 Just
as the picture property was used in
Pure VB: Create a Ledger-Style Listview Report Background
to simulate a ledger-style background for the listview, this code provides
a means to highlight the data in a specific column in the control using the same
technique.
To
do this, the the default background colour, and the colour for the
highlighted row are passed, along with the 1-based index of the column of
interest. The code determines the left and width of the column of
interest, and draws a 1 pixel high filled rect at that location. The code
then assigns the picture drawn to the listview's picture property in
tiled mode, causing the column to take the a BackColor specified. This
code works equally well with the HideColumnHeaders property set to either True or
False.
There is an obvious drawback to this routine ... although scrolling
provides no problems, resizing the column once the highlight has been
applied does not cause the highlight width to match the new column width
because the listview does not expose any method to track the movement of
the ColumnHeaders. This is addressed in the subclassed demo of this
series listed above.
|
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
Private sFilenameIn As String
'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 = "Highlight Column"
With Combo1
.AddItem 1
.AddItem 2
.AddItem 3
.AddItem 4
.AddItem 5
.ListIndex = 0
End With
LoadData sizeNone 'change to sizeIcon if using an imagelist
End Sub
Private Sub Command1_Click()
With ListView1
.Visible = False
.Checkboxes = False
.FullRowSelect = True
Call SetHighlightColumn(ListView1, _
vbLedgerRed, _
vbledgerPureWhite, _
Combo1.List(Combo1.ListIndex), _
sizeNone)
.Refresh
.Visible = True 'Restore visibility
End With
End Sub
Private Sub SetHighlightColumn(lv As ListView, _
clrHighlight As LedgerColours, _
clrDefault As LedgerColours, _
nColumn As Long, _
nSizingType As ImageSizingTypes)
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
With lv
.Picture = Nothing 'clear picture
.Refresh
.Visible = 1
.PictureAlignment = lvwTile
End With ' lv
'set up the picture box properties
With Picture1
.AutoRedraw = False 'clear/reset picture
.Picture = Nothing
.BackColor = clrDefault
.Height = 1
.AutoRedraw = True 'assure image draws
.BorderStyle = vbBSNone 'other attributes
.ScaleMode = vbTwips
.Top = Form1.Top - 10000 'move it off screen
.Visible = False
.Height = 1 'only need a 1 pixel high picture
.Width = Screen.Width
'draw a box in the highlight colour
'at location of the column passed
cl = ListView1.ColumnHeaders(nColumn).Left
cw = ListView1.ColumnHeaders(nColumn).Left + _
ListView1.ColumnHeaders(nColumn).Width
Picture1.Line (cl, 0)-(cw, 210), clrHighlight, BF
.AutoSize = True
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
SetHighlightColumn_Exit:
On Local Error GoTo 0
Exit Sub
SetHighlightColumn_Error:
'clear the listview's picture and exit
With lv
.Picture = Nothing
.Refresh
End With
Resume SetHighlightColumn_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 , , "Mode"
.ColumnHeaders.Add , , "State"
.ColumnHeaders.Add , , "Warnings"
.View = lvwReport
.Sorted = False
End With
'Create some fake data
For cnt = 1 To 100
Set itmX = Form1.ListView1.ListItems.Add(, , Format$(cnt, "###"))
itmX.SubItems(1) = "Weld process"
itmX.SubItems(2) = "T-manual"
If cnt Mod 2 = 0 Then
itmX.SubItems(2) = "Auto detect"
End If
If cnt Mod 3 = 0 Then
itmX.SubItems(4) = "Trouble at " & Format$(Time, "hh:mm:ss am/pm")
itmX.SubItems(3) = "Stopped"
If nSizingType = sizeIcon Then itmX.SmallIcon = 1
End If
Next
'Now that the control contains data, this
'causes the columns to resize to fit the items
Call lvAutosizeControl(Form1.ListView1)
ListView1.Refresh
End Sub
Private Sub lvAutosizeControl(lv As ListView)
Dim col2adjust As Long
'Size each column based on the maximum of
'EITHER the column header 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
|
