Visual Basic Common Control API Routines
Pure VB: Create a Ledger-Style Listview Report Background
Posted:   Tuesday February 05, 2002
Updated:   Monday December 26, 2011
Applies to:   VB6, or VB5 using APIs (not demonstrated)
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch

Pure VB: Create a Ledger-Style Listview Report Background with Custom Height
Pure VB: Highlight a Listview Report Column
WM_NOTIFY: Track Highlighted ListView Column Width Changes via Subclassing

Visual Basic 6. Visual Basic 5 users can not access the listview's picture property without using APIs: see SendMessage: Add a Background Image to a ListView

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.

 BAS Module Code

 Form Code
Add three command buttons (Command1, Command2, Command3), a picture box (Picture1), a listview (Listview1), a combo (Combo1) and a label (Label1) to a form.  An imagelist is optional - if not used you'll get an error if Command3 is pressed. If it is used, add at least one 16x16 icon.  Add the following code:

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
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 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, _
      .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, _
      .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, _
      .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
        .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
                  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
      End With  'Picture1
     '/* set the lv picture to the
     '/* Picture1 image
      lv.Picture = Picture1.Image
      lv.Picture = Nothing
   End If  'lv.View = lvwReport

On Local Error GoTo 0
Exit Sub

  '/* clear the listview's picture and exit
   With lv
      .Picture = nothing
   End With
   Resume SetListViewColor_Exit
End Sub

Private Sub LoadData(nSizingType As ImageSizingTypes)

   Dim cnt As Long
   Dim itmX As ListItem
   With ListView1
      .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"

  '/* 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)

End Sub


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter