VB - Add greenbar effect to Listview control
Add a module to your project and paste this sub into the module.
Add a picturebox to the form containing the listview. You do not have to set any properties on the picturebox.
Call this sub in the Form_Load event using this syntax:
DoGreenBar Me, Me.Picture1, Me.Listview1
I didn't write this code, but I have used it and it works.
Code:
Public Sub DoGreenBar(fm as Form, pb as PictureBox, lv As ListView)
Dim iFontHeight As Long
Dim iBarHeight As Long
Dim i As Long
fm.ScaleMode = vbTwips 'make sure our form is In twips
pb.ScaleMode = vbTwips
pb.BorderStyle = vbBSNone 'this is important - we don't want to measure the border In our calcs.
pb.AutoRedraw = True
pb.Visible = False
pb.Font = lv.Font
iFontHeight = pb.TextHeight("b") + Screen.TwipsPerPixelY
iBarHeight = (iFontHeight * 1) '3 line wide greenbars.
pb.Width = lv.Width
'======
'size the picture control 2 barheights t
' all
pb.Height = iBarHeight * 2
'set a custom scalemode to make drawing
' the bars easy (set up for 2 bars)
pb.ScaleMode = vbUser
pb.ScaleHeight = 2 '2 bar-widths high
pb.ScaleWidth = 1 '1 bar-width wide
'draw the actual bars
pb.Line (0, 0)-(1, 1), vbWhite, BF 'white bars - modify vbWhite To change bar color
pb.Line (0, 1)-(1, 2), RGB(227, 241, 226), BF 'light green bars - modify RGB(x,x,x) To change bar color
'======
'put it in the listview control, tiled
lv.PictureAlignment = lvwTile
lv.Picture = pb.Image
'Notes:
'You could actually use more uniquely co
' lored bars if desired.
'I've found this is usefull where the li
' st is in distinct sections
'of a certain number of lines.
'Example (using 5 differently colored ba
' rs)
'replace the original code between the "
' ======" marks with
'this (remove the first comment hash (')
' , of course):
''======
'picGreenbar.Height = iBarHeight * 5 '5
' is how many different colors bars we'll
' use
''set a custom scalemode to make drawing
' the bars easy (set up for 2 bars)
'picGreenbar.ScaleMode = vbUser
'picGreenbar.ScaleHeight = 5 '5 bar-widt
' hs high
'picGreenbar.ScaleWidth = 1 '1 bar-width
' wide
'picGreenbar.DrawWidth = 1
''draw the actual bars
'picGreenbar.Line (0, 0)-(1, 1), RGB(254
' , 209, 199), BF
'picGreenbar.Line (0, 1)-(1, 2), RGB(254
' , 255, 193), BF
'picGreenbar.Line (0, 2)-(1, 3), RGB(200
' , 255, 193), BF
'picGreenbar.Line (0, 3)-(1, 4), RGB(193
' , 255, 254), BF
'picGreenbar.Line (0, 4)-(1, 5), vbWhite
' , BF
''======
'
End Sub
