Visual Basic Codes
Visual Basic > Forms sample source codes

Get and set the list area width of a combo box

Get and set the list area width of a combo box

The following code will set and get the width of the list area of a combo box.


Option Explicit
'Combo set width API/Structure and constants
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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 Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type


'Purpose     :  Sets the width of the list area of a combobox.
'Inputs      :  cmbWidth                        The combo to set the list area.
'               lWidth                          The width in pixels of the list area.
'                                               Note: Must be greater than the combo width.
'Outputs     :  N/A
'Notes       :  In units of pixels


Sub ComboSetListWidth(ByRef cmbWidth As ComboBox, ByVal lWidth As Long)
    Const CB_SETDROPPEDWIDTH = &H160
    Call SendMessage(cmbWidth.hwnd, CB_SETDROPPEDWIDTH, lWidth, ByVal 0&)
End Sub


'Purpose     :  Returns the width of the list area of a combobox
'Inputs      :  cmbWidth                        The combo to determine the list area.
'Outputs     :  The list area width
'Notes       :  In units of pixels


Function ComboGetListWidth(ByRef cmbWidth As ComboBox) As Long
    Const CB_GETDROPPEDWIDTH = &H15F
    ComboGetListWidth = SendMessage(cmbWidth.hwnd, CB_GETDROPPEDWIDTH, 0, 0)
End Function

'Purpose     :  Autofits the width of the drop down in a combo box
'Inputs      :  cmbWidth                        The combo to autofit.
'               [lMaxWidth]                     The max width to set the drop down.
'Outputs     :  N/A

'Notes       :  The CB_SETDROPPEDWIDTH call will not make the list
'               area smaller than the combo box. Does NOT work on MDI combos.


Public Sub ComboAutoFitWidth(ByRef cmbWidth As ComboBox, Optional ByVal lMaxWidth = -1)
    Dim lThisItem As Long, lTestWidth As Long, lWidth As Long
    Dim tItemDetails As RECT
    Dim lHDC As Long, oContainerFont As StdFont
    Const DT_CALCRECT = &H400

    On Error Goto ErrFailed

    If lMaxWidth <= 0 Then
        'Set the max width the the screen width
        lMaxWidth = Screen.Width \ Screen.TwipsPerPixelX
    End If
    
    'As the combo doesn't give us an HDC we must
    'copy it's font information to its container
    'then evaluate the item widths on the container.
    With cmbWidth.Parent
        lHDC = .hdc
        'Store container's font
        Set oContainerFont = .Font
        'Copy combo's font to container
        Set .Font = cmbWidth.Font
    End With
    
    'Look for the largest item
    For lThisItem = 0 To cmbWidth.ListCount - 1
        DrawText lHDC, cmbWidth.List(lThisItem), -1, tItemDetails, DT_CALCRECT
        lTestWidth = tItemDetails.Right - tItemDetails.Left + 22     'Include space for a verical scroll bar
        If (lTestWidth > lWidth) Then
            lWidth = lTestWidth
        End If
    Next
        
    'Reset container font
    Set cmbWidth.Parent.Font = oContainerFont
    Set oContainerFont = Nothing
    
    If (lWidth > lMaxWidth) Then
        'Max width exceeded
        lWidth = lMaxWidth
    End If
    
    'Set the min. list width of the combo 
    '(if the combo is wider than this, the list width
    'will be the greater of the two
    ComboSetListWidth cmbWidth, lWidth
    Exit Sub

ErrFailed:
    Debug.Print "Failed to autofit combo: " & Err.Description
    Debug.Assert False
End Sub


'Demonstration routine
Private Sub Command1_Click()
    Dim sNewText As String
    sNewText = InputBox("Add new combo text", , Combo1.Text)
    If Len(sNewText) Then
        Combo1.AddItem sNewText
        ComboAutoFitWidth Combo1
    End If
End Sub