Visual Basic Combo API
GetTextExtentPoint32: Change Combo List Width Based on Contents
     
Posted:   Friday July 10, 1998
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB5, Windows 98
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

SendMessage: Change Combo Box List Width
       
 Prerequisites
None.

Like the routine in SendMessage: Change Combo Box List Width, this routine performs the same functionality but adds the ability to resize the list at runtime.  By calculating the average width of a character in the listbox based on the current font, the dropdown width can change to accommodate the longest string whenever the sizing routine is called.

You can use the form from the routine above, or create a new one. The form specifics are the same, but this method adds another command button ... Command2. Again, in the form load event, add code to load several combo items of varying length making sure that some are longer than the control's width.

 BAS Module Code
None.

 Form Code
Add a combo, text box and three command buttons, using the control's default names. Command3 holds a standard unload command. Add the following code to the form:

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 Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Long) As Long

Private Const CB_GETLBTEXTLEN = &H149
Private Const CB_SHOWDROPDOWN = &H14F
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const CB_SETDROPPEDWIDTH = &H160

Private Const ANSI_FIXED_FONT = 11
Private Const ANSI_VAR_FONT = 12
Private Const SYSTEM_FONT = 13
Private Const DEFAULT_GUI_FONT = 17 'win95/98 only

Private Const SM_CXHSCROLL = 21
Private Const SM_CXHTHUMB = 10
Private Const SM_CXVSCROLL = 2

Private Type SIZE
  cx As Long
  cy As Long
End Type

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

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_CALCRECT = &H400

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

Private Declare Function GetTextExtentPoint32 Lib "gdi32" _
    Alias "GetTextExtentPoint32A" _
   (ByVal hDC As Long, _
    ByVal lpsz As String, _
    ByVal cbString As Long, _
    lpSize As SIZE) As Long

Private Declare Function GetStockObject Lib "gdi32" _
  (ByVal nIndex As Long) As Long
  
Private Declare Function DeleteObject Lib "gdi32" _
  (ByVal hObject As Long) As Long
  
Private Declare Function ReleaseDC Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal hDC As Long) As Long
   
Private Declare Function GetDC Lib "user32" _
  (ByVal hwnd As Long) As Long
  
Private Declare Function GetSystemMetrics Lib "user32" _
  (ByVal nIndex As Long) As Long


Private Function GetFontDialogUnits() As Long

   Dim hFont As Long
   Dim hFontOld As Long
   Dim avgWidth As Long
   Dim hDc As Long
   Dim tmp As String
   Dim sz As SIZE
   
  'get the hdc to the main window  
   hDc = GetDC(Form1.hwnd)
   
  'with the current font attributes, select the font  
   hFont = GetStockObject(ANSI_VAR_FONT)
   hFontOld = SelectObject(hDc, hFont&)
   
  'get its length, then calculate the average character width  
   tmp = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
   GetTextExtentPoint32(hDc, tmp, 52, sz)
   avgWidth = (sz.cx \ 52)
   
  're-select the previous font & delete the hDc  
   SelectObject(hDc, hFontOld)
   DeleteObject(hFont)
   ReleaseDC(Form1.hwnd, hDc)
   
  'return the average character width  
   GetFontDialogUnits = avgWidth

End Function
         

Private Sub Command1_Click()

   Dim cwidth As Long
   Dim NewDropDownWidth As Long
   
  'check if a number is entered into Text1. 
  'If not, bail out.
   If Val(Text1.Text) Then
     'here we simply set the dropdown list size to 
     'the value entered in Text1. Note: If the proposed 
     'width this is less than the width of the combo
     'portion, the combo width is used (the dropdown 
     'can never be narrower than the combo box)
      NewDropDownWidth = Val(Text1.Text)
   
     'resize the dropdown portion of the combo box using SendMessage
      Call SendMessage(Combo1.hwnd, CB_SETDROPPEDWIDTH, NewDropDownWidth, ByVal 0)
   
     'reflect the new dropdown list width in the Label   
      cwidth = SendMessage(Combo1.hwnd, CB_GETDROPPEDWIDTH, 0, ByVal 0)
      Label1.Caption = "Current dropdown width = " & cwidth & " pixels."
   
     'drop the list down by code to show the new size   
      Call SendMessage(Combo1.hwnd, CB_SHOWDROPDOWN, True, ByVal 0)
      
   End If

End Sub


Private Sub Command2_Click()

   Dim cwidth As Long
   Dim cnt As Long
   Dim NumOfChars As Long
   Dim LongestComboItem As Long
   Dim avgCharWidth As Long
   Dim NewDropDownWidth As Long
   
  'loop through the combo entries, using SendMessage
  'with CB_GETLBTEXTLEN to determine the longest item
  'in the dropdown portion of the combo   

   For cnt = 0 To Combo1.ListCount - 1

      NumOfChars = SendMessage(Combo1.hwnd, CB_GETLBTEXTLEN, cnt, ByVal 0)
      
      If NumOfChars > LongestComboItem Then LongestComboItem = NumOfChars

   Next
   
  'get the average size of the characters using the 
  'GetFontDialogUnits API. Because a dummy string is 
  'used in GetFontDialogUnits, avgCharWidth is an 
  'approximation based on that string.   
   avgCharWidth = GetFontDialogUnits()
   
  'compute the size the dropdown needs to be to accommodate
  'the longest string. Here I subtract 2 because I find that
  'on my system, using the dummy string in GetFontDialogUnits,
  'the width is just a bit too wide.   
   NewDropDownWidth = (LongestComboItem - 2) * avgCharWidth
   
  'resize the dropdown portion of the combo box   
   Call SendMessage(Combo1.hwnd, CB_SETDROPPEDWIDTH, NewDropDownWidth, ByVal 0)
   
  'reflect the new dropdown list width in Label2 and in Text1   
   cwidth = SendMessage(Combo1.hwnd, CB_GETDROPPEDWIDTH, 0, ByVal 0)

   Label1.Caption = "Current dropdown width = " & cwidth & " pixels."
   Text1.Text = cwidth
   
  'finally, drop the list down by code to show the new size   
   Call SendMessage(Combo1.hwnd, CB_SHOWDROPDOWN, True, ByVal 0)

End Sub
 Comments
Run the app, and then press the Command2 command button. The combo will resize to accommodate the longest item, and dropdown automatically. If not exactly perfect, use the Command1 button with the value returned into the textbox to tweak to your liking.

This routine is resolution-independent. The value set by the API calls in determining the NewDropDownWidth will produce the exact same results on 640x480 and 1024x768, that is, if it sizes the dropdown perfectly at 640, it will size it perfectly at 1024.

If your application uses a combo box to display data that you provide, and you therefore always know what the length of the longest item will be, you can use the simpler method detailed in Changing Combo Dropdown Width.

 
 

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