フォームをスムースドラッグにする
ここに載せてあるソースコードは、参考のために載せてあります
サンプルコードは、一番下にLZHとしてあります
Sample44.lzhがSample43.lzhと
同じということに気づきアップしました。(すいません)(2000/1/14)
Option Explicit '#####型の宣言です##### '座標位置用の型です Private Type POINTAPI x As Long y As Long End Type '短形用の型です Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type '#####各種APIの宣言です##### 'マウスの位置を取得できます Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 'ウィンドウの位置を取得できます Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long 'ウィンドウの位置を設定できます Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long '#####モジュール変数です##### 'マウスとウィンドウの位置の幅を保存します Dim Span As POINTAPI 'マウスが押されました Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Dim posMouse As POINTAPI Dim recWindow As RECT '左ボタンが押されているときだけを許可する If Button = vbLeftButton Then 'マウスの位置を取得します GetCursorPos posMouse 'ウィンドウの位置を取得します GetWindowRect Me.hwnd, recWindow 'マウスの位置とウィンドウの位置の幅を取得します Span.x = posMouse.x - recWindow.Left Span.y = posMouse.y - recWindow.Top End If End Sub 'マウスが移動されました Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Dim posMouse As POINTAPI Dim lngLeft As Long, lngTop As Long '左ボタンが離されたときだけを許可する If Button = vbLeftButton Then 'マウスの位置を取得します GetCursorPos posMouse 'マウスの位置からウィンドウの位置を逆算します lngLeft = (posMouse.x - Span.x) lngTop = (posMouse.y - Span.y) SetWindowPos Me.hwnd, 0, lngLeft, lngTop, vbNull, vbNull, vbNull End If End Sub |