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 LB_SETHORIZONTALEXTENT = &H194
-------------------------------------------------------------------------------------------------- Private Sub setListWidth() '如果列表框不夠寬,則增加水平滾動條 Dim i As Integer Dim List_MaxL As Integer '獲得選項內容的最大長度 For i = 0 To List1.ListCount - 1 ''讓list_maxl中保存最長的一條字串 If Len(List1.List(i)) > List_MaxL Then List_MaxL = Len(List1.List(i)) + 2 End If Next i '判斷是否內容顯示不完全,如果是則添加水平滾動條 If Me.TextWidth("AA ") * List_MaxL > List1.Width Then SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, Me.TextWidth("a") * List_MaxL, ByVal 0& End If End Sub
--------------------------------------------------------------------------------------------------
Private Sub Form_Load() Dim i As Integer '為ListBox控件添加選項 For i = 0 To 100 List1.AddItem ("這是,最據jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj:(第 " + CStr(i)) & "行) " 'List1.AddItem ( "(第 " + CStr(i)) & "行) " Next i ' 設置窗體坐標尺度模式和字體大小 Me.ScaleMode = vbPixels Me.FontSize = List1.FontSize 設置列表框的水平滾動條 Call setListWidth End Sub
'方法二:-----------------------------------------------------------------------------------------------
'添加 ListBox 水平滾動條------------------------------------------------- Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type 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 Const LB_SETHORIZONTALEXTENT = &H194 Const DT_CALCRECT = &H400 Public Function ListTextWidth(ByRef lstThis As ListBox) As Long '獲取最長項目的象素長度值 Dim i As Long Dim tR As RECT Dim lW As Long Dim lWidth As Long Dim lHDC As Long With lstThis.Parent.Font .Name = lstThis.Font.Name .Size = lstThis.Font.Size .Bold = lstThis.Font.Bold .Italic = lstThis.Font.Italic End With lHDC = lstThis.Parent.hdc For i = 0 To lstThis.ListCount - 1 '遍歷所有的列表項以找到最長的項 DrawText lHDC, lstThis.List(i), -1, tR, DT_CALCRECT lW = tR.Right - tR.Left + 8 If lW > lWidth Then lWidth = lW Next ListTextWidth = lWidth + 20 '返回最長列表項的長度(像素) End Function
Private Sub Form_Load() '設置 List 橫向滾動條 dim l As Long l = ListTextWidth(ltCol) SendMessage ltCol.hwnd, LB_SETHORIZONTALEXTENT, l, 0 End Sub