msgsetlistboxhscroll.bas

vb做的数据库 客户管理系统

Attribute VB_Name = "msgSetListBoxHScroll"

Public Declare Function GetSystemMetrics Lib "user32" (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