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

Adding a horizontal scroll bar to a listbox

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 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171
Adding a horizontal scroll bar to a listbox If the text in a listbox is likely to exceed the width of the listbox, then use the following code to add items to the listbox. By using the routine below a horizontal scroll bar will be displayed if the width of the added item exceeds the width of the listbox. Option Explicit Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 'Purpose : Adds items to a listbox and if neccessary sets the ' width of the horizontal scroll bar to the maximum width of the ' items in the listbox. 'Inputs : lbListbox The listbox to add the item to. ' sItemText The text to add to the listbox. ' [iIndex] The position within the object where the new item or row is placed. 'Outputs : Returns True on success 'Notes : 'Revisions : 'Assumptions : Function ListboxAddItem(lbListbox As ListBox, sItemText As String, Optional iIndex As Integer = -1) as Boolean Dim fTextWidth As Single, fExistScrollWidth As Single Dim oParentFont As StdFont Const LB_SETHORIZONTALEXTENT = &H194, LB_GETHORIZONTALEXTENT = &H193 On Error Resume Next 'Add item to listbox If iIndex > -1 Then lbListbox.AddItem sItemText, iIndex Else lbListbox.AddItem sItemText End If 'Store the form's original font Set oParentFont = lbListbox.Parent.Font 'Set the form's font to the listbox's font Set lbListbox.Parent.Font = lbListbox.Font 'Get width of text on the form fTextWidth = lbListbox.Parent.TextWidth(sItemText & " ") 'Extra space allows for vertical scroll bar 'Restore the form's font Set lbListbox.Parent.Font = oParentFont 'Get the width of the existing scroll bar fExistScrollWidth = SendMessageA(lbListbox.hwnd, LB_GETHORIZONTALEXTENT, 0, 0) If lbListbox.Parent.ScaleMode = vbTwips Then 'Change twips to pixels fTextWidth = fTextWidth / Screen.TwipsPerPixelX End If If fTextWidth > fExistScrollWidth Then 'Increase width of scroll bar Call SendMessageA(lbListbox.hwnd, LB_SETHORIZONTALEXTENT, fTextWidth, 0) End If ListboxAddItem = (Err.Number = 0) End Function 'Purpose : Modifies the text of an item in a listbox and if neccessary sets the ' width of the horizontal scroll bar to the maximum width of the ' items in the listbox. 'Inputs : lbListbox The listbox to update the item in. ' sNewItemText The new text for the item in the listbox. ' [iIndex] The index of the item to update within the listbox. 'Outputs : Returns True on Success 'Notes : 'Revisions : 'Assumptions : Function ListboxUpdateItem(lbListbox As ListBox, sNewItemText As String, iIndex As Integer) As Boolean Dim fTextWidth As Single, fExistScrollWidth As Single Dim oParentFont As StdFont Const LB_SETHORIZONTALEXTENT = &H194, LB_GETHORIZONTALEXTENT = &H193 'Add item to listbox On Error GoTo ErrFailed If lbListbox.List(iIndex) <> sNewItemText Then lbListbox.List(iIndex) = sNewItemText 'Get width of text Set oParentFont = lbListbox.Parent.Font Set lbListbox.Parent.Font = lbListbox.Font fTextWidth = lbListbox.Parent.TextWidth(sNewItemText & " ") 'Extra space allows for vertical scroll bar Set lbListbox.Parent.Font = oParentFont fExistScrollWidth = SendMessageA(lbListbox.hwnd, LB_GETHORIZONTALEXTENT, 0, 0) If lbListbox.Parent.ScaleMode = vbTwips Then 'Change twips to pixels fTextWidth = fTextWidth / Screen.TwipsPerPixelX End If If fTextWidth > fExistScrollWidth Then 'Increase width of scroll bar Call SendMessageA(lbListbox.hwnd, LB_SETHORIZONTALEXTENT, fTextWidth, 0) End If End If ListboxUpdateItem = True Exit Function ErrFailed: Debug.Print "Error in ListboxAddItem: " & lbListbox.Name & " Description: " & Err.Description ListboxUpdateItem = False End Function 'Purpose : Adds a horizontal scroll bar to a listbox 'Inputs : lbListbox The listbox to add the scrollbar to. 'Outputs : Returns True on success 'Notes : 'Revisions : 'Assumptions : Function ListboxAddHorizontalScollBar(lbListbox As ListBox) As Boolean On Error GoTo ErrFailed Dim fTextWidth As Single Dim oParentFont As StdFont, fExistScrollWidth As Single Dim lThisListItem As Long, fMaxScollWidth As Single, lMaxTextLen As Long Const LB_SETHORIZONTALEXTENT = &H194, LB_GETHORIZONTALEXTENT = &H193 'Add item to listbox On Error GoTo ErrFailed 'Set the parent font Set oParentFont = lbListbox.Parent.font Set lbListbox.Parent.font = lbListbox.font Set lbListbox.Parent.font = oParentFont 'Determine max. length of text For lThisListItem = 0 To lbListbox.ListCount - 1 If Len(lbListbox.list(lThisListItem)) > lMaxTextLen Then lMaxTextLen = Len(lbListbox.list(lThisListItem)) End If Next 'Get the text length fTextWidth = lbListbox.Parent.TextWidth(String(lMaxTextLen + 1, "W")) 'Extra space allows for vertical scroll bar 'Restore the form's font Set lbListbox.Parent.font = oParentFont 'Get the width of the existing scroll bar fExistScrollWidth = SendMessage(lbListbox.hwnd, LB_GETHORIZONTALEXTENT, 0, 0) If lbListbox.Parent.ScaleMode = vbTwips Then 'Change twips to pixels fTextWidth = fTextWidth / Screen.TwipsPerPixelX End If If fTextWidth > fExistScrollWidth Then 'Increase width of scroll bar Call SendMessage(lbListbox.hwnd, LB_SETHORIZONTALEXTENT, fTextWidth, 0) End If ListboxAddHorizontalScollBar = (err.number = 0) Exit Function ErrFailed: Debug.Print err.description Debug.Assert False ListboxAddHorizontalScollBar = (err.number = 0) End Function