 Richard
Wolf has provided a modified routine based on
Pure VB: Create a Ledger-Style Listview Report Background that provides for specifying
how many rows in height each ledger "row" should be. The illustration shows
the result of passing 1 through 4 as this parameter.
Like
the previous example, this code uses a picture box's Line method to create
solid bars representing the two ledger background colours before
assigning the created picture to the listview's background picture
property.
This demo changes the parameters passed to the routine, adding a variable
used as a multiplier in calculating both the Picture1 height, and the
height of the two bars drawn into the picturebox.
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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
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"
With Combo1
.AddItem 1
.AddItem 2
.AddItem 3
.AddItem 4
.AddItem 5
.ListIndex = 0
End With
End Sub
Private Sub Command1_Click()
With ListView1
.Visible = False '/* Slimy workaround for listview redraw problem
.Checkboxes = False
.FullRowSelect = True
.HideSelection = True
Set .SmallIcons = Nothing
Call LoadData(sizeNone)
Call SetListViewLedgerRows(ListView1, _
vbLedgerYellow, _
vbLedgerGrey, _
sizeNone, _
Combo1.List(Combo1.ListIndex))
.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 SetListViewLedgerRows(ListView1, _
vbLedgerYellow, _
vbLedgerGrey, _
sizeCheckBox, _
Combo1.List(Combo1.ListIndex))
.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 SetListViewLedgerRows(ListView1, _
vbLedgerYellow, _
vbLedgerGrey, _
sizeIcon, _
Combo1.List(Combo1.ListIndex))
.Refresh
.Visible = True
End With
Command1.Enabled = False
End Sub
Private Sub SetListViewLedgerRows(lv As ListView, _
Bar1Color As LedgerColours, _
Bar2Color As LedgerColours, _
nSizingType As ImageSizingTypes, _
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
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 font matches 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
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
End Select
'/* since we need two-tone bars, the
'/* picturebox needs to be twice as
'/* high as the number of rows desired
.Height = iBarHeight * (2 * nRowsPerBar)
.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 * nRowsPerBar)), Bar1Color, BF
Picture1.Line (0, (iBarHeight * nRowsPerBar))-(lBarWidth, _
(iBarHeight * (2 * nRowsPerBar))), 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 |
