● マウスでドラッグ(キャプチャー)して移動する ●

別にピクチャーボックスに限ったことではないが、サンプルとして分かりやすいので敢えてここに記述する。

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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Const WM_SYSCOMMAND = &H112
Private Const MOUSE_MOVE = &HF012&

'---------------------------------------------------------------------------
' 関数名 : MoveControl
' 機  能 : コントロールを移動する
' 引  数 : (in)hWnd … コントロールのハンドル
' 返り値 : なし
'---------------------------------------------------------------------------
Public Sub MoveControl(ByVal hWnd As Long)

    Dim udtPA As POINTAPI
    Dim MakelParam As Long
    Dim FuncRet As Long

    'マウスキャプチャーを解放
    Call ReleaseCapture

    'マウスカーソル現在位置を取得
    If GetCursorPos(udtPA) = 0 Then Exit Sub

    '上位ワードと下位ワードを結合
    MakelParam = udtPA.X + (udtPA.Y * &H10000)

    '移動
    Call SendMessage(hWnd, WM_SYSCOMMAND, MOUSE_MOVE, ByVal MakelParam)

End Sub

あとはフォームにピクチャーボックスを配置して、以下のコードを書く。

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

    Call MoveControl(Picture1.hWnd)

End Sub

戻る