【API Function】

[ウインドウの移動]

　ここでいうウインドウとは、ダイアログではなく、CommandButton やTextBoxなどのコントロールのことです。一般的に、実行時においてはこのようなコントロールが移動できるプログラムは見かけませんが、そういったプログラムを作ることは、比較的簡単です。サンプルプログラムもクラス的なまとめ方をしましたので、余計な手間なく使用できると思います。使用するAPIは、かなり多いのですが、MoveWindow関数が主です。その他にはマウスカーソルの位置を知るAPI等、カーソル系のものが多いです。

（ウインドウの移動方法）
フォームのGeneralセクションに次の宣言コードを追加して下さい。
というより、サンプルプログラムをダウンロードしてもらった方が早いですね。特に丁寧に説明しているわけでもないし。標準モジュールにまとめてあるので使い方は簡単です。しかし、下のコード、自分で見てもちょっとゾッとします。これをじっくり見るにはかなりの根気がいります。

'構造体の定義
Private Type POINT
    x1 As Long
    y1 As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'*****マウスカーソルの現在の位置を､スクリーン座標で取得する*****
Private Declare Function GetCursorPos Lib "user32" _
        (lpPoint As POINT) As Long

'*****スクリーン座標をクライアント座標に変換*****
Private Declare Function ScreenToClient Lib "user32" _
        (ByVal hWnd As Long, lpPoint As POINT) As Long
    '---------------------引数---------------------------
    '(hWnd) このハンドルのクライアント座標に変換
    '--------------------戻り値--------------------------
    '関数が成功すると0以外の値が返り
    '関数が失敗すると0が返る

'*****指定されたウインドウにマウスをキャプチャする*****
Private Declare Function SetCapture Lib "user32" _
        (ByVal hWnd As Long) As Long
    '---------------------引数---------------------------
    '(hWnd) マウスをキャプチャするウィンドウハンドル
    '--------------------戻り値--------------------------
    'その前にキャプチャされていたウィンドウのハンドル返す
    'そういったウインドウがなければ0を返す

'*****キャプチャを解放する*****
Private Declare Function ReleaseCapture Lib "user32" () _
        As Long
    '--------------------戻り値--------------------------
    '関数が成功すると0 以外の値が返り
    '関数が失敗すると0が返る

'*****指定されたウインドウの位置とサイズを変更する*****
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd _
        As Long, ByVal X As Long, ByVal Y As Long, _
        ByVal nWidth As Long, ByVal nHeight As Long, _
        ByVal bRepaint As Long) As Long
    '---------------------引数---------------------------
    '(hWnd) 指定するウインドウのハンドル
    '(x)ウィンドウの左上隅の新しい x 座標
    '(y)ウィンドウの左上隅の新しい y 座標
    '(nWidth)ウィンドウの新しい幅
    '(nHeight)ウィンドウの新しい高さ
    '(bRepaint)再描画するかどうか
    '--------------------戻り値--------------------------
    '関数が成功すると0 以外の値が返り
    '関数が失敗すると0が返る
    '---------------------注意---------------------------
    '指定されたウインドウが親ウインドプの場合、位置とサイズを
    'スクリーン座標で指定し、子ウィンドウの場合は、クライアン
    'ト座標で指定する

'*****指定ウインドウの左上隅と右下隅座標のクライアント座標を得る
Private Declare Function GetClientRect Lib "user32" _
        (ByVal hWnd As Long, lpRect As RECT) As Long
    '---------------------引数---------------------------
    '(hwnd) クライアント座標を取得するウインドウのハンドル
    '(lpRect) 座標を格納する構造体
    '--------------------戻り値--------------------------
    '関数が成功すると0以外の値が返り
    '関数が失敗すると0が返る

'*****指定ウインドウの左上隅と右下隅座標のスクリーン座標を得る
Private Declare Function GetWindowRect Lib "user32" (ByVal _
        hWnd As Long, lpRect As RECT) As Long
    '---------------------引数---------------------------
    '(hwnd) スクリーン座標を取得するウインドウのハンドル
    '(lpRect) 座標を格納する構造体
    '--------------------戻り値--------------------------
    '関数が成功すると0以外の値が返り
    '関数が失敗すると0が返る

