Anyone know how to set the height of a combo box drop down when the combo box is inside a frame???
Thanks
Paul
Printable View
Anyone know how to set the height of a combo box drop down when the combo box is inside a frame???
Thanks
Paul
To change the drop down height of a combobox, use the MoveFile API function.
Code:Public Declare Function MoveWindow Lib "user32" _
(ByVal hwnd As Long, ByVal x As Long, ByVal y As _
Long, ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Public Sub SetComboHeight(oComboBox As ComboBox, _
lNewHeight As Long)
Dim oldscalemode As Integer
' This procedure does not work with frames: you
' cannot set the ScaleMode to vbPixels, because
' the frame does not have a ScaleMode Property.
' To get round this, you could set the parent control
' to be the form while you run this procedure.
If TypeOf oComboBox.Parent Is Frame Then Exit Sub
' Change the ScaleMode on the parent to Pixels.
oldscalemode = oComboBox.Parent.ScaleMode
oComboBox.Parent.ScaleMode = vbPixels
' Resize the combo box window.
MoveWindow oComboBox.hwnd, oComboBox.Left, _
oComboBox.Top, oComboBox.Width, lNewHeight, 1
' Replace the old ScaleMode
oComboBox.Parent.ScaleMode = oldscalemode
End Sub
Usage
Call SetComboHeight(Combo1, 1450)
That code doesn't work when the combo box is in a frame, it even says that in the middle of the code. Its says I can set the form as the parent during the procedure, but I have no idea how to do that. Does anybody know how???
This worked for me [edit: outside of a frame]
Just to think, you posted something like a bazillion years ago. and it helps me here in 2023!
@clickman---
I just keep the following in a Module (to add to any project I desire). I 'call' the function like this:
Code:SetDropDownHeight Me, Combo2, 13
Code:Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Const CB_GETITEMHEIGHT As Long = &H154
'---------------------------------------------------------------------------------
Public Sub SetDropDownHeight(pobjForm As Form, _
pobjCombo As ComboBox, _
plngNumItemsToDisplay As Long)
'---------------------------------------------------------------------------------
Dim pt As POINTAPI
Dim rc As RECT
Dim lngSavedWidth As Long
Dim lngNewHeight As Long
Dim lngOldScaleMode As Long
Dim lngItemHeight As Long
lngSavedWidth = pobjCombo.width
lngOldScaleMode = pobjForm.ScaleMode
pobjForm.ScaleMode = vbPixels
lngItemHeight = SendMessage(pobjCombo.hWnd, CB_GETITEMHEIGHT, 0, ByVal 0)
lngNewHeight = lngItemHeight * (plngNumItemsToDisplay + 2)
Call GetWindowRect(pobjCombo.hWnd, rc)
pt.x = rc.Left
pt.y = rc.Top
Call ScreenToClient(pobjForm.hWnd, pt)
Call MoveWindow(pobjCombo.hWnd, pt.x, pt.y, pobjCombo.height, lngNewHeight, True)
pobjForm.ScaleMode = lngOldScaleMode
pobjCombo.width = lngSavedWidth
End Sub
#1 What is the 13? Is that the number of items you want to have shown? I am thinking that it is based on the code itself.
#2 This too, does not work if the combobox is inside a frame. Correct???
13 is simply an EXAMPLE of showing the first 13 items in the combobox. Yes, it DOES work within a frame.
Yes, you can set that "13" to some other number based upon your code. Use a variable.
And, of course, you can 'reset' that variable depending upon how many you want see visible when the box is selected. For example, if you use the same combobox for displaying other lists, you clear it, add the stuff to it, and then set that number to whatever you desire.
Sammi
How about that.
Sure enough it does work inside a frame. Now to figure out why it is not "working" inside my frame.
Got it on setting the number of items using a variable.
Thanks
A slightly better version of the above, no need to send the Form as a parameter, and it works inside and outside a frame.
Code:Private Declare Function GetParent Lib "user32.dll" (ByVal hwnd As Long) As Long
Public Sub SetDropDownHeight(pobjCombo As ComboBox, plngNumItemsToDisplay As Long)
Dim pt As POINTAPI
Dim rc As RECT
Dim lngNewHeight As Long
Dim lngItemHeight As Long
Dim hParent As Long
hParent = GetParent(pobjCombo.hwnd)
lngItemHeight = SendMessage(pobjCombo.hwnd, CB_GETITEMHEIGHT, 0, ByVal 0)
lngNewHeight = lngItemHeight * (plngNumItemsToDisplay + 2)
Call GetWindowRect(pobjCombo.hwnd, rc)
pt.x = rc.Left
pt.y = rc.Top
Call ScreenToClient(hParent, pt)
Call MoveWindow(pobjCombo.hwnd, pt.x, pt.y, rc.Right - rc.Left, lngNewHeight, 1)
End Sub
Humm .. throwing error..
Click the "Help" button to the right of the "OK" button in that message box. It will tell you how to fix it.
Here is full code:
Code:Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetParent Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Const CB_GETITEMHEIGHT As Long = &H154&
Public Sub SetDropDownHeight(pobjCombo As ComboBox, plngNumItemsToDisplay As Long)
Dim pt As POINTAPI
Dim rc As RECT
Dim lngNewHeight As Long
Dim lngItemHeight As Long
Dim hParent As Long
hParent = GetParent(pobjCombo.hwnd)
lngItemHeight = SendMessage(pobjCombo.hwnd, CB_GETITEMHEIGHT, 0, ByVal 0)
lngNewHeight = lngItemHeight * (plngNumItemsToDisplay + 2)
Call GetWindowRect(pobjCombo.hwnd, rc)
pt.x = rc.Left
pt.y = rc.Top
Call ScreenToClient(hParent, pt)
Call MoveWindow(pobjCombo.hwnd, pt.x, pt.y, rc.Right - rc.Left, lngNewHeight, 1)
End Sub
Here is code to set the cbo width automatically based on the length of the longest item in the cbo, AND to set the height.
Steps:
Create a form
Add a Frame
In the Frame add a combobox named cboName
( I don't think you need a frame I i was just demoing to myself that it could be done inside a frame as mentioned earlier by Dry Bone
Paste in the following code
Code:Option Explicit
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const DT_CALCRECT = &H400
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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 Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetParent Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Const CB_GETITEMHEIGHT As Long = &H154&
Public Function SetDropDownHeight(pobjCombo As ComboBox, plngNumItemsToDisplay As Long)
Dim pt As POINTAPI
Dim rc As RECT
Dim lngNewHeight As Long
Dim lngItemHeight As Long
Dim hParent As Long
hParent = GetParent(pobjCombo.hwnd)
lngItemHeight = SendMessage(pobjCombo.hwnd, CB_GETITEMHEIGHT, 0, ByVal 0)
lngNewHeight = lngItemHeight * (plngNumItemsToDisplay + 2)
Call GetWindowRect(pobjCombo.hwnd, rc)
pt.x = rc.Left
pt.y = rc.Top
Call ScreenToClient(hParent, pt)
Call MoveWindow(pobjCombo.hwnd, pt.x, pt.y, rc.Right - rc.Left, lngNewHeight, 1)
End Function
Public Function AutoSizeDropDownWidth(cboName As Object) As Boolean
'**************************************************************
'PURPOSE: Automatically size the cboName box drop down width
' based on the width of the longest item in the cboName box
'PARAMETERS: cboName - cboNameBox to size
'RETURNS: True if successful, false otherwise
'ASSUMPTIONS: 1. Form's Scale Mode is vbTwips, which is why
' conversion from twips to pixels are made.
' API functions require units in pixels
'
' 2. cboName Box's parent is a form or other
' container that support the hDC property
'See ...https://www.freevbcode.com/ShowCode.asp?ID=1800
'****************************************************************
'EXAMPLE: AutoSizeDropDownWidth cboName
'****************************************************************
Dim lRet As Long
Dim bAns As Boolean
Dim lCurrentWidth As Single
Dim rectCboText As RECT
Dim lParentHDC As Long
Dim lListCount As Long
Dim lCtr As Long
Dim lTempWidth As Long
Dim lWidth As Long
Dim sSavedFont As String
Dim sngSavedSize As Single
Dim bSavedBold As Boolean
Dim bSavedItalic As Boolean
Dim bSavedUnderline As Boolean
Dim bFontSaved As Boolean
On Error GoTo ErrorHandler
100 If Not TypeOf cboName Is ComboBox Then Exit Function
102 lParentHDC = cboName.Parent.hdc
104 If lParentHDC = 0 Then Exit Function
106 lListCount = cboName.ListCount
108 If lListCount = 0 Then Exit Function
'Change font of parent to cboName box's font
'Save first so it can be reverted when finished
'this is necessary for drawtext API Function
'which is used to determine longest string in cboName box
110 With cboName.Parent
112 sSavedFont = .FontName
114 sngSavedSize = .FontSize
116 bSavedBold = .FontBold
118 bSavedItalic = .FontItalic
120 bSavedUnderline = .FontUnderline
122 .FontName = cboName.FontName
124 .FontSize = cboName.FontSize
126 .FontBold = cboName.FontBold
128 .FontItalic = cboName.FontItalic
130 .FontUnderline = cboName.FontItalic
End With
132 bFontSaved = True
'Get the width of the largest item
134 For lCtr = 0 To lListCount
136 DrawText lParentHDC, cboName.List(lCtr), -1, rectCboText, _
DT_CALCRECT
'adjust the number added (20 in this case to
'achieve desired right margin
138 lTempWidth = rectCboText.Right - rectCboText.Left + 20
140 If (lTempWidth > lWidth) Then
142 lWidth = lTempWidth
End If
Next
144 lCurrentWidth = SendMessageLong(cboName.hwnd, CB_GETDROPPEDWIDTH, _
0, 0)
146 If lCurrentWidth > lWidth Then 'current drop-down width is
' sufficient
148 AutoSizeDropDownWidth = True
150 GoTo ErrorHandler
Exit Function
End If
'don't allow drop-down width to
'exceed screen.width
152 If lWidth > Screen.Width \ Screen.TwipsPerPixelX - 20 Then _
lWidth = Screen.Width \ Screen.TwipsPerPixelX - 20
154 lRet = SendMessageLong(cboName.hwnd, CB_SETDROPPEDWIDTH, lWidth, 0)
156 AutoSizeDropDownWidth = lRet > 0
ErrorHandler:
On Error Resume Next
158 If bFontSaved Then
'restore parent's font settings
160 With cboName.Parent
162 .FontName = sSavedFont
164 .FontSize = sngSavedSize
166 .FontUnderline = bSavedUnderline
168 .FontBold = bSavedBold
170 .FontItalic = bSavedItalic
End With
End If
End Function
Private Sub Form_Load()
With cboName
.AddItem ("Set 01")
.AddItem ("Set 02")
.AddItem ("Set 03")
.AddItem ("Fake Name Billy 41")
.AddItem ("Fake Name Billy 5")
.AddItem ("Fake Name Billy 6")
.AddItem ("Fake Name Billy 7")
.AddItem ("Fake Name Billy 8")
.AddItem ("Fake Name Billy 9")
.AddItem ("Fake Name Billy 10")
.AddItem ("Fake Name Billy 11")
.AddItem ("Fake Name Billy 12")
.AddItem ("Fake Name Billy 13")
.AddItem ("Fake Name Billy 14")
.AddItem ("Fake Name Billy 15")
.AddItem ("Fake Name Billy 16")
.AddItem ("Fake Name Billy 17")
.AddItem ("Fake Name Billy 18")
.AddItem ("Fake Name Billy Bob Jenkins 19")
End With
Call SetDropDownHeight(cboName, 19)
Call AutoSizeDropDownWidth(cboName)
End Sub
A ComboBox is divided into to two different controls...a dropdown control and a listcontrol.
For setting the totalheight for dropdownlist you have to use the hWnd to the Listcontrol part.
If you are a using a existant control from an OCX in the toolbox there should be a "Handle" to the the list itself.
If you are creating a ComboBoxEx (Common Controls Version) from code using CreateWindowEx ("ComboBoxEx32" class) you have regarding to MSDN a message to get the handle to the listcontrol. (This message even applies to ComboBoxEx from OCX (Toolbox).
This message gets the handle to the dropdopdownlist CBEM_GETCOMBOCONTROL and this message CBEM_GETEDITCONTROL gets the handle to the upper part (with the arrow button the right)
Why making such a repeat?
Why not just making an enumeration?
For i = 1 to 100
.Additem ("Fake Name Billy " & i )
Call SetDropDownHeight(cboName, i)
Next i
And finally Call SetDropDownHeight(cboName, ListItem.Count)
Call AutoSizeDropDownWidth(cboName)
Finally when all Items are collected...send CB_SETITEMHEIGHT * iItems
And for convineince I suggest you to ONLY use ComboBoxEx (Both ListBox and ComboBox in one control) instead of ListBox or ComboBox because when things turns 64bit these old controls will vanish and become prohibited by Win64 and banned. The ComboBoxEx will support 64bit as far as I know.
Quote:
Originally Posted by nebeln
Yes, for the example I posted, when all the names are ("Fake Name Billy " & i ) that works. In the case where every name is different, the .AddItem ""item" will be different, and require separate .AddItems. Your point is well taken, and useful to remind folks of, however.
Yourfollows SamOscarBrowns comment. Thanks for showing that tweak.Code:Call SetDropDownHeight(cboName, ListItem.Count)