ピクチャボックスの移動          <TOP>


ReleaseCapture マウスのキャプチャを解放
SendMessage ウィンドウにメッセージを送信

WM_NCLBUTTONDOWN(&HA1) 非クライアント領域で左マウスボタンを押す
HTCAPTION(2) タイトルバーをクリックしたことを示す

'================================================================
'= ピクチャボックスの移動
'=    (ReleaseCapture.bas)
'================================================================
#include "Windows.bi"

' マウスのキャプチャを解放
Declare Function Api_ReleaseCapture& Lib "user32" Alias "ReleaseCapture" ()

' ウィンドウにメッセージを送信。この関数は、指定したウィンドウのウィンドウプロシージャが処理を終了するまで制御を返さない
Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)

#define WM_NCLBUTTONDOWN &HA1           '非クライアント領域で左マウスボタンを押す
#define HTCAPTION 2                     'タイトルバーをクリックしたことを示す
#define vbArrow 1                       '矢印アイコン
#define vbDefault 0                     'デフォルト値

Var Shared Picture1 As Object
Var Shared Button1 As Object
Var Shared Bitmap As Object

Picture1.Attach GetDlgItem("Picture1")
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
BitmapObject Bitmap

Var Shared mMove As Integer

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Bitmap.LoadFile "flower.bmp"
    Picture1.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject

    Picture1.SetMousePointer vbArrow
    Button1.SetWindowText "移動できません!"
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Picture1.SetMousePointer vbDefault
    Button1.SetWindowText "移動可能です!"
End Sub

'================================================================
'=
'================================================================
Declare Sub Picture1_MouseDown edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Sub Picture1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Var Ret As Long

    If Picture1.GetMousePointer = vbDefault Then
        Ret = Api_ReleaseCapture
        Ret = Api_SendMessage(Picture1.GethWnd, WM_NCLBUTTONDOWN, ByVal HTCAPTION, ByVal 0)
        mMove = True
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Picture1_MouseMove edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Sub Picture1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    If mMove Then
        Picture1.SetMousePointer vbArrow
        mMove = False
    
        Button1.SetWindowText "移動できません!"
    End If
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End