如何实现浮动没有标题的窗体

Option Explicit
    
     Public Type RECT
     Left As Long
     Top As Long
     Right As Long
     Bottom As Long
     End Type
    
     Public Type POINTAPI
     x As Long
     y As Long
     End Type
    
     Public Const COLOR_ACTIVECAPTION = 2
     Public Const SM_CXDLGFRAME = 7
     Public Const SM_CYDLGFRAME = 8
    
     Public Declare Function GetWindowRect Lib "user32" _
     (ByVal hwnd As Long, lpRect As RECT) As Long
    
     Public Declare Function GetSysColor Lib "user32" _
     (ByVal nIndex As Long) As Long
    
     Public Declare Function GetSystemMetrics Lib "user32" _
     (ByVal nIndex As Long) As Long
    
     Public Declare Function DrawFocusRect Lib "user32" _
     (ByVal hdc As Long, lpRect As RECT) As Long
    
     Public Declare Function ClientToScreen Lib "user32" _
     (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    
     Public Declare Function GetDC Lib "user32" _
     (ByVal hwnd As Long) As Long
    
     Public Declare Function ReleaseDC Lib "user32" _
     (ByVal hwnd As Long, ByVal hdc As Long) As Long
    
     在窗体中输入以下代码：
    
     Option Explicit
     Dim tpoint As POINTAPI
     Dim temp As POINTAPI
     Dim dpoint As POINTAPI
    
     Dim fbox As RECT
     Dim tbox As RECT
     Dim oldbox As RECT
    
     Dim TwipsPerPixelX
     Dim TwipsPerPixelY
    
     Private Sub BeginFRDrag(x As Single, y As Single)
     Dim tDc As Long
     Dim sDc As Long
     Dim d As Long
    
     MousePointer = 5
     'convert points to POINTAPI struct
     dpoint.x = x
     dpoint.y = y
    
     'get screen area of toolbar
     GetWindowRect hwnd, fbox
     'screen Rect of toolbar
     TwipsPerPixelX = Screen.TwipsPerPixelX
     TwipsPerPixelY = Screen.TwipsPerPixelY
    
     'get point of mousedown in screen coordinates
     temp = dpoint
     ClientToScreen hwnd, temp
    
     sDc = GetDC(ByVal 0)
     DrawFocusRect sDc, tbox
     d = ReleaseDC(0, sDc)
     oldbox = tbox
     End Sub
    
     Private Sub DoFRDrag(x As Single, y As Single)
     Dim tDc As Long
     Dim sDc As Long
     Dim d As Long
    
     tpoint.x = x
     tpoint.y = y
    
     ClientToScreen hwnd, tpoint
    
     tbox.Left = (fbox.Left + tpoint.x / TwipsPerPixelX) - temp.x / TwipsPerPixelX
     tbox.Top = (fbox.Top + tpoint.y / TwipsPerPixelY) - temp.y / TwipsPerPixelY
     tbox.Right = (fbox.Right + tpoint.x / TwipsPerPixelX) - temp.x / TwipsPerPixelX
     tbox.Bottom = (fbox.Bottom + tpoint.y / TwipsPerPixelY) - temp.y / TwipsPerPixelY
    
     sDc = GetDC(ByVal 0)
     DrawFocusRect sDc, oldbox
     DrawFocusRect sDc, tbox
     d = ReleaseDC(0, sDc)
     oldbox = tbox
     End Sub
    
     Private Sub EndFRDrag(x As Single, y As Single)
     Dim tDc As Long
     Dim sDc As Long
     Dim d As Long
    
     Dim newleft As Single
     Dim newtop As Single
    
     sDc = GetDC(ByVal 0)
     DrawFocusRect sDc, oldbox
     d = ReleaseDC(0, sDc)
    
     newleft = x + fbox.Left * TwipsPerPixelX - dpoint.x
     newtop = y + fbox.Top * TwipsPerPixelY - dpoint.y
    
     Move newleft, newtop
     MousePointer = 0
     End Sub
    
     Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Button = 2 Then BeginFRDrag x, y
     End Sub
    
     Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Button = 2 Then DoFRDrag x, y
     End Sub
    
     Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Button = 2 Then EndFRDrag x, y
     End Sub
    这样只要你按下右键就可以移动窗体。这里面的一个关键就是使用ClientToScreen函数转换窗体坐标为屏幕坐标。