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