[VBA程序]：在VBA中实现鼠标事件

efan2000

该组件可以实现鼠标的按下、弹起、双击和移动的事件捕捉。具体的效果可以使用下面的例子演示。
注意：Enabled属性设置为True表示允许事件的触发，之后一定要将其设置为False，表示不再处理。

2. 
   
3.   [FONT=courier new]
   
4. 引用EFAN Hook AutoCAD Tool Library 1.0动态链接库。
   
5. 
   
6. Private WithEvents ehObj As EFHook.Hook
   
7. 
   
8. Private Sub ehObj_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   
9.     ThisDrawing.ModelSpace(0).TextString = Round(ehObj.ConvertScreenToWorldX(X, Y) + 0.0000000001, 4) & ",  " & Round(ehObj.ConvertScreenToWorldY(X, Y) + 0.0000000001, 4)
   
10.     ThisDrawing.ModelSpace(0).Update
    
11. End Sub
    
12. 
    
13. Private Sub test()
    
14. 
    
15.     On Error GoTo ErrTrap
    
16.     Set ehObj = New Hook
    
17.     ehObj.Enabled = True
    
18.     ThisDrawing.Utility.GetPoint
    
19.     ehObj.Enabled = False
    
20.     Set ehObj = Nothing
    
21.     Exit Sub
    
22.    
    
23. ErrTrap:
    
24.     ehObj.Enabled = False
    
25.     Set ehObj = Nothing
    
26. End Sub
    
27. 
    
28.   [/FONT]
    

<br />   [FONT=courier new]<br /> 引用EFAN Hook AutoCAD Tool Library 1.0动态链接库。<br /> <br /> Private WithEvents ehObj As EFHook.Hook<br /> <br /> Private Sub ehObj_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)<br />     ThisDrawing.ModelSpace(0).TextString = Round(ehObj.ConvertScreenToWorldX(X, Y) + 0.0000000001, 4) & ",  " & Round(ehObj.ConvertScreenToWorldY(X, Y) + 0.0000000001, 4)<br />     ThisDrawing.ModelSpace(0).Update<br /> End Sub<br /> <br /> Private Sub test()<br /> <br />     On Error GoTo ErrTrap<br />     Set ehObj = New Hook<br />     ehObj.Enabled = True<br />     ThisDrawing.Utility.GetPoint<br />     ehObj.Enabled = False<br />     Set ehObj = Nothing<br />     Exit Sub<br />     <br /> ErrTrap:<br />     ehObj.Enabled = False<br />     Set ehObj = Nothing<br /> End Sub<br /> <br />   [/FONT]<br />

efan2000

这是效果，不过由于Flash Cam无法实现其实的效果，所以只有一帧图像。