自动根据ListBox的最大长度添加横滚动条的软件源码

Option Explicit
'======================================================================
'功能:自动根据ListBox的最大长度添加横滚动条
'用法:Call ListBoxChange(List1)
'======================================================================
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 Sub ListBoxChange(ByRef lstThis As ListBox)
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