frog.raindrop.jp.knowledge

VB6のリストボックスは、項目が長くても横スクロールできない。横スクロールバーを出すには、LB_SETHORIZONTALEXTENT メッセージを送る必要がある。

項目追加するたびに横スクロールバーを調整するのはこんな感じ

Option Explicit
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_GETHORIZONTALEXTENT    As Long = &H193
Private Const LB_SETHORIZONTALEXTENT    As Long = &H194&

'------------------------------------------------------------------
'プロシージャ名:  :AddItemAndSetScrollBar
'説明:            :リストボックスに項目を追加し、必要に応じて横スクロールバーを表示する
'引数:            :pListBox           I   リストボックス
'                 :pItem              I   追加する文字列
'                 :pIndex             I   追加位置
'------------------------------------------------------------------
Private Sub AddItemAndSetScrollBar(pListBox As VB.ListBox, pItem As String, Optional pIndex As Variant)
Dim sngTextWidth        As Single
Dim lngCurPixels        As Long
Dim lngNewPixels        As Long
    
    
    '' ここは説明は不要でしょう
    Call pListBox.AddItem(pItem, pIndex)
    
    '' 現在の幅を取得
    lngCurPixels = SendMessage(pListBox.hWnd, LB_GETHORIZONTALEXTENT, 0&, ByVal 0&)
    
    '' テキストの幅から必要なスクロール幅を計算
    '' 計算方法は適宜修正のこと
    '' リストボックスのフォントとフォームのフォントが同じならこんな感じで求められる
    With pListBox.Parent
        sngTextWidth = .TextWidth(pItem)                            '' 文字列の幅
        lngNewPixels = .ScaleX(sngTextWidth, .ScaleMode, vbPixels)  '' ピクセルに変換
    End With
    
    '' 余白分を足す
    '' ここでは適当に4ピクセル足してるが、システム標準の値とかあるのかしら
    '' GetSystemMetrics( SM_CXEDGE ) * 2 あたりがに合わしておくといいかも
    lngNewPixels = lngNewPixels + 4&
    
    '' 現在の幅がちっちゃければ設定します。
    If (lngNewPixels > lngCurPixels) Then
        Call SendMessage(pListBox.hWnd, LB_SETHORIZONTALEXTENT, lngNewPixels, ByVal 0&)
    End If
End Sub