ScrollListBoxByMouse

'------------------------------------------------------------------------------------
' モジュール: ScrollListBoxByMouse
' 概　要   : リストボックスに対して「右クリック + ドラッグ」で疑似的にスクロール
'             させる機能を提供し、Shiftキーを押している場合は高速スクロールを行う。
'             さらに、Shiftキー押下時のスクロール倍数をオプショナル引数で可変にする。
'
' 【使い方】
'   1) このコードを標準モジュールまたはユーザーフォームのコードモジュールに貼り付ける。
'   2) リストボックスの MouseDown / MouseMove / MouseUp イベントで、それぞれ本モジュールの
'      ScrollListBoxByMouse_MouseDown / ScrollListBoxByMouse_MouseMove / ScrollListBoxByMouse_MouseUp
'      を呼び出す。
'   3) Shiftキー押下時のスクロール倍数は、MouseMove呼び出し時の引数で指定可能。
'      指定しない場合はデフォルト値(2倍)が使われる。
'
'【サンプル】
'Private Sub [リストボックス]_MouseDown(ByVal Button As Integer, _
'                                ByVal Shift As Integer, _
'                                    ByVal X As Single, _
'                                    ByVal Y As Single)
'
'    Call ScrollListBoxByMouse_MouseDown(Button, Shift, Y)
'End Sub
'
'Private Sub [リストボックス]_MouseMove(ByVal Button As Integer, _
'                                ByVal Shift As Integer, _
'                                    ByVal X As Single, _
'                                    ByVal Y As Single)
'
'    Call ScrollListBoxByMouse_MouseMove([リストボックス], Button, Shift, Y, 5)
'End Sub
'
'Private Sub [リストボックス]_MouseUp(ByVal Button As Integer, _
'                              ByVal Shift As Integer, _
'                                  ByVal X As Single, _
'                                  ByVal Y As Single)
'
'    Call ScrollListBoxByMouse_MouseUp(Button)
'End Sub
'
'------------------------------------------------------------------------------------

' 右ドラッグ中かどうかを判定するフラグ
Private Pri_bRightDrag As Boolean

' 前回のマウスY座標を保持(ドラッグ開始時の基準点)
Private Pri_lastY As Single


Public Sub ScrollListBoxByMouse_MouseDown(ByVal Button As Integer, _
                                           ByVal Shift As Integer, _
                                               ByVal Y As Single)
'リストボックスの MouseDown イベントから呼び出されるサブプロシージャ。
'右クリックが押されたタイミングで、スクロール用のフラグを立てる。
'右ボタンが押された場合にドラッグを開始
'20250214

'引数
'Button・・・押されたマウスボタン(1=左,2=右,4=中)
'Shift ・・・押されている修飾キーの状態(ビットマスク 1=Shift,2=Ctrl,4=Alt)
'Y     ・・・マウスのY座標(ユーザーフォーム基準)

    If Button = 2 Then
        Pri_bRightDrag = True
        Pri_lastY = Y
    End If
End Sub

Public Sub ScrollListBoxByMouse_MouseMove(ByVal ListBox As MSForms.ListBox, _
                                           ByVal Button As Integer, _
                                            ByVal Shift As Integer, _
                                                ByVal Y As Single, _
                              Optional ByVal ShiftSpeed As Long = 2)

'リストボックスの MouseMove イベントから呼び出されるサブプロシージャ。
'右ボタンを押下中(ドラッグ中)の場合のみ、リストボックスのスクロールを行う。
'Shiftキーを押している場合はスクロール速度を可変にし、倍数を Optional パラメータで指定可能。
'20250214

'引数
'引数
'ListBox     ・・・スクロール対象のリストボックス(型: MSForms.ListBox)
'Button      ・・・押されているマウスボタン(1=左,2=右,4=中)
'Shift       ・・・押されている修飾キーの状態(ビットマスク 1=Shift,2=Ctrl,4=Alt)
'Y           ・・・マウスのY座標(ユーザーフォーム基準)
'[shiftSpeed]・・・Shiftキー押下時のスクロール倍数(省略時は 2 )

    Dim deltaY     As Single  ' マウスの移動量(Y方向)
    Dim scrollRows As Long    ' スクロール行数
    Dim newIndex   As Long    ' 新しいTopIndex(スクロール先)
    Dim speedCoeff As Long    ' スクロール速度の係数

    ' 右ドラッグ中であればスクロール処理を実行
    If Pri_bRightDrag Then
        
        ' Shiftキーが押されているか判定(Shiftキーはビットマスクの1)
        If (Shift And 1) <> 0 Then
            ' Shiftキー押下中は引数で指定された倍数を適用(既定値は 2)
            speedCoeff = ShiftSpeed
        Else
            ' Shiftキーが押されていない場合は通常(1倍)
            speedCoeff = 1
        End If

        ' マウスの移動量を計算
        deltaY = Y - Pri_lastY
        
        ' 例：10ピクセル移動ごとに1行スクロール
        '     speedCoeff を掛けて高速化/低速化
        If Abs(deltaY) >= 10 Then
            scrollRows = Int(deltaY / 10) * speedCoeff
            
            ' 新しいTopIndexを計算
            '   deltaYがプラスなら上方向へスクロール、マイナスなら下方向へスクロール
            newIndex = ListBox.TopIndex - scrollRows
            
            ' 範囲チェック(最小は0、最大はListCount-1)
            If newIndex < 0 Then
                newIndex = 0
            ElseIf newIndex > ListBox.ListCount - 1 Then
                newIndex = ListBox.ListCount - 1
            End If
            
            ' 実際にスクロールを実行
            ListBox.TopIndex = newIndex
            
            ' 今回のマウス座標を次回計算用の基準点として更新
            Pri_lastY = Y
        End If
    End If
End Sub

Public Sub ScrollListBoxByMouse_MouseUp(ByVal Button As Integer)
'リストボックスの MouseUp イベントから呼び出されるサブプロシージャ。
'右ボタンが離されたらドラッグフラグを解除する。
'右ボタンが離された場合、ドラッグ状態を終了
'20250214

'引数
'Button・・・離されたマウスボタン(1=左,2=右,4=中)

    If Button = 2 Then
        Pri_bRightDrag = False
    End If
End Sub