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