Membuat Listview dengan Baris Berwarna VB6

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. 

• DOWNLOAD SOURCE CODE VB6