ModHeightCBox




Public 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
Public Const CB_GETLBTEXTLEN = &H149
Public Const CB_SHOWDROPDOWN = &H14F
Public Const CB_GETDROPPEDWIDTH = &H15F
Public Const CB_SETDROPPEDWIDTH = &H160
'APIs to set determine the font width

Public Type SIZE
cx As Long
cy As Long
End Type
Public Declare Function SelectObject Lib "gdi32" _
(ByVal hDc As Long, ByVal hObject As Long) As Long
Public Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A _
(ByVal hDc As Long, ByVal lpsz As String,
ByVal cbString As Long, lpSize As SIZE) As Long
Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDc As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Const ANSI_FIXED_FONT = 11
Public Const ANSI_VAR_FONT = 12
Public Const SYSTEM_FONT = 13
Public Const DEFAULT_GUI_FONT = 17 'win95 only
Add the following code to the bas module:
Public Function GetFontDialogUnits() As Long
Dim hFont As Long
Dim hFontOld As Long
Dim r 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 it's length, then calculate the average character width

tmp = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
r = GetTextExtentPoint32(hDc, tmp, 52, sz)
avgWidth = (sz.cx \ 52)

're-select the previous font & delete the hDc

r = SelectObject(hDc, hFontOld)
r = DeleteObject(hFont)
r = ReleaseDC(Form1.hwnd, hDc)

'return the average character width

GetFontDialogUnits = avgWidth
End Function

Add the following code to the form:
Private Sub cmdAdjManual_Click()
Dim r As Long
Dim NewDropDownWidth As Long

'first, check if a number is entered into Text1. If not, bail out.

If Val(Text1) <= 0 Then Exit Sub
'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 combobox)

NewDropDownWidth = Val(Text1)

'resize the dropdown portion of the combo box using SendMessageLong

r = SendMessageLong(Combo1.hwnd, CB_SETDROPPEDWIDTH, NewDropDownWidth, 0)

'reflect the new dropdown list width in the Label

r = SendMessageLong(Combo1.hwnd, CB_GETDROPPEDWIDTH, 0, 0)
Label1 = "Current dropdown width = " & r & " pixels."

'Finally, drop the list down by code to show the new size

r = SendMessageLong(Combo1.hwnd, CB_SHOWDROPDOWN, True, 0)
End Sub

Private Sub cmdAdjCombol_Click()
Dim r As Long
Dim i As Long
Dim NumOfChars As Long
Dim LongestComboItem As Long
Dim avgCharWidth As Long
Dim NewDropDownWidth As Long

'loop through the combo entries, using SendMessageLong

'with CB_GETLBTEXTLEN to determine the longest item

'in the dropdown portion of the combo

For i = 0 To Combo1.ListCount - 1
NumOfChars = SendMessageLong(Combo1.hwnd, CB_GETLBTEXTLEN, i, 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

r = SendMessageLong(Combo1.hwnd, CB_SETDROPPEDWIDTH, NewDropDownWidth, 0)

'reflect the new dropdown list width in Label2 and in Text1

r = SendMessageLong(Combo1.hwnd, CB_GETDROPPEDWIDTH, 0, 0)
Label1 = "Current dropdown width = " & r & " pixels."
Text1 = r

'finally, drop the list down by code to show the new size

r = SendMessageLong(Combo1.hwnd, CB_SHOWDROPDOWN, True, 0)
End Sub











( modheightcbox.html )- by Paolo Puglisi - Modifica del 17/12/2023