form被移动以后响应什么事件？

Question

好像没有事件，要不弄一个Time来判断Form的top、left属性，然后处理你的代码！！

Answer 1

比较麻烦，需要制作自己的消息循环
然后截获wm_move,wm_moving消息。

Answer 2

用setwindowlong替换掉窗体默认处理，
然后处理WM_MOVING消息

Answer 3

用HTCAPTION消息，当用鼠标拖动窗体时要用到HTCAPTION消息，
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

Answer 4

当然找不到。
需要自己截获。
WM_MOVING和WM_MOVE常量在winuser.h里可以获得xyjdn的是用来在窗体没有caption的时候模拟鼠标点住caption来移动窗体，对你的要求可能没用。

Answer 5

给段代码给你吧
'建一个模块Public Const GWL_WNDPROC = -4
Public Const WM_SIZE = &H5
Public Const WM_MOVING = &H216
Public MyProc As LongPublic Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam 
As Long, ByVal lParam As Long) As Long
  Dim ret As Long
        
If Msg = WM_MOVING Then
        
            '正在移动～～，处理它            WindowProc = CallWindowProc(MyProc, hWnd, Msg, wParam, lParam)
            
        Else
        '默认处理
            WindowProc = CallWindowProc(MyProc, hWnd, Msg, wParam, lParam)
            
        End If
        
End Function
'窗体中写这些代码Private Sub Form_Load()
MyProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End SubPrivate Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, MyProc)End Sub

Answer 6

但是我要的是移动以后哦，不是移动的时候哦。to xyjdn(项有建)　
WM_NCHITTEST这个事件我鼠标在上面动都会触发哦。

Answer 7

1.FrmABout
Option Explicit
Dim mvX
Dim mvY
Dim mvLastSec
Dim mvEggX(1 To 4)
Dim mvEggY(1 To 4)Private Sub CmdOK_Click()
Unload Me
End SubPrivate Sub Form_Click()
Dim i As Integer
For i = 1 To 3
   mvEggX(i) = mvEggX(i + 1)
   mvEggY(i) = mvEggY(i + 1)
Next i
mvEggX(4) = mvX
mvEggY(4) = mvY
If Abs(mvEggX(1) - 42) < 300 And _
   Abs(mvEggY(1) - 60) < 300 And _
   Abs(mvEggX(2) - 5930) < 300 And _
   Abs(mvEggY(2) - 60) < 300 And _
   Abs(mvEggX(3) - 5930) < 300 And _
   Abs(mvEggY(3) - 3120) < 300 And _
   Abs(mvEggX(4) - 42) < 300 And _
   Abs(mvEggY(4) - 3120) < 300 Then
  '以上设置隐藏屏幕的显示条件:依次(左上.右上.右下.左下)点击ABOUT窗体的四个角
     FrmEgg.Show vbModal
End If
End SubPrivate Sub Form_Load()
Me.Caption = "关于 " & App.Title
Me.Icon = LoadPicture("")
LblTittle.Caption = App.Title & " Ver " & App.Major & "." & App.Minor & "." & App.Revision
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
mvLastSec = -1
mvX = X
mvY = Y
End Sub2.FrmEgg
Option Explicit
Private Sub TmrQuit_Timer()
Unload Me3.FrmMain
Option Explicit
'MouseTracker By KeFeng Wang
'This little application keeps how far your mouse have travelled.
'提供了其他程序设计技巧:如隐藏信息屏(复活节彩蛋).没有图标的窗体.
'利用系统注册表保存应用程序信息.防止应用程序被多次执行.
'弹出式菜单以及用GetCursorPos 来获取鼠标位置
'Public Sub Form_Load()
Dim Response
If App.PrevInstance Then
   Response = MsgBox("程序已经运行，不能再次装载!", vbOKOnly + vbExclamation, "警告")
   If Response = vbOK Then
        Unload Me
        Exit Sub
   End If
End If
Unit = GetSetting("Mouse Tracker", "Units", "Current Unit", 1)
Distance = GetSetting("Mouse Tracker", "Tracker", "Current Distance", 0) * 60000
Select Case Unit
Case 0
UnitValue = 1440
UnitName = "英寸"
FormatStr = FormatStr1
Case 1
UnitValue = 567
UnitName = "厘米"
FormatStr = FormatStr1
Case 2
UnitValue = 14400
UnitName = "英尺"
FormatStr = FormatStr1
Case 3
UnitValue = 56700
UnitName = "米"
FormatStr = FormatStr1
Case 4
UnitValue = 144000000
UnitName = "英里"
FormatStr = FormatStr2
Case 5
UnitValue = 55700000
UnitName = "公里"
FormatStr = FormatStr2
End Select
TmrSys.Enabled = True
TmrSys.Interval = 300
GetCursorPos Pnt
OldX = Pnt.X * Screen.TwipsPerPixelX
OldY = Pnt.Y * Screen.TwipsPerPixelYDim hSysMenu As Long
    ' Get handle of system menu
    hSysMenu = GetSystemMenu(hWnd, 0&)
    ' Append separator and menu item with ID IDM_ABOUT
    Call AppendMenu(hSysMenu, MF_SEPARATOR, 0&, 0&)
    Call AppendMenu(hSysMenu, MF_STRING, IDM_ABOUT, "About...")
    Call AppendMenu(hSysMenu, MF_STRING, IDM_UNITS, "Units...")
    Call AppendMenu(hSysMenu, MF_STRING, IDM_RESET, "Reset...")
    Call AppendMenu(hSysMenu, MF_STRING, IDM_EXIT, "Exit")
    Show
    
    ' Install system menu window procedure
    procOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SysMenuProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveSetting "Mouse Tracker", "Tracker", "Current Distance", Distance / 60000
End SubPrivate Sub TmrSys_Timer()
FrmMain.Caption = Format(Distance / UnitValue, FormatStr) & UnitName
    GetCursorPos Pnt
    NewX = Pnt.X * Screen.TwipsPerPixelX
    NewY = Pnt.Y * Screen.TwipsPerPixelY
    Distance = Distance + Sqr((NewX - OldX) * (NewX - OldX) + (NewY - OldY) * (NewY - OldY))
    OldX = NewX
    OldY = NewY
End Sub4.FrmUnits
Option Explicit
Private Sub cmdCancel_Click()
Unload Me
End SubPrivate Sub CmdOK_Click()
Dim i As Integer
For i = 0 To 5
If OptUnits(i).Value = True Then Unit = i
Next i
Select Case Unit
Case 0
UnitValue = 1440
UnitName = "英寸"
FormatStr = FormatStr1
Case 1
UnitValue = 567
UnitName = "厘米"
FormatStr = FormatStr1
Case 2
UnitValue = 14400
UnitName = "英尺"
FormatStr = FormatStr1
Case 3
UnitValue = 56700
UnitName = "米"
FormatStr = FormatStr1
Case 4
UnitValue = 144000000
UnitName = "英里"
FormatStr = FormatStr2
Case 5
UnitValue = 56700000
UnitName = "公里"
FormatStr = FormatStr2
End Select
SaveSetting "Mouse Tracker", "Units", "Current Unit", Unit
Unload Me
End SubPrivate Sub Form_Load()
Me.Icon = LoadPicture("")
OptUnits(Unit).Value = True
End Sub5.Module1
Option Explicit
Public Declare Function GetCursorPos Lib "user32" _
    (lpPoint As PointAPI) As Long
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 AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert 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 Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const GWL_WNDPROC = (-4)
Public Const WM_SYSCOMMAND = &H112
Public procOld As Long
Public Type PointAPI
    X As Long
    Y As Long
End Type
Public Pnt As PointAPI
    '     'These values MUST be public
Public OldX As Long
Public OldY As Long
Public NewX As Long
Public NewY As Long
    'This Const determines the total timeout value in
    '     minutes
   ' Global Const MINUTES = 15
    'Public TimeExpired
    'Public ExpiredMinutes
Public Distance As Double
Public Unit As Integer   '度量单位序号
Public UnitValue As Long '度量单位权值
Public UnitName As String '度量单位名称
Public FormatStr As String
Public Const FormatStr1 = "000000.00"
Public Const FormatStr2 = "0000.0000"
Public Const IDM_ABOUT = &H2000
Public Const IDM_UNITS = &H2001
Public Const IDM_RESET = &H2002
Public Const IDM_EXIT = &H2003
Public Function SysMenuProc(ByVal hWnd As Long, ByVal iMsg As Long, _
                            ByVal wParam As Long, ByVal lParam As Long) As Long
    ' Ignore everything but system commands
    If iMsg = WM_SYSCOMMAND Then
        ' Check for one special menu item
        Select Case wParam
        Case IDM_ABOUT
            FrmABout.Show
            Exit Function
        Case IDM_UNITS
            FrmUnits.Show
            Exit Function
        Case IDM_RESET
           FrmMain.TmrSys.Enabled = False
           Dim Response
           Response = MsgBox("Do you want to reset your Mouse Tracker to zero?  " & Chr(13) & "Your current mileage reading will lost forever.", vbOKCancel + vbExclamation, "Reset Mouse Tracker")
            If Response = vbOK Then
             Distance = 0 'reset to zero
             GetCursorPos Pnt
             OldX = Pnt.X * Screen.TwipsPerPixelX
             OldY = Pnt.Y * Screen.TwipsPerPixelY
             FrmMain.Caption = Format(Distance / UnitValue, FormatStr) & UnitName
             FrmMain.TmrSys.Enabled = True
            Else: FrmMain.TmrSys.Enabled = True
           End If
           Exit Function
        Case IDM_EXIT
            Unload FrmMain
            Exit Function
        End Select
        
    End If
    ' Let old window procedure handle other messages
    SysMenuProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)
End FunctionEnd Sub名称: 鼠标计程器(MouseTracker) Ver 1.00
简介: 该趣味小程序用来统计您的鼠标所走的距离,您也许见过类似的程序,如         Odometer.这里提供了MouseTracker的全部源代码,展示了用VB编程的多种
      技巧.如:用注册表保存应用程序状态或数据,随时获取鼠标所在位置(不仅      仅限于客户区),改变系统菜单(就是有"移动"."关闭"的那个)并使之响应(用到了VB5.0的利器--AddressOf),隐藏信息屏(即复活节彩蛋)等等.在中文WIN98,中文VB 5.0下运行通过出处：VB编程资源大全

Answer 8

The WM_MOVE message is sent after a window has been moved

Answer 9

The WM_MOVE message is sent after a window has been moved用这个代替我代码中得WM_MOVING就行了，参数请到winuser.h里查

Answer 10

WM_MOVE就是移动以后呀？？！！

Answer 11

gameboy999(活着就是幸运)的方法是对的，我用他的方法试过了，真的很好用。
'建一个模块Public Const GWL_WNDPROC = -4
Public Const WM_SIZE = &H5
Public Const WM_MOVING = &H216
Public Const WM_MOVE = &H3
Public MyProc As Long
 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 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
'The WM_MOVE message is sent after a window has been moved
Public Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long
  Dim ret As Long
        
If Msg = WM_MOVE Then
        
            '正在移动～～，处理它
           移动F.Label1.Caption = lParam
            WindowProc = CallWindowProc(MyProc, hWnd, Msg, wParam, lParam)
            
        Else
        '默认处理
            WindowProc = CallWindowProc(MyProc, hWnd, Msg, wParam, lParam)
            
        End If
        
End Function'窗体中写这些代码
Private Sub Form_Load()
MyProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End SubPrivate Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, MyProc)End SubPrivate Sub Label1_Change()
If Text1.Text = "" Then
    Text1.Text = 1
Else
    Text1.Text = Text1.Text + 1
End If
If Text1.Text > 1 Then
Label2.Caption = Label1.Caption
End If
End SubPrivate Sub Label2_Change()
Label3.Caption = "嘿!谁动了我的Form!"
End Sub

Answer 12

吖！！！为什么我的还是以后的时候就立即相应了。请看看代码，我用的是ｗｉｎ2000有关系吗？我的意思是用户托着窗口当标题栏mouseup以后再乡音
Public Const GWL_WNDPROC = -4
Public Const WM_SIZE = &H5
Public Const WM_MOVING = &H216
Public Const WM_MOVE = &H3
Public MyProc As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
'The WM_MOVE message is sent after a window has been moved
Public Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long
  Dim ret As Long
        
If Msg = WM_MOVE Then
        
            '正在移动～～，处理它
          Form1.Label1.Caption = lParam
            WindowProc = CallWindowProc(MyProc, hWnd, Msg, wParam, lParam)
            
        Else
        '默认处理
            WindowProc = CallWindowProc(MyProc, hWnd, Msg, wParam, lParam)
            
        End If
        
End Function'窗口
Private Sub Form_Load()
MyProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End SubPrivate Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, MyProc)End Sub

Answer 13

吖！！！为什么我的还是以后的时候就立即相应了。请看看代码，我用的是ｗｉｎ2000有关系吗？我的意思是用户托着窗口当标题栏mouseup以后再响应

Answer 14

我没装ｗｉｎ2000,我的代码在WINME绝对没问题.

Answer 15

拖动后放开鼠标后才有反应，你可以到WINME下试试看。

Answer 16

吖。不如你发个完整的给我试试？[email protected]谢了

Answer 17

to raeck:
在win2000里我试的结果如下，你将此代码放到你的模块中去，可以看出，移动以后是消息WM_MOVING,而移动中居然是消息WM_MOVE...不管怎样，还是可以获得该消息用以完成你的要求。Public Const GWL_WNDPROC = -4
Public Const WM_SIZE = &H5
Public Const WM_MOVING = &H216
Public Const WM_MOVE = &H3
Public MyProc As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
'The WM_MOVE message is sent after a window has been moved
Public Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long
  Dim ret As Long
        
If Msg = WM_MOVE Then
        
            '正在移动～～，处理它
          Form1.Label1.Caption = "MOVING"
            WindowProc = CallWindowProc(MyProc, hWnd, Msg, wParam, lParam)
            
        Else
        If Msg = WM_MOVING Then
                   Form1.Label1.Caption = "MOVED"
            WindowProc = CallWindowProc(MyProc, hWnd, Msg, wParam, lParam)        Else
        '默认处理
            WindowProc = CallWindowProc(MyProc, hWnd, Msg, wParam, lParam)
            
        End If
        End If
End Function