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
0 Comments
