Realize mouse gestures in VB
1. What is a mouse gesture: ??? I understand, press a key (generally right) to move the mouse, then let a key, the program will identify your mobile trajectory, make a corresponding response. 2. Implementation Principle:? First explain, I didn't find the relevant document on the Internet. My method may not be consistent with others. The actual effect is ok. • The track of mouse movement We can regard it as many small straight lines Then these straight lines are the direction in this trajectory. 3. Implement code:? Also explain,? A) To capture mouse mobile events, you can use the mousemove event in VB, but this will be Some restrictions (for example, there is no such event on the webbrowser control). In this example, I use the WIN API to install a mouse hook in the program, so that the mouse event of the entire program can be captured.? B) This is just An example of capturing the mouse to the upper, lower, left, right movement. (Oh, in fact, these four directions are generally enough :))
New Standrad EXE, add a Module
The code of FORM1 is as follows
Option expedition
Private Sub Form_Load () Call InstallMousehookend Sub
Private Sub Form_Queryunload (Cancel AS Integer, UnloadMode As Integer) Call UninstallMousehookend Sub
The code of Module1 is as follows
Option expedition
Public const htclient as long = 1
Private HMousehook As LongPrivate const kf_up as long = & h80000000
Public Declare Sub CopyMemory Lib "kernel32" Alias "RTLmoveMemory" (HPVDest As Any, HPVSource As Any, Byval CBCopy As Long)
PRIVATE TYPE POINTAPI ??? x ask ??? y as long
End Type
Public Type MousehookStruct ??? Pt As Pointapi ??? HWND As long ??? DWEXTRAINFO As Long
End Type
Public Declare Function CallNexthookex Lib "User32" _ ??????? (Byval HHOOK AS Long, _ ??????? Byval Ncode As Long, _ ??????? byval WPARAM As Long, _? ?????? byval lparam as long) As longpublic declare function setWindowshookex lib "user32" _ ??????? alias "setWindowshookexa" _ ??????? (Byval IDHOOK AS Long, _ ??? ???? byval lpfn as long, _ ??????? byval hmod as long, _ ??????? byval dwthreadid as long) As longpublic declare function unhookwindowshookex lib "user32" _ ????? ?? (BYVAL HHOOK AS Long) As long
Public const wh_keyboard as long = 2public const wh_mouse as long = 7
Public Const HC_SYSMODALOFF = 5Public Const HC_SYSMODALON = 4Public Const HC_SKIP = 2Public Const HC_GETNEXT = 1Public Const HC_ACTION = 0Public Const HC_NOREMOVE As Long = 3Public Const WM_LBUTTONDBLCLK As Long = & H203Public Const WM_LBUTTONDOWN As Long = & H201Public Const WM_LBUTTONUP As Long = & H202Public Const WM_MBUTTONDBLCLK As Long = & H209Public Const WM_MBUTTONDOWN As Long = & H207Public Const WM_MBUTTONUP As Long = & H208Public Const WM_RBUTTONDBLCLK As Long = & H206Public Const WM_RBUTTONDOWN As Long = & H204Public Const WM_RBUTTONUP As Long = & H205Public Const WM_MOUSEMOVE As Long = & H200Public Const WM_MOUSEWHEEL As Long = & H20A
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Const MK_RBUTTON As Long = & H2Public Declare Function ScreenToClient Lib "user32" (ByVal HWND As Long, LPPOINT AS POINTAPI AS Long
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerPublic Const VK_LBUTTON As Long = & H1Public Const VK_RBUTTON As Long = & H2Public Const VK_MBUTTON As Long = & H4
DIM MPT As Pointapiconst PTGAP As Single = 5 * 5Dim Predir As Longdim MouseEventdsp As Stringdim EventLength As Long
'######### mouse hook #############
Public Sub InstallMousehook () ??? hmousehook = setwindowshookex (wh_mouse, addressof mousehookproc, _ ??????????? app.hinstance, app.threadid) End Sub
Public Function MouseHookProc (ByVal iCode As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDim Cancel As BooleanCancel = FalseOn Error GoTo dueDim i & Dim nMouseInfo As MOUSEHOOKSTRUCTDim tHWindowFromPoint As LongDim tpt As POINTAPIIf iCode = HC_ACTION Then ??? CopyMemory nMouseInfo, ByVal LPARAM, LEN (NMOUSEINFO) ??? TPT = NMouseInfo.Pt ??? ScreenToClient NMouseInfo.hwnd, TPT ??? 'debug.print tpt.x, tpt.y ??? if nmouseinfo.whittestcode = 1 THEN??? ???? SELECT CASE WPARAM ??????????? case wm_rbuttondown ??????????????? MPT = nMouseInfo.pt ?????????? ????? predir = -1 ??????????????????????????????????????????? Cancel = true ???? ??????? case wm_rbuttonup ??????????????? debug.print mouseeventdsp ??????????????? Cancel = True ???? ??????? case wm_mousemove ??????????????? IF vkpress (VK_RBUTTON) THEN ??????????????????? Call GetMouseEvent (nmouseinfo.pt) ????????????????????????????? End if ???
If Cancel Then ??? MousehookProc = 1ELSE ??? MousehookProc = CallNexthookex (HMousehook, iCode, WPARAM, LPARAM) endiff
EXIT FUNCTION
Due: ??? End function
Public Sub UninstallMousehook () ??? if hmousehook <> 0 THEN ??????? Call unhookwindowshookex (hmousehook) ??? End if ??? hmousehook = 0nd Sub
Public Function VKPRESS (VKCODE As Long) AS Booleanif (GetasyncKeyState (Vkcode) and & H8000) <> 0 THEN ??? vkpress = trueelse ??? vkpress = false ingnd function
Public Function GetMouseEvent (NPT As Pointapi) AS Longdim CX &, CY & DIM RTN & RTN = -1CX = NPT.X - MPT.X: CY = - (NPT.Y - MPT.Y) IF CX * CX CY * CY> PTGAP THEN? ?? IF CX> 0 and abs (cy) <= cx tell = 0 ??? Elseif Cy> 0 and abs (cx) <= cyin ??????? rtn = 1 ??? Elseif CX <0 and ABS (CY) <= ABS (CX) THEN ??????? rtn = 2 ??? Elseif CY <0 and ABS (CX) <= ABS (CY) THEN? ?????? r = 3 ??? End if ??? MPT = npt ??? if Predir <> RTN THEN ??????? mouseeventdsp = mouseeventdsp & debugdir (RTN) ?????? PREDIR = RTN ??? End IFEND IFGETMOUSEEVENT = RTNEND FunctionPublic Function Debugdir (NDIR &) AS STRINGDIM TSTR $ SELECT CASE NDIR ??? Case 0 ??????? TSTR = "Right" ??? case 1 ??? ?????????? case 2 ??????? tstr = "left" ??? case 3 ??????? TSTR = "under" ??? case else ?? ????? tstr = "None" end selectdebug.print timer, tstrDebugdir = tstrend function
After running the program, on the program window, press the right click to move the mouse, IMMEDIATE WINDOW will display the track of the mouse movement.
The constant PTGAP is "the trajectory of mouse movement We can see it as a square of the length of the length of the small segment in many small lines. The usage of the API function can be used, you can refer to MSDN. I am lazy here. .
?
LINGLL? (lingll2001@21cn.com) 2004-7-23
No comments? Lazy, you will look at it :)
