如何移动一个没有标题栏的窗体

Question

Private Declare Function ReleaseCapture Lib "user32" () As Long
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 Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF012
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
End Sub
你也可以在控件的MOUSEDOWN中加入ReleaseCapture
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
这样就可以通过控件来拖动窗体了

Answer 1

bob008(冻冬)的代码在win98下应该可以，win2000下没试过，如果不用API函数，可以参考下面的代码：Option Explicit
Dim tx As Long
Dim ty As LongPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
    tx = X
    ty = Y
End If
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
    Me.Move Me.Left + X - tx, Me.Top + Y - ty
End If
End Sub

Answer 2

这样的在任何操作系统中都可以Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As LongConst HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
    Dim ReturnVal As Long
    X = ReleaseCapture()
    ReturnVal = SendMessage(Command1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub

Answer 3

没改好，应该这样（幸好没被别人发现，要不然多 分给 一个人 分 了）：Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As LongConst HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
    Dim ReturnVal As Long
    X = ReleaseCapture()
    ReturnVal = SendMessage(me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub

Answer 4

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 Sub ReleaseCapture Lib "User32" ()Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2Private Sub Form1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     If Button = 1 Then
        'Release capture
        Call ReleaseCapture
        'Send a 'left mouse button down on caption'-message to our form
        lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    ElseIf Button = 2 Then
        End
    End If
End SubPrivate Sub Form_Paint()
    Me.Print "左键拖动，右键退出"
End Sub

Answer 5

能不能直接根据鼠标，改变窗体的位置啊？ 我想应该是可以的。
================================================================可以。mousedown里面记下鼠标的相对位置，mousemove里面保持这个相对位置

Answer 6

to wxy_xiaoyu(然也)
你的方法在2000下不能用啊

Answer 7

Option Explicit
Dim mMove As Boolean, mR As RECT
Dim sX As Long, sY As LongPrivate Sub Form_Load()
    Dim lRect As Long
    
    mMove = False
    Me.ScaleMode = 3
    GetWindowRect Me.hwnd, mR
    SetWindowPos Me.hwnd, HWND_TOPMOST, mR.Left, mR.Top, mR.Right - mR.Left, mR.Bottom - mR.Top, 0
    lRect = CreateRoundRectRgn(mR.Left, mR.Top, mR.Right, mR.Bottom, 30, 30)
    If lRect <> 0 Then SetWindowRgn Me.hwnd, lRect, True
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mMove = True
    sX = X
    sY = Y
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If mMove Then
        mR.Left = mR.Left + X - sX
        mR.Top = mR.Top + Y - sY
        mR.Right = mR.Right + X - sX
        mR.Bottom = mR.Bottom + Y - sY
        SetWindowPos Me.hwnd, HWND_TOPMOST, mR.Left, mR.Top, mR.Right - mR.Left, mR.Bottom - mR.Top, 0
    End If
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mMove = False
End Sub'=====
以上代码，98，2000都可用