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
snowghoul
janainaart
vaporwave
areudirty
pixelskylines
tangentwithtanner
2087
stormborns
yousharknotpass
jbbartram-illu