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