This should be a good one.
In Access you are able to make the drop down list wider than the combo box itself to allow to show wider listings.
Can I do the same in vb. Some API call?
Any ideas?
Printable View
This should be a good one.
In Access you are able to make the drop down list wider than the combo box itself to allow to show wider listings.
Can I do the same in vb. Some API call?
Any ideas?
You can just set the columnwidths if you have multiple columns and the listwidth in design view. There should be properties for both there. That is IF you are using the Microsoft Forms Combo Box (which is what I use).
VB Code:
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 Const CB_SETDROPPEDWIDTH = &H160 Private Sub Command1_Click() 'set 500 as the new width Call SendMessage (Combo1.hWnd, CB_SETDROPPEDWIDTH, 500, 0) End Sub
I'm using the default combo box.
Thank you very much Serge.
One more thing,
Is there a way to position the drop down list on the screen.
By default it's left property is the same as the combo box's. Is there any way to change that?
Auto-size combo. Code from www.vbcodelibrary.com
VB Code:
Option Explicit 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 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 Sub Command1_Click() Dim x As Boolean x = AutosizeCombo(Combo1) End Sub Private Sub Form_Load() Combo1.AddItem "aaaaaaaaa" Combo1.AddItem "bbbbbbbbbbbbbbbbbbbbb" Combo1.AddItem "ccccc" Combo1.AddItem "eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee" End Sub Public Function AutosizeCombo(Combo As ComboBox) As Boolean 'Automatically sizes a combo box to 'hold the longest item within it Dim lngRet As Long Dim lngCurrentWidth As Single Dim rectCboText As RECT Dim lngParentHDC As Long Dim lngListCount As Long Dim lngCounter As Long Dim lngTempWidth As Long Dim lngWidth As Long Dim strSavedFont As String Dim sngSavedSize As Single Dim blnSavedBold As Boolean Dim blnSavedItalic As Boolean Dim blnSavedUnderline As Boolean Dim blnFontSaved As Boolean On Error GoTo ErrorHandler 'Grab the combo handle and list count lngParentHDC = Combo.Parent.hdc lngListCount = Combo.ListCount If lngParentHDC = 0 Or lngListCount = 0 Then Exit Function 'Save combo box fonts, etc. to the parent 'object (form), for testing lengths with the API With Combo.Parent strSavedFont = .FontName sngSavedSize = .FontSize blnSavedBold = .FontBold blnSavedItalic = .FontItalic blnSavedUnderline = .FontUnderline .FontName = Combo.FontName .FontSize = Combo.FontSize .FontBold = Combo.FontBold .FontItalic = Combo.FontItalic .FontUnderline = Combo.FontItalic End With blnFontSaved = True 'Get the width of the widest item For lngCounter = 0 To lngListCount DrawText lngParentHDC, Combo.List(lngCounter), -1, rectCboText, _ DT_CALCRECT 'Add twenty to the the number as a margin lngTempWidth = rectCboText.Right - rectCboText.Left + 20 If (lngTempWidth > lngWidth) Then lngWidth = lngTempWidth End If Next 'Get current width of combo lngCurrentWidth = SendMessageLong(Combo.hwnd, CB_GETDROPPEDWIDTH, _ 0, 0) 'If big enough then that's all A-OK If lngCurrentWidth > lngWidth 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 lngWidth > Screen.Width \ Screen.TwipsPerPixelX - 20 Then _ lngWidth = Screen.Width \ Screen.TwipsPerPixelX - 20 'Set the width of our combo lngRet = SendMessageLong(Combo.hwnd, CB_SETDROPPEDWIDTH, lngWidth, 0) 'Set the function to True/False depending on API success AutosizeCombo = lngRet > 0 ErrorHandler: 'If anything goes wrong, revert back! On Error Resume Next If blnFontSaved Then With Combo.Parent .FontName = strSavedFont .FontSize = sngSavedSize .FontUnderline = blnSavedUnderline .FontBold = blnSavedBold .FontItalic = blnSavedItalic End With End If End Function