● カーソル以下のアイテムを自動選択する ●

これを実装すると途端にリストボックスが使いにくくなる(笑) ファイルリストボックスでも有効だね。

Private Type POINTAPI
    X As Long
    Y As Long
End Type

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 ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function LBItemFromPt Lib "comctl32.dll" (ByVal hLB As Long, ByVal ptX As Long, ByVal ptY As Long, ByVal bAutoScroll As Long) As Long

Private Const LB_SETCURSEL = &H186
Private Const LB_GETCURSEL = &H188

'---------------------------------------------------------------------------
' 関数名: SelectItemUnderCursor
' 機能 : カーソル以下のアイテムを自動選択する
' 引数 : (in)hWnd … リストボックスのハンドル
'         (in)xPos … リストボックスのカーソルX位置
'         (in)yPos … リストボックスのカーソルY位置
' 返り値: 1…正常終了   0…異常終了
'---------------------------------------------------------------------------
Public Sub SelectItemUnderCursor(ByVal hWnd As Long, ByVal xPos As Long, ByVal yPos As Long) 

    Dim ListItemIndex As Long
    Dim SelectedIndex As Long
    Dim udtPoint As POINTAPI

    With udtPoint
        .X = xPos
        .Y = yPos
    End With

    'スクリーン座標に変換
    Call ClientToScreen(hWnd, udtPoint)

    'カーソル以下のアイテムインデックスを得る(0が基準)…(1)
    ListItemIndex = LBItemFromPt(hWnd, udtPoint.X, udtPoint.Y, False)

    '選択されたアイテムのインデックスを得る(0が基準)…(2)
    SelectedIndex = SendMessage(hWnd, LB_GETCURSEL, 0, ByVal 0&)

    '(1)と(2)の数が違うなら(1)の位置を選択する
    If ListItemIndex <> SelectedIndex Then
        Call SendMessage(hWnd, LB_SETCURSEL, ListItemIndex, ByVal 0&)
    End If

End Sub

呼び出し側。

Private Sub Form_Load()

    With List1
        .AddItem "WM_LBUTTONDBCLICK"
        .AddItem "WM_LBUTTONDOWN"
        .AddItem "WM_LBUTTONUP"
        .AddItem "WM_MOUSEACTIVE"
        .AddItem "WM_MOUSEMOVE"
        .AddItem "WM_NCHITTEST"
        .AddItem "WM_NCLBUTTONDBCLICK"
        .AddItem "WM_NCMOUSEMOVE"
        .AddItem "WM_CHAR"
        .AddItem "WM_USER"
    End With

End Sub

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Debug.Print List1.List(List1.ListIndex)

End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Call SelectItemUnderCursor(List1.hWnd, _
                               CLng(X \ Screen.TwipsPerPixelX), _
                               CLng(Y \ Screen.TwipsPerPixelX))

End Sub

戻る