Dalam menggunakan komponen Listview pada VB6 tampilan data untuk view : 3-lvwReport, data yang ditampilkan dengan latar belakang warna putih atau sesuai dengan warna yang kita tentukan. Bagaiman seandainya kita akan memberi warna tiap baris berbeda sehingga data akan lebih mudah dibaca. Pada artikel ini saya akan memberikan contoh program yang bisa anda download untuk membuat program tersebut dengan VB6.
Pada contoh program aplikasi tersebut saya menggunakan komponen Listview dengan jenis view 3-lvwReport, dengan kolom kode barang dan nama barang. Untuk program setting warna baris listview saya menggunakan class yang akan digunakan dalam project, dengan prosedur seperti kode program dibawah ini:
'-------------------------------------------------------------------
'Listview Ledger
'-------------------------------------------------------------------
Option Explicit
Public Enum ImageSizingTypes
[sizeNone] = 0
[sizeCheckBox]
[sizeIcon]
End Enum
Public Enum LedgerColours
vbledgerWhite = &HF9FEFF
vbLedgerGreen = &HD0FFCC
vbLedgerYellow = &HE1FAFF
vbLedgerRed = &HE1E1FF
vbLedgerGrey = &HEEEEEE
vbLedgerBeige = &HD9F2F7
vbledgerSoftWhite = &HF7F7F7
vbledgerPureWhite = &HFFFFFF
vbledgerSoftBlue = &HFFC0C0
vbledgerSoftRed = &HE1F7FB
vbledgerBlackGray = &HE6E7E8
vbledgerSoftYellow = &HD2FCFD
vbledgerCyan = &HFCFCEB
vbledgerMagenta = &HFCE2FC
vbledgerGold = &H80C0FF
End Enum
Public ListViewBarType As ImageSizingTypes
Public BarColor1 As LedgerColours
Public BarColor2 As LedgerColours
Public Sub FormatLedger(lsvLedger As Object)
Dim oPicture As PictureBox
Dim oimgLedger As ImageList
On Error GoTo ErrorFormat
Set oPicture = frmTemplate.picLedger
Set oimgLedger = frmTemplate.imgLedger
lsvLedger.Visible = False
If ListViewBarType = sizeCheckBox Then
lsvLedger.Checkboxes = True
Else
lsvLedger.Checkboxes = False
End If
If ListViewBarType = sizeIcon Then 'Or ListViewBarType = sizeCheckBox Then
Set lsvLedger.SmallIcons = oimgLedger
End If
Call SetListViewLedgerRows(lsvLedger, BarColor1, BarColor2, ListViewBarType, oPicture, oimgLedger, 1)
lsvLedger.Refresh
lsvLedger.Visible = True
Set oPicture = Nothing
Set oimgLedger = Nothing
Exit Sub
ErrorFormat:
MsgBox Err.Description, vbCritical, "Peringatan"
On Error GoTo 0
End Sub
Public Sub SettingHeighLight(lsvLedger As Object, ListviewColumn As Long)
Dim oPicture As PictureBox
On Error Resume Next
Set oPicture = frmTemplate.picLedger
lsvLedger.Visible = False
Call SetHighlightColumn(lsvLedger, BarColor1, BarColor2, ListviewColumn, ListViewBarType, oPicture)
lsvLedger.Refresh
lsvLedger.Visible = True 'Restore visibility
Set oPicture = Nothing
On Error GoTo 0
End Sub
Private Sub SetListViewLedgerRows(lv As ListView, Bar1Color As LedgerColours, Bar2Color As LedgerColours, nSizingType As ImageSizingTypes, _
picLedger As Object, imlLedger As Object, Optional nRowsPerBar As Long = 1)
Dim iBarHeight As Long '/* height of 1 line in the listview
Dim lBarWidth As Long '/* width of listview
Dim diff As Long '/* used in calculations of row height
Dim twipsy As Long '/* var holding Screen.TwipsPerPixelY
Dim nCol As Integer
iBarHeight = 0
lBarWidth = 0
diff = 0
On Error Resume Next
On Local Error GoTo SetListViewColor_Error
twipsy = Screen.TwipsPerPixelY
If lv.View = lvwReport Then
'/* set up the listview properties
lv.Picture = Nothing
lv.Refresh
lv.Visible = 1
lv.PictureAlignment = lvwTile
lBarWidth = 0
For nCol = 1 To lv.ColumnHeaders.Count
lBarWidth = lBarWidth + lv.ColumnHeaders(nCol).Width
Next
If lBarWidth < lv.Width Then lBarWidth = lv.Width
'/* set up the picture box properties
picLedger.AutoRedraw = False '/* clear/reset picture
picLedger.Picture = Nothing
picLedger.BackColor = vbWhite
picLedger.Height = 1
picLedger.AutoRedraw = True '/* assure image draws
picLedger.BorderStyle = vbBSNone '/* other attributes
picLedger.ScaleMode = vbTwips
picLedger.Width = Screen.Width
picLedger.Visible = False
picLedger.Font = lv.Font '/* assure font matches listview font
'/* match picture box font properties
'/* with those of listview
picLedger.Font.Bold = lv.Font.Bold
picLedger.Font.Charset = lv.Font.Charset
picLedger.Font.Italic = lv.Font.Italic
picLedger.Font.Name = lv.Font.Name
picLedger.Font.Strikethrough = lv.Font.Strikethrough
picLedger.Font.Underline = lv.Font.Underline
picLedger.Font.Weight = lv.Font.Weight
picLedger.Font.Size = lv.Font.Size
'/* used by all sizing routines
iBarHeight = picLedger.TextHeight("W")
Select Case nSizingType
Case sizeNone:
'/* 1. text only
iBarHeight = iBarHeight + twipsy
Case sizeCheckBox:
'/* 2. text with checkboxes: add to TextHeight the
'/* difference between 18 pixels and iBarHeight
'/* all calculated initially in pixels,
'/* then converted to twips
diff = imlLedger.ImageHeight - (iBarHeight \ twipsy)
iBarHeight = iBarHeight + (diff * twipsy) + twipsy
'If (iBarHeight \ twipsy) > 18 Then
' iBarHeight = iBarHeight + twipsy
'Else
' diff = 18 - (iBarHeight \ twipsy)
' iBarHeight = iBarHeight + (diff * twipsy) + twipsy
'End If
Case sizeIcon:
'/* 3. text with icons: add to TextHeight the
'/* difference between TextHeight and image
'/* height, all calculated initially in pixels,
'/* then converted to twips. Handles 16x16 icons
diff = imlLedger.ImageHeight - (iBarHeight \ twipsy)
iBarHeight = iBarHeight + (diff * twipsy) + twipsy
End Select
'/* since we need two-tone bars, the
'/* picturebox needs to be twice as
'/* high as the number of rows desired
picLedger.Height = iBarHeight * (2 * nRowsPerBar)
picLedger.Width = lBarWidth
'/* paint the two bars of color and refresh
'/* Note: The line method does not support
'/* With/End With blocks
picLedger.Line (0, 0)-(lBarWidth, (iBarHeight * nRowsPerBar)), Bar1Color, BF
picLedger.Line (0, (iBarHeight * nRowsPerBar))-(lBarWidth, (iBarHeight * (2 * nRowsPerBar))), Bar2Color, BF
picLedger.AutoSize = True
picLedger.Refresh
'/* set the lv picture to the
'/* picLedger image
lv.Refresh
lv.Picture = picLedger.Image
Else
lv.Picture = Nothing
End If 'lv.View = lvwReport
SetListViewColor_Exit:
On Local Error GoTo 0
Exit Sub
SetListViewColor_Error:
lv.Picture = Nothing
lv.Refresh
Resume SetListViewColor_Exit
On Error GoTo 0
End Sub
'-------------------------------------------------------------------
'-------------------------------------------------------------------
Private Sub SetHighlightColumn(lv As ListView, clrHighlight As LedgerColours, clrDefault As LedgerColours, _
nColumn As Long, nSizingType As ImageSizingTypes, picLedger As Object)
Dim cnt As Long 'counter
Dim cl As Long 'columnheader left
Dim cw As Long 'columnheader width
On Local Error GoTo SetHighlightColumn_Error
If lv.View = lvwReport Then
'set up the listview properties
lv.Picture = Nothing 'clear picture
lv.Refresh
lv.Visible = 1
lv.PictureAlignment = lvwTile
'set up the picture box properties
picLedger.AutoRedraw = False 'clear/reset picture
picLedger.Picture = Nothing
picLedger.BackColor = clrDefault
picLedger.Height = 1
picLedger.AutoRedraw = True 'assure image draws
picLedger.BorderStyle = vbBSNone 'other attributes
picLedger.ScaleMode = vbTwips
picLedger.Visible = False
picLedger.Height = 1 'only need a 1 pixel high picture
picLedger.Width = Screen.Width
'draw a box in the highlight colour
'at location of the column passed
cl = lv.ColumnHeaders(nColumn).Left
cw = lv.ColumnHeaders(nColumn).Left + _
lv.ColumnHeaders(nColumn).Width
picLedger.Line (cl, 0)-(cw, 210), clrHighlight, BF
picLedger.AutoSize = True
'set the lv picture to the
'Picture1 image
lv.Refresh
lv.Picture = picLedger.Image
Else
lv.Picture = Nothing
End If 'lv.View = lvwReport
SetHighlightColumn_Exit:
On Local Error GoTo 0
Exit Sub
SetHighlightColumn_Error:
'clear the listview's picture and exit
lv.Picture = Nothing
lv.Refresh
Resume SetHighlightColumn_Exit
End Sub
Memberi Warna Baris Listview
Selanjutnya dalam project yaitu di Form, digunakan dua buah komponen CommandButton dengan event clik dengan menuliskan kode program sperti dibawah ini:
Private Sub cmdHighLightCheckBox_Click()
Dim oFormatListview As New SSListViewSetting
lsvData.Checkboxes = True
oFormatListview.ListViewBarType = sizeCheckBox
oFormatListview.BarColor1 = BarColor(cboBarColor1.ListIndex)
oFormatListview.BarColor2 = BarColor(cboBarColor2.ListIndex)
oFormatListview.FormatLedger lsvData
IsiData
End Sub
Private Sub cmdHighLightNone_Click()
Dim oFormatListview As New SSListViewSetting
lsvData.Checkboxes = False
oFormatListview.ListViewBarType = sizeNone
oFormatListview.BarColor1 = BarColor(cboBarColor1.ListIndex)
oFormatListview.BarColor2 = BarColor(cboBarColor2.ListIndex)
oFormatListview.FormatLedger lsvData
IsiData
End Sub
Demikian contoh program membuat listview dengan baris berwarna dan untuk lebih jelasnya anda bisa download contoh program tersebut Membuat Listview dengan Baris Berwarna VB6 disini. Semoga artikel ini bermanfaat.
Daftarkan email anda disini untuk berlangganan artikel kodiing
ConversionConversion EmoticonEmoticon