Listview Color Row dengan Visual Basic

Listview Color Row dengan Visual Basic 6.0 - Pasti sudah mengenal atau sudah pernah memakai tampilan tabel dengan List View atau LV, Nah sekarang untuk artikel ini saya akan berbagi tips merubah tampilan List View. Komponen yang saya butuhkan tidak banyak hanya komponen yang sering di pakai saja seperti Command buat Tombol buttonnya, Listview, Imagelist, dan PictureBox. 

Bagi yang berminat mendapatkan source code vb  nya bisa mampir ke group “Tutorial visual basic Indonesia”.

Untuk Lebih detailnya sebagai berikut :

1.    Untuk tahapan pertama seperti biasa , Buat dulu Desain Form nya. Desain form yang saya buat sebagai berikut : 

2.    Untuk pengaturan Propertis nya default kan saja, tapi jika ingin setting kembali silahkan sesuainya dengan selera masing – masing. 

3.    Penulisan Source Code

Private Enum ImageSizingTypes
[sizeNone] = 0
[sizeCheckBox]
[sizeIcon]
End Enum

Private Enum LedgerColours
vbledgerWhite = &HF9FEFF
vbLedgerGreen = &HD0FFCC
vbLedgerYellow = &HE1FAFF
vbLedgerRed = &HE1E1FF
vbLedgerGrey = &HE0E0E0
vbLedgerBeige = &HD9F2F7
vbLedgerSoftWhite = &HF7F7F7
vbledgerPureWhite = &HFFFFFF
End Enum

Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE As Long = -1
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long


Private Sub Form_Load()
Command1.Caption = "Hanya Teks Saja"
Command2.Caption = "Teks da&n Check Box"
Command3.Caption = "Text da&n Icons"
End Sub


Private Sub Command1_Click()
With ListView1
.Visible = False
.Checkboxes = False
.FullRowSelect = True
Set .SmallIcons = Nothing

Call LoadData(sizeNone)
Call SetListViewLedger(ListView1, _
vbLedgerYellow, _
vbLedgerGrey, _
sizeNone)

.Refresh
.Visible = True '/* Restore visibility
End With
End Sub

Private Sub Command2_Click()
With ListView1
.Visible = False
.Checkboxes = True
.FullRowSelect = True
Set .SmallIcons = Nothing

Call LoadData(sizeCheckBox)
Call SetListViewLedger(ListView1, _
vbLedgerYellow, _
vbLedgerGrey, _
sizeCheckBox)

.Refresh
.Visible = True
End With

End Sub


Private Sub Command3_Click()
With ListView1
.Visible = False
.Checkboxes = False
.FullRowSelect = True
Set .SmallIcons = ImageList1

Call LoadData(sizeIcon)
Call SetListViewLedger(ListView1, _
vbLedgerYellow, _
vbLedgerGrey, _
sizeIcon)

.Refresh
.Visible = True
End With

Command1.Enabled = False
End Sub

Private Sub SetListViewLedger(lv As ListView, _
Bar1Color As LedgerColours, _
Bar2Color As LedgerColours, _
nSizingType As ImageSizingTypes)

Dim iBarHeight As Long
Dim lBarWidth As Long
Dim diff As Long
Dim twipsy As Long

iBarHeight = 0
lBarWidth = 0
diff = 0

On Local Error GoTo SetListViewColor_Error

twipsy = Screen.TwipsPerPixelY

If lv.View = lvwReport Then


With lv
.Picture = Nothing
.Refresh
.Visible = 1
.PictureAlignment = lvwTile
lBarWidth = .Width
End With ' lv


With Picture1
.AutoRedraw = False
.Picture = Nothing
.BackColor = vbWhite
.Height = 1
.AutoRedraw = True
.BorderStyle = vbBSNone
.ScaleMode = vbTwips
.Top = Form1.Top - 10000
.Width = Screen.Width
.Visible = False
.Font = lv.Font

With .Font
.Bold = lv.Font.Bold
.Charset = lv.Font.Charset
.Italic = lv.Font.Italic
.Name = lv.Font.Name
.Strikethrough = lv.Font.Strikethrough
.Underline = lv.Font.Underline
.Weight = lv.Font.Weight
.Size = lv.Font.Size
End With

iBarHeight = .TextHeight("W")

Select Case nSizingType
Case sizeNone:

iBarHeight = iBarHeight + twipsy

Case sizeCheckBox:
If (iBarHeight \ twipsy) > 18 Then
iBarHeight = iBarHeight + twipsy
Else
diff = 18 - (iBarHeight \ twipsy)
iBarHeight = iBarHeight + (diff * twipsy) + (twipsy * 1)
End If

Case sizeIcon:
diff = ImageList1.ImageHeight - (iBarHeight \ twipsy)
iBarHeight = iBarHeight + (diff * twipsy) + (twipsy * 1)

End Select

.Height = iBarHeight * 2
.Width = lBarWidth

Picture1.Line (0, 0)-(lBarWidth, iBarHeight), Bar1Color, BF
Picture1.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), Bar2Color, BF

.AutoSize = True
.Refresh

End With 'Picture1


lv.Refresh
lv.Picture = Picture1.Image

Else

lv.Picture = Nothing

End If 'lv.View = lvwReport

SetListViewColor_Exit:
On Local Error GoTo 0
Exit Sub

SetListViewColor_Error:

With lv
.Picture = Nothing
.Refresh
End With

Resume SetListViewColor_Exit
End Sub


Private Sub LoadData(nSizingType As ImageSizingTypes)
Dim cnt As Long
Dim itmX As ListItem

With ListView1
.ListItems.Clear
.ColumnHeaders.Clear
.ColumnHeaders.Add , , "No Urut"
.ColumnHeaders.Add , , "Waktu"
.ColumnHeaders.Add , , "User"
.ColumnHeaders.Add , , "Tag"
.View = lvwReport
.Sorted = False
End With

For cnt = 1 To 100

Set itmX = Form1.ListView1.ListItems.Add(, , Format$(cnt, "###"))
If nSizingType = sizeIcon Then itmX.SmallIcon = 1
itmX.SubItems(1) = Format$(Time, "hh:mm:ss am/pm")
itmX.SubItems(2) = "RGB-T"
itmX.SubItems(3) = "SYS-1234"

Next

Call lvAutosizeControl(Form1.ListView1)
End Sub

Private Sub lvAutosizeControl(lv As ListView)
Dim col2adjust As Long
For col2adjust = 0 To lv.ColumnHeaders.Count - 1

Call SendMessage(lv.hwnd, _
LVM_SETCOLUMNWIDTH, _
col2adjust, _
ByVal LVSCW_AUTOSIZE_USEHEADER)

Next
End Sub