フォームをスムースドラッグにする

<戻る

ここに載せてあるソースコードは、参考のために載せてあります

サンプルコードは、一番下に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





<戻る

Sample44.lzh


http://www.vector.co.jp/authors/VA015521/