AdjustHScrollBar

リストボックスコントロールは、自動的に水平スクロールバーを表示してはくれないので、入りきらないような長い文字列をアイテムとして追加した場合、ユーザーはその内容を見ることが出来なくなってしまいます。
そこで、各アイテムの長さを測定し、一番長いアイテムに合わせて水平スクロールバーを付加する関数を作りました。プロポーショナルフォントにも対応しています。

'標準モジュールに記述します。

Option Explicit

Private Type Size
    cx As Long
    cy As Long
End Type

Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" _
    (ByVal hDC As Long, _
     ByVal lpsz As String, _
     ByVal cbString As Long, _
     lpSize As Size) As Long
Private Declare Function GetDC Lib "user32" _
    (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hwnd As Long, _
     ByVal hDC 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
Private Declare Function SelectObject Lib "gdi32" _
    (ByVal hDC As Long, _
     ByVal hObject As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
    (ByVal nIndex As Long) As Long

Private Const SM_CXBORDER = 5
Private Const WM_GETFONT = &H31
Private Const LB_SETHORIZONTALEXTENT = &H194

Public Sub AdjustHScrollBar(ListCtrl As ListBox)
'ListBox 内の Item の最大横幅を計算し、水平スクロールバーを丁度いい大きさで表示する

    Dim hDC As Long
    Dim hFont As Long
    Dim i As Long
    Dim s As Size
    Dim lngMaxWidth As Long

    'デバイスコンテキストハンドル取得
    hDC = GetDC(ListCtrl.hwnd)
    'フォントハンドル取得
    hFont = SendMessage(ListCtrl.hwnd, WM_GETFONT, 0, 0)
    'デバイスコンテキストにフォントを関連付ける
    Call SelectObject(hDC, hFont)

    '各リストアイテム毎に長さを測定し、その最大値を求める
    lngMaxWidth = 0
    For i = 0 To ListCtrl.ListCount - 1
        Call GetTextExtentPoint32(hDC, _
                                  ListCtrl.List(i), _
                                  LenB(StrConv(ListCtrl.List(i), vbFromUnicode)), _
                                  s)
        If lngMaxWidth < s.cx Then lngMaxWidth = s.cx
    Next
    
    'デバイスコンテキストハンドル解放
    Call ReleaseDC(0, hDC)
    '長さの最大値に、コントロールの境界線分の幅を足したものを基準値にして
    '水平スクロールバーを作成
    Call SendMessage(ListCtrl.hwnd, _
                     LB_SETHORIZONTALEXTENT, _
                     lngMaxWidth + GetSystemMetrics(SM_CXBORDER) * 4, _
                     0)

End Sub

'フォームにリストボックス(List1)を配置して、以下のプロシージャを記述します。

Private Sub Form_Load()

    With List1
        .AddItem "じゅげむじゅげむごこうのすりきれ"
        .AddItem "wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwx"
        .AddItem "iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiix"
    End With
    
    Call AdjustHScrollBar(List1)

End Sub