给listbox加横向滚动条

Question

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, ListBox1.Width + 30, 0);
end;

Answer 1

老兄，这个是DELPHI程序嘛，VB的呢？

Answer 2

虽是DELPHI，但和vb.net差不多，
你可以用
SendMessage ListBox1.Handle, LB_SETHORIZONTALEXTENT, ListBox1.Width + 30, 0
给listbox发一条信息即可

Answer 3

其实我觉得这里的问题关键是怎么判断项目的长度是不是大于listbox的宽度。

Answer 4

下面的函数可以满足你的第一个条件，如果要取消滚动条，你可以在remove一个选项是判断剩下的选项是否有大于ListBox的宽度，然后用
      Call SendMessage(ListBox1.hwnd, LB_SETHORIZONTALEXTENT, 0, ByVal 0&)就可以去掉滚动条Public Sub setListScroll(lstObject as ListBox,strText As String)
'目    的:  设置ListBox中的水平滚动条长度   Static lngScrollWidth As Long
   Dim lngTmpWidth As Long
   
   lngTmpWidth = Me.TextWidth(strText) / Screen.TwipsPerPixelX + 5
   If lngScrollWidth < lngTmpWidth Then
      lngScrollWidth = lngTmpWidth
      Call SendMessage(lstObject.hwnd, LB_SETHORIZONTALEXTENT, lngScrollWidth, ByVal 0&)
   End IfEnd Sub

Answer 5

以下这个过程要以自动计算列表框中最长的列表项的长度，并自动为列表框添加滚动条：（绝对好用，我一直都是用这个过程的呢！）Public Declare Function GetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Public 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
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const SM_CXVSCROLL = 2
Public Const DT_CALCRECT = &H400
Public Const LB_SETHORIZONTALEXTENT = &H194
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
'为ListBox设置水平滚动条
Sub SetHScroll(FormName as Form, ListName As ListBox)
Dim c As Long
Dim rcText As RECT
Dim newWidth As Long
Dim itemWidth As Long
Dim sysScrollWidth As Long
sysScrollWidth = GetSystemMetrics(SM_CXVSCROLL)
For c = 0 To ListName.ListCount - 1
    DrawText FormName.hDC, (ListName.List(c)), -1&, rcText, DT_CALCRECT
    itemWidth = rcText.Right + sysScrollWidth
    If itemWidth >= newWidth Then
        newWidth = itemWidth
    End If
Next
SendMessage ListName.hwnd, LB_SETHORIZONTALEXTENT, newWidth, ByVal 0&
End Sub