Horizontal scroll bar for combobox

By default a combobox does not have horizontal scroll
bar when text contained in it is longer than the width
of the combobox. I( have researched and found that the send message api
function passing the constant
CB_SETHORIZONTALEXTEND is suposed to insert a scroll bar if the length of the longest string is longer than the width of the combobox. I doesnt seem to work. Does anybody have any information on how to set a horizontal scrollbar for a combobox.

I don't know about a horizontal scrollbar, but you can use this to have the combo box expand to the length of its longest entry.

VB Code:

Private Declare Function SendMessageLong 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 Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const DT_CALCRECT = &H400
 
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
 
Private Function AutosizeCombo(CB As ComboBox) As Boolean
 
'Automatically sizes a combo box to the longest item within it
 
    Dim LongReturn As Long
    Dim CurrentCBWidth As Single
    Dim TheCBItems As RECT
    Dim ParentHdc As Long
    Dim MyListCount As Long
    Dim MyLongCounter As Long
    Dim TempCBWidth As Long
    Dim LongWidth As Long
    Dim SavedFont As String
    Dim SavedSize As Single
    Dim SavedBold As Boolean
    Dim SavedItalic As Boolean
    Dim SavedUnderline As Boolean
    Dim IsFontSaved As Boolean
 
On Error GoTo ErrorHandler
 
    'Grab the combo handle and list count
    ParentHdc = CB.Parent.hdc
    MyListCount = CB.ListCount
    
    If ParentHdc = 0 Or MyListCount = 0 Then Exit Function
 
    'Save combo box fonts, etc. to the parent object(form), for testing lengths with the API
    'My personal contribution
    With CB.Parent
        SavedFont = .FontName
        SavedSize = .FontSize
        SavedBold = .FontBold
        SavedItalic = .FontItalic
        SavedUnderline = .FontUnderline
        .FontName = CB.FontName
        .FontSize = CB.FontSize
        .FontBold = CB.FontBold
        .FontItalic = CB.FontItalic
        .FontUnderline = CB.FontUnderline
    End With
 
    IsFontSaved = True
 
    'Get the width of the widest item
    For MyLongCounter = 0 To MyListCount
        DrawText ParentHdc, CB.List(MyLongCounter), -1, TheCBItems, DT_CALCRECT
        'Add twenty to the the number as a margin
        TempCBWidth = TheCBItems.Right - TheCBItems.Left + 20
         If (TempCBWidth > LongWidth) Then
            LongWidth = TempCBWidth
         End If
    Next
 
    'Get current width of combo
    CurrentCBWidth = SendMessageLong(CB.hwnd, CB_GETDROPPEDWIDTH, 0, 0)
 
    'If big enough then that's all A-OK
    If CurrentCBWidth > LongWidth Then
        AutosizeCombo = True
        GoTo ErrorHandler
        Exit Function
    End If
 
    '... but if not big enough, first calculate the screen width to ensure we don't exceed it!
    If LongWidth > Screen.Width \ Screen.TwipsPerPixelX - 20 Then _
        LongWidth = Screen.Width \ Screen.TwipsPerPixelX - 20
 
    'Set the width of our combo
    LongReturn = SendMessageLong(CB.hwnd, CB_SETDROPPEDWIDTH, LongWidth, 0)
 
    'Set the function to True/False depending on API success
    AutosizeCombo = LongReturn > 0
    
ErrorHandler:
        
    'If anything blows up, reset the combo to its original state
    On Error Resume Next
    
    If IsFontSaved Then
      With CB.Parent
        .FontName = SavedFont
        .FontSize = SavedSize
        .FontUnderline = SavedUnderline
        .FontBold = SavedBold
        .FontItalic = SavedItalic
     End With
   End If
 
End Function
 
'Usage:  In the dropdown even of the combo box, place this code
'Dim x
'x = AutosizeCombo(Combo1)

I haven't tested it, but it may work :rolleyes:

VB Code:

Private Declare Function ShowScrollBar Lib "user32" Alias "ShowScrollBar" (ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
Private Const SB_BOTH = 3
Private Const SB_HORZ = 0
Private Const SB_VERT = 1
ShowScrollBar Combo1.hwnd, SB_BOTH, 1