窗口移动问题**********！（进来者皆有分）

Question

怎么实现像输入法窗口一样，窗体可以跟随光标移动，且在屏幕上可以自动上下左右调整位置？

Answer 1

方法一
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 HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim rr As Long
Dim i
If Button = 1 Then
i = ReleaseCapture()
rr = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub方法二：Private Sub Form_Load()
prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End Sub
模块中Public Const GWL_WNDPROC = (-4)
Public Const WM_NCHITTEST = &H84
Public Const HTCLIENT = 1
Public Const HTCAPTION = 2
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public prevWndProc As Long
Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
If Msg = WM_NCHITTEST And WndProc = HTCLIENT Then
WndProc = HTCAPTION
End If
End Function请参考http://community.csdn.net/Expert/TopicView.asp?id=3649442

Answer 2

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
        x As Long
        y As Long
End Type
Dim pt As POINTAPIPrivate Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then
        Unload Me
    End If
End SubPrivate Sub Form_Load()
    Timer1.Interval = 100
    Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
    Dim x As Long
    Dim y As Long
    GetCursorPos pt
    x = pt.x * Screen.TwipsPerPixelX
    y = pt.y * Screen.TwipsPerPixelY
    If x + Me.Width > Screen.Width Then
        x = x - Me.Width
    End If
    If y + Me.Height > Screen.Height Then
        y = y - Me.Height
    End If
    Me.Left = x
    Me.Top = y
End Sub

Answer 3

给你个最简单的
'为当前的应用程序释放鼠标捕获
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
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    '以上声明的API函数的常量均可在VB自带的“API文本浏览器”中取得。    Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)    '在窗体的MouseDown事件中加入以下代码。    If Button = 1 Then '判断是否鼠标的左键被按下    Call ReleaseCapture    Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)    End If    End Sub

Answer 4

我用timer加下面的两个函数做过类似的应用，不过好像楼上几位的方法更适合你的要求GetCursorPos VB声明 
Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long 
说明 
获取鼠标指针的当前位置 
返回值 
Long，非零表示成功，零表示失败。会设置GetLastError 
参数表 
参数 类型及说明 
lpPoint POINTAPI，随同指针在屏幕像素坐标中的位置载入的一个结构 MoveWindow VB声明 
Declare Function MoveWindow Lib "user32" Alias "MoveWindow" (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 
说明 
改变指定窗口的位置和大小。顶级窗口可能受最大或最小尺寸的限制，那些尺寸优先于这里设置的参数 
返回值 
Long，非零表示成功，零表示失败 
参数表 
参数 类型及说明 
hwnd Long，欲移动窗口的句柄 
x Long，窗口新的左侧位置 
y Long，窗口新的顶部位置 
nWidth Long，窗口的新宽度 
nHeight Long，窗口的高宽度 
bRepaint Long，如窗口此时应重画，则设为TRUE（非零）。FALSE（零）则表明应用程序会自己决定是否重画窗口