VB and VBA Users Source Code: Get and set the list area width of a combo box
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Get and set the list area width of a combo box
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Thursday, March 01, 2001
Hits:
775
Category:
Windows API
Article:
The following code will set and get the width of the list area of a combo box. Option Explicit 'Combo set width API/Structure and constants Private Declare Function SendMessage 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 Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type 'Purpose : Sets the width of the list area of a combobox. 'Inputs : cmbWidth The combo to set the list area. ' lWidth The width in pixels of the list area. ' Note: Must be greater than the combo width. 'Outputs : N/A 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : In units of pixels 'Assumptions : Sub ComboSetListWidth(ByRef cmbWidth As ComboBox, ByVal lWidth As Long) Const CB_SETDROPPEDWIDTH = &H160 Call SendMessage(cmbWidth.hwnd, CB_SETDROPPEDWIDTH, lWidth, ByVal 0&) End Sub 'Purpose : Returns the width of the list area of a combobox 'Inputs : cmbWidth The combo to determine the list area. 'Outputs : The list area width 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : In units of pixels 'Assumptions : Function ComboGetListWidth(ByRef cmbWidth As ComboBox) As Long Const CB_GETDROPPEDWIDTH = &H15F ComboGetListWidth = SendMessage(cmbWidth.hwnd, CB_GETDROPPEDWIDTH, 0, 0) End Function 'Purpose : Autofits the width of the drop down in a combo box 'Inputs : cmbWidth The combo to autofit. ' [lMaxWidth] The max width to set the drop down. 'Outputs : N/A 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : The CB_SETDROPPEDWIDTH call will not make the list ' area smaller than the combo box. Does NOT work on MDI combos. 'Assumptions : Public Sub ComboAutoFitWidth(ByRef cmbWidth As ComboBox, Optional ByVal lMaxWidth = -1) Dim lThisItem As Long, lTestWidth As Long, lWidth As Long Dim tItemDetails As RECT Dim lHDC As Long, oContainerFont As StdFont Const DT_CALCRECT = &H400 On Error Goto ErrFailed If lMaxWidth <= 0 Then 'Set the max width the the screen width lMaxWidth = Screen.Width \ Screen.TwipsPerPixelX End If 'As the combo doesn't give us an HDC we must 'copy it's font information to its container 'then evaluate the item widths on the container. With cmbWidth.Parent lHDC = .hdc 'Store container's font Set oContainerFont = .Font 'Copy combo's font to container Set .Font = cmbWidth.Font End With 'Look for the largest item For lThisItem = 0 To cmbWidth.ListCount - 1 DrawText lHDC, cmbWidth.List(lThisItem), -1, tItemDetails, DT_CALCRECT lTestWidth = tItemDetails.Right - tItemDetails.Left + 22 'Include space for a verical scroll bar If (lTestWidth > lWidth) Then lWidth = lTestWidth End If Next 'Reset container font Set cmbWidth.Parent.Font = oContainerFont Set oContainerFont = Nothing If (lWidth > lMaxWidth) Then 'Max width exceeded lWidth = lMaxWidth End If 'Set the min. list width of the combo '(if the combo is wider than this, the list width 'will be the greater of the two ComboSetListWidth cmbWidth, lWidth Exit Sub ErrFailed: Debug.Print "Failed to autofit combo: " & Err.Description Debug.Assert False End Sub 'Demonstration routine Private Sub Command1_Click() Dim sNewText As String sNewText = InputBox("Add new combo text", , Combo1.Text) If Len(sNewText) Then Combo1.AddItem sNewText ComboAutoFitWidth Combo1 End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
