 Up
to now, arguably, the recommended way to add a ledger-style appearance to
a listview control has been to subclass the control in order to create an
owner-drawn control, and to provide the appropriate brushes for drawing
each row.
This
page takes a different approach based on the Picture property of the VB5
and VB6 listviews. With this demo, picture box properties are set to
match the size and font of the listview. The demo then draws two filled
rectangles inside the picture box corresponding to ledger colours
specified, and, based on calculations to determine the height of a line
of text in the listview, uses the picture box's Line method to create
solid bars representing the two ledger background colours. The code then
sets the control's picture style to tiled, and sets the picture box image
to the listview's picture property.
Paramount to this working successfully is accurately calculating the
height of the listview row. This height differs when the control has text
alone, has a state icon such as the checkbox, and when the control has
images contained in an imagelist control. The illustration depicts these
three conditions and shows how the ledger routine correctly sized the row
based on the type of data being presented. And extending this basic
routine to add three, four or more different coloured ledger lines is a
simple matter of increasing the size of the picture box and drawing
additional lines with the Line method.
One caveat: Remember that with an imagelist bound to the listview's
SmallIcon property you have committed the listview to a internal state
where listitem line height based on the expectation of an icon being
assigned. When this has taken place, item height remains the same even
when the SmallIcon property is set to nothing and the ListItems cleared.
With respect to this demo, this anomaly means that although the
ledger-creating code sizes ledger row height correctly (based on the font
and flag passed), if the listview has previously displayed a SmallIcon
the ledger will no longer align correctly with the listitem rows because
the control has reserved vertical space for the non-existent icons. This
should
really only be an issue within this demo since in a "real" application, a
user is never presented with this set of display choices. |
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
'/* Below used for listview column auto-resizing
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 = "Text Only"
Command2.Caption = "Text && Checks"
Command3.Caption = "Text && 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 '/* 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 '/* variable holding Screen.TwipsPerPicture1elY
iBarHeight = 0
lBarWidth = 0
diff = 0
On Local Error GoTo SetListViewColor_Error
twipsy = Screen.TwipsPerPixelY
If lv.View = lvwReport Then
'/* set up the listview properties
With lv
.Picture = Nothing '/* clear picture
.Refresh
.Visible = 1
.PictureAlignment = lvwTile
lBarWidth = .Width
End With ' lv
'/* set up the picture box properties
With Picture1
.AutoRedraw = False '/* clear/reset picture
.Picture = Nothing
.BackColor = vbWhite
.Height = 1
.AutoRedraw = True '/* assure image draws
.BorderStyle = vbBSNone '/* other attributes
.ScaleMode = vbTwips
.Top = Form1.Top - 10000 '/* move it way off screen
.Width = Screen.Width
.Visible = False
.Font = lv.Font '/* assure Picture1 font matched listview font
'/* match picture box font properties
'/* with those of listview
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 'Picture1.Font
'/* here we calculate the height of each
'/* bar in the listview. Several things
'/* can affect this height - the use
'/* of item icons, the size of those icons,
'/* the use of checkboxes and so on through
'/* all the permutations.
'/*
'/* Shown here is code sufficient to calculate
'/* this height based on three combinations of
'/* data, state icons, and imagelist icons:
'/*
'/* 1. text only
'/* 2. text with checkboxes
'/* 3. text with icons
'/* used by all sizing routines
iBarHeight = .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
If (iBarHeight \ twipsy) > 18 Then
iBarHeight = iBarHeight + twipsy
Else
diff = 18 - (iBarHeight \ twipsy)
iBarHeight = iBarHeight + (diff * twipsy) + (twipsy * 1)
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 = imagelist1.ImageHeight - (iBarHeight \ twipsy)
iBarHeight = iBarHeight + (diff * twipsy) + (twipsy * 1)
End Select
'/* since we need two-tone bars, the
'/* picturebox needs to be twice as high
.Height = iBarHeight * 2
.Width = lBarWidth
'/* paint the two bars of color and refresh
'/* Note: The line method does not support
'/* With/End With blocks
Picture1.Line (0, 0)-(lBarWidth, iBarHeight), Bar1Color, BF
Picture1.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), Bar2Color, BF
.AutoSize = True
.Refresh
End With 'Picture1
'/* set the lv picture to the
'/* Picture1 image
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:
'/* clear the listview's picture and exit
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 , , "Number"
.ColumnHeaders.Add , , "Time"
.ColumnHeaders.Add , , "User"
.ColumnHeaders.Add , , "Tag "
.View = lvwReport
.Sorted = False
End With
'/* Create some fake data
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
'/* Now that the control contains data, this
'/* causes the columns to resize to fit the items
Call lvAutosizeControl(Form1.ListView1)
End Sub
Private Sub lvAutosizeControl(lv As ListView)
Dim col2adjust As Long
'/* Size each column based on the maximum of
'/* EITHER the columnheader text width, or,
'/* if the items below it are wider, the
'/* widest list item in the column
For col2adjust = 0 To lv.ColumnHeaders.Count - 1
Call SendMessage(lv.hwnd, _
LVM_SETCOLUMNWIDTH, _
col2adjust, _
ByVal LVSCW_AUTOSIZE_USEHEADER)
Next
End Sub |