'*****指定されたクライアント座標を含む子ウインドウのハンドルを返す
Private Declare Function ChildWindowFromPoint Lib "user32" _
        (ByVal hWnd As Long, ByVal xPoint As Long, _
         ByVal yPoint As Long) As Long
    '---------------------引数---------------------------
    '(hWnd) 親ウインドウのハンドル
    '(xPoint) 子ウインドウの x 座標
    '(yPoint) 子ウインドウの y 座標
    '--------------------戻り値--------------------------
    '指定された座標に子ウインドウが存在していればその
    'ウインドウのハンドルを返し、指定された座標が親ウィンドウ
    'の内部であれば、そのハンドルを返す
    '指定された座標が親ウィンドウの外であれば、0を返す

'マウス位置
Dim p As POINT
'移動対象ウインドウのウインドウ座標
Dim rec As RECT
'移動対象ウインドウの左上隅座標保管
Dim lt As POINT
'マウスがダウンされた座標
Dim sx As Long, sy As Long
'移動対象ウインドウのハンドル
Dim ContWnd As Long
'マウスがダウンされているか
Dim mDown As Boolean

次に、GeneralセクションにDownChildWindow、MoveParentWindow、 UpParentWindowプロシージャを新規に作成し、それぞれに次のコードを追加して下さい。

'============================================================
'プロシージャ名  DownChildWindow
'処理内容  ユーザーがマウスをダウンしたとき呼び出される
'          そのダウンした位置からウインドウのハンドルを得て
'          ウインドウを移動するための準備をする
'---------------------引数---------------------------
'(ParentWnd) 親ウインドウのハンドル
'============================================================
Private Sub DownChildWindow(ParentWnd As Long)
    'マウスがダウンされたスクリーン座標を得る
    GetCursorPos p
    'フォームのクライアント座標に変換
    ScreenToClient ParentWnd, p
    'その座標を保管しておく
    sx = p.x1: sy = p.y1
    'マウスダウンされた位置からその子ウインドウのハンドルを得る
    ContWnd = ChildWindowFromPoint(ParentWnd, sx, sy)
    '移動対象の子ウインドウのスクリーン座標位置を得る
    GetWindowRect ContWnd, rec
    '左上隅の座標を保管しておく
    lt.x1 = rec.Left: lt.y1 = rec.Top
    'その座標を親ウインドウのクライアント座標に変換
    ScreenToClient ParentWnd, lt
    '親ウインドウ（ここでは、フォーム）をキャプチャする
    SetCapture ParentWnd
End Sub

'============================================================
'プロシージャ名　MoveParentWindow
'処理内容　子ウインドウを移動する
'---------------------引数---------------------------
'(ParentWnd) 親ウインドウのハンドル
'============================================================
Private Sub MoveParentWindow(ParentWnd As Long)
    'マウスが移動したスクリーン位置を得る
    GetCursorPos p
    'クライアント座標に変換
    ScreenToClient ParentWnd, p
    '移動対象ウインドウを移動する
    MoveWindow ContWnd, lt.x1 + p.x1 - sx, lt. _
                        y1 + p.y1 - sy, rec.Right - rec.Left, _
                        rec.Bottom - rec.Top, True
End Sub

'============================================================
'プロシージャ名　UpParentWindow
'処理内容　キャプチャの解放
'============================================================
Private Sub UpParentWindow()
    'キャプチャを解放する
    ReleaseCapture
End Sub

これで、処理の中核部分はできあがりましたが、フォームにマウスのクリック操作で行う処理、つまり、プロシージャを呼び出す処理を追加します。サンプルプログラムの標準モジュールを使えば、要は、これだけを追加すれば移動できるんですけどね。

Private Sub Form_Load()
    '変数の初期化
    mDown = False
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
            X As Single, Y As Single)
    'マウスがダウンされていなければ、このプロシージャを抜ける
    If mDown = False Then Exit Sub
    Call MoveParentWindow(Me.hWnd)
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _
            X As Single, Y As Single)
    'マウスアップ
    mDown = False
    Call UpParentWindow
End Sub

最後に、マウス操作で実行中に移動させたいコントロールのMouseDown プロシージャかGotFocusプロシージャ（コントロールによって違う）に次のコードを追加します。（ラベルコントロールは移動できませんでした。何故だろう？コードに欠陥が・・・）

    'マウスダウン
    mDown = True
    Call DownChildWindow(Me.hWnd)

API Functionインデックストップ