Happy Codings - Programming Code Examples
Html Css Web Design Sample Codes CPlusPlus Programming Sample Codes JavaScript Programming Sample Codes C Programming Sample Codes CSharp Programming Sample Codes Java Programming Sample Codes Php Programming Sample Codes Visual Basic Programming Sample Codes


Visual Basic Programming Code Examples

Visual Basic > Forms Code Examples

Get and set the list area width of a combo box

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
Get and set the list area width of a combo box 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 'Notes : In units of pixels 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 'Notes : In units of pixels 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 'Notes : The CB_SETDROPPEDWIDTH call will not make the list ' area smaller than the combo box. Does NOT work on MDI combos. 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