Dynamically Adding a Horizontal Scroll Bar to a List Box

Environment: SP4, NT4 SP3, winCE 2.0

The accompanying code contains a class that can be used to add items to the ListBox control. When you add a new item, it adds a horizontal scroll bar to a specified list box (if required) and scrolls down the list box so you can see the last added item.

The code uses the SendMessage API function to add a horizontal scroll bar dynamically to a list box using the LB_SETHORIZONTALEXTENT message; it also takes into account the width of the vertical scroll bar that can be present in the list box. To precisely calculate the width of a new item, our class uses the DrawText API function with the DT_CALCRECT flag. Draw attention to the fact that our class works properly if you change the font of the listbox as you want. We use the IFont interface and its hFont property to retrieve the handle of the font used in the listbox. In addition, our class also takes into account the visibility of the vertical scroll bar in the listbox. It determines whether this scroll bar is present retrieving the listbox style flags and testing these set of flags for WS_VSCROLL.

Using this class called CLBHscroll in real-world applications is very easy. All you need to do is (1) Initialize this class using the Init method, which accepts the reference to the list box you want to populate and (2) Call the AddItem method of this class to add a new item. The Init method also clears the list box.

To see how this class works, create a new exe project in VB and place the CommandButton and ListBox controls on its form. Don't change the default names of these controls (Command1 and List1, respectively). Put the following code in the Command1_Click event procedure:

Private Sub cmdPopulate_Click()
   Dim LBHS As New CLBHScroll
   Dim i As Long, lStrLen As Long

   With List1.Font
      .Name = "Arial"
      .Size = 12
      .Italic = True
   End With

   LBHS.Init List1

   For i = 1 To 30
      lStrLen = Int(Rnd * 50) + 1
      LBHS.AddItem String(lStrLen, "W") + "!"
   Next
End Sub

Run the project and click the Command1 button. You will see that the listbox named List1 is populated with 30 random-length strings, has the horizontal scroll bar, and displays the last added string.

The accompanying class can be useful in many real-world situations. For instance, if you perform a context search in files, you can use this class to add found files to a list box at the screen as they are found. Our company uses this code in demo applications of the xDir library that allows you to enumerate files and folders in a specified folder and all of its subfolders using various filter criteria (file and folder mask; file size; attributes; date and time of creation, last access and modification, and so forth). You can visit our Web site (www.10Tec.com) to download this and other demos to see how it works.

======================
Class ListBoxHScroll
======================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1            'True
  Persistable = 0          'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name            = "CLBHScroll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable       = True
Attribute VB_PredeclaredId   = False
Attribute VB_Exposed         = False
Option Explicit

' --- required API declarations ---

Private Declare Function SendMessageByLong Lib "user32" _
        Alias "SendMessageA" _
   (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const LB_SETHORIZONTALEXTENT = &H194
Private Const WM_VSCROLL = &H115
Private Const SB_BOTTOM = 7

Private Declare Function GetSystemMetrics Lib "user32" _
        (ByVal nIndex As Long) As Long
Private Const SM_CXVSCROLL = 2

Private Declare Function GetDC Lib "user32" _
        (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
        (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function DrawText Lib "user32" _
        Alias "DrawTextA" _
        (ByVal hdc As Long, ByVal lpStr As String, _
        ByVal nCount As Long, _
        lpRect As RECT, ByVal wFormat As Long) As Long
Private Const DT_SINGLELINE = &H20
Private Const DT_CALCRECT = &H400

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Declare Function SelectObject Lib "gdi32" _
   (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function GetWindowLong Lib "user32" _
        Alias "GetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_VSCROLL = &H200000

' --- private class variables ---
Private mvarListBox As ListBox
Private m_lMaxItemWidth As Long
Private m_hItemFont As Long
Private m_ListBoxHwnd As Long

Public Sub Init(ByRef pListBox As ListBox)
   Dim FontInt As IFont

   Set mvarListBox = pListBox
   mvarListBox.Clear
   m_lMaxItemWidth = 0
   m_ListBoxHwnd = mvarListBox.hwnd

   ' Determining the handle of the font used in the specified
   ' listbox.
   ' Using the IFont interface we can retrieve the handle of
   ' the font used in the specified listbox.
   ' We'll use this handle further when we'll calculate the
   ' width of the listbox items
   Set FontInt = pListBox.Font
   m_hItemFont = FontInt.hFont
End Sub

' The following routine adds a string to a specified list box
' and displays the horizontal scroll bar in it if required
Public Sub AddItem(ByRef psItemText As String)
   Dim m As Long
   Dim hdc As Long
   Dim rc As RECT
   Dim hOldFont As Long
   Dim bHasVScrBar As Boolean
   
   mvarListBox.AddItem psItemText

   ' --- calculating the width of the currently added item ---
   hdc = GetDC(m_ListBoxHwnd)  ' retrieving HDC for the listbox
   hOldFont = SelectObject(hdc, m_hItemFont) ' selecting the
                                             ' required font
   ' if you specify the DT_CALCRECT flag,
   ' DrawText only determines the width and height of the
   ' rectangle required to display the text:
   DrawText hdc, psItemText, -1, rc, DT_SINGLELINE + DT_CALCRECT
   m = rc.Right - rc.Left
   ' restoring the previous state
   Call SelectObject(hdc, hOldFont)
   ReleaseDC m_ListBoxHwnd, hdc

   ' --- determining whether we need to display the horizontal
   ' scroll bar ---
   If m > m_lMaxItemWidth Then
      m_lMaxItemWidth = m
      bHasVScrBar = GetWindowLong(m_ListBoxHwnd, GWL_STYLE) _
                    And WS_VSCROLL
      SendMessageByLong m_ListBoxHwnd, LB_SETHORIZONTALEXTENT, _
         m + IIf(bHasVScrBar, _
             GetSystemMetrics(SM_CXVSCROLL), 4), 0
   End If

   ' --- scrolling the listbox to be sure that the user sees
   ' the last item ---
   SendMessageByLong m_ListBoxHwnd, WM_VSCROLL, SB_BOTTOM, 0
End Sub


======================
Form with ListBox
======================
VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3615
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3615
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtItemCnt
      Height          =   315
      Left            =   1500
      TabIndex        =   3
      Text            =   "50"
      Top             =   120
      Width           =   735
   End
   Begin VB.ListBox List1
      Height          =   2700
      IntegralHeight  =   0   'False
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   4395
   End
   Begin VB.CommandButton cmdPopulate
      Caption         =   "Populate the listbox"
      Height          =   375
      Left            =   2760
      TabIndex        =   0
      Top             =   120
      Width           =   1815
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      Caption         =   "Number of items:"
      Height          =   195
      Left            =   120
      TabIndex        =   2
      Top             =   180
      Width           =   1185
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdPopulate_Click()
   Dim LBHS As New CLBHScroll
   Dim i As Long, lStrLen As Long

   With List1.Font
      .Name = "Arial"
      .Size = 12
      .Italic = True
   End With

   LBHS.Init List1

   For i = 1 To Val(txtItemCnt)
      lStrLen = Int(Rnd * 50) + 1
      LBHS.AddItem String(lStrLen, "W") + "!"
   Next
End Sub

Downloads