[VBnet List API] SendMessage: Display the List Box Horizontal Scroll Bar if Needed


	Visual Basic List API Routines SendMessage: Display the List Box Horizontal Scroll Bar if Needed

Posted:	Thursday October 7, 1999
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows NT4
OS restrictions:	None
Author:	VBnet - Randy Birch

Related:	SendMessage: Display the List Box Horizontal Scroll Bar SendMessage: Align List Box Contents Using Tabstops VBnet CoolTabs

Prerequisites

None.

This routine takes the basic method used in SendMessage: Display the List Box Horizontal Scroll Bar, adding a new Add method for list boxes.

By calling AddItemToList, rather than the regular list's AddItem method, the horizontal scrollbar extent is always increased whenever a longer string is added to the control. The current width of the control is stored in the list's Tag property. This provides a simple mechanism to always ensure that the user can scroll across to see the widest list item.

To use the demo, type a string into the textbox (or select a list item). Increase its width, and hit Add.

BAS Module Code

Place the following code into the general declarations area of a bas module:

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Const LB_GETHORIZONTALEXTENT = &H193
Public Const LB_SETHORIZONTALEXTENT = &H194
Public Const DT_CALCRECT = &H400
Public Const SM_CXVSCROLL = 2

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

Public 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
   
Declare Function GetSystemMetrics Lib "user32" _
  (ByVal nIndex As Long) As Long

Public Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Form Code

Add a list (List1), textbox (Text1), label (Label1) and a command button (Command1) to a form, along with the following code:

Option Explicit

Private Sub Form_Load()

   Call AddItemToList(List1, "Ministry of Agriculture and Food")
   Call AddItemToList(List1, "Ministry of the Attorney General")
   Call AddItemToList(List1, "Ministry of Community, City and Social Services")
   Call AddItemToList(List1, "Ministry of Education")
   Call AddItemToList(List1, "Ministry of the Environment")
   Call AddItemToList(List1, "Ministry of Health and Long-Term Care")
   Call AddItemToList(List1, "Ministry of Housing")
 
End Sub


Private Sub Command1_Click()

   Dim newIndex As Long
   
   newIndex = AddItemToList(List1, Text1.Text)
   
  'an 'EnsureVisible' method for the listbox
   List1.TopIndex = newIndex
   Label1.Caption = "Item " & newIndex & " added"
   
End Sub


Private Sub List1_Click()

   Text1.Text = List1.List(List1.ListIndex)
   
End Sub


Private Function AddItemToList(ctl As Control, _
                               sNewItem As String, _
                               Optional dwNewItemData As Variant) As Long

   Dim c As Long
   Dim rcText As RECT
   Dim newWidth As Long
   Dim currWidth As Long
   Dim sysScrollWidth As Long
   
   Dim tmpFontName As String
   Dim tmpFontSize As Long
   Dim tmpFontBold As Boolean
   
  'get the current width used
   If Len(ctl.Tag) > 0 Then
      currWidth = CLng(ctl.Tag)
   End If
   
  'determine the needed width for the new item
  'save the font properties to tmp variables
   tmpFontName = Form1.Font.Name
   tmpFontSize = Form1.Font.Size
   tmpFontBold = Form1.Font.Bold
   
   Form1.Font.Name = List1.Font.Name
   Form1.Font.Size = List1.Font.Size
   Form1.Font.Bold = List1.Font.Bold
   
  'get the width of the system scrollbar
   sysScrollWidth = GetSystemMetrics(SM_CXVSCROLL)
   
  'use DrawText/DT_CALCRECT to determine item length
   Call DrawText(Form1.hDC, sNewItem, -1&, rcText, DT_CALCRECT)
   newWidth = rcText.Right + sysScrollWidth
   
  'if this is wider than the current setting,
  'tweak the list and save the new horizontal
  'extent to the tag property
   If newWidth > currWidth Then
      
      Call SendMessage(List1.hwnd, _
                       LB_SETHORIZONTALEXTENT, _
                       newWidth, _
                       ByVal 0&)
                       
      ctl.Tag = newWidth
      
   End If
   
  'restore the form font properties
   Form1.Font.Name = tmpFontName
   Form1.Font.Bold = tmpFontBold
   Form1.Font.Size = tmpFontSize
   
  'add the items to the control, and 
  'add the ItemData if supplied
   ctl.AddItem sNewItem
   
   If Not IsMissing(dwNewItemData) Then
      If IsNumeric(dwNewItemData) Then
         ctl.ItemData(ctl.newIndex) = dwNewItemData
      End If
   End If
   
  'return the new index as the function result
   AddItemToList = ctl.newIndex

End Function

Comments

This routine calculates in pixels, and so is resolution-independent. This routine will produce the exact same results on all display resolutions. That is to say, if a horizontal scrollbar is needed at 640x480, it will correctly determine if one is needed at 1024x768.

If you don't need the functionality shown here, see SendMessage: Display the List Box Horizontal Scroll Bar.

PayPal Link