ComboBox - ReSize Dropdown List To Fit Data

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc"
Global hDlg As Dword, MaxWidth As Long
 
Function PBMain() As Long
   Dim MyArray(3) As String
   Array Assign MyArray() = "zero", "one", "two", "three"
   Dialog New Pixels, 0, "ComboBox Test",300,300,200,200, %WS_SysMenu, 0 To hDlg
   Control Add Button, hDlg, 200, "Add", 10,10,100,20
   Control Add ComboBox, hDlg, 100, MyArray(), 50,50,75,100, %CBS_DropDown Or %CBS_AutoHScroll Or %WS_TabStop
   ComboBox Select hDlg, 100, 1
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         SetMaxWidth
      Case %WM_Command
         Select Case Cb.Ctl
            Case 200
               Local temp$
               Control Get Text hdlg, 100 To temp$
               ComboBox Add hDlg, 100, temp$
               SetMaxWidth
            Case 100
               Select Case Cb.CtlMsg
                  Case %CBN_SelChange
                     Control Post hDlg, 100, %CB_SetEditSel, 0, Mak(Long,0,0)
               End Select
         End Select
   End Select
End Function
 
Sub SetMaxWidth
   Local i, MaxWidth, iCount As Long, temp$
   ComboBox Get Count hDlg, 100 To iCount
   For i = 1 To iCount
      ComboBox Get Text hDlg, 100, i To temp$
      Maxwidth = Max(MaxWidth, GetTextWidth(temp$,GetDlgItem(hDlg,100)))
   Next i
   Control Send hDlg, 100, %CB_SetDroppedWidth, MaxWidth,0
End Sub
 
Function GetTextWidth(buf$, hWnd As Dword) As Single
   Local hDC,hFont As Dword, R As SizeL
   hDC = GetDC(hWnd)
   hFont = SendMessage (hWnd, %WM_GETFONT, 0, 0)
   SelectObject hDc, hFont
   GetTextExtentPoint32 (hDc, ByVal StrPtr(buf$), Len(buf$), R)
   Function = R.cx
   ReleaseDC hWnd, hDC
End Function
 
'gbs_01116
'Date: 03-10-2012

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm