'********************************************************** *********************** ** Module Name: BASMOUSE '** Creation: Ye Fan' ** Japan: December 31, 2002 Day '** Modifier:' ** Japan: '** Description: Mouse Hook' ** Version: Version 1.0 '******************* *********************************************************** *** Option ExplicitPublic Type POINTLX As LongY As LongEnd TypeDeclare 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 LongDeclare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongDeclare Function SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As any, byval fuwini as long) AS Longdeclare Function ScreenToClient Lib "User32" (Byval Hwnd As Long, XYPOINT AS POINTL) AS LONG
Public const gwl_wndproc = -4public const spi_getwheelscrollnes = 104public const wm_mousewheel = & h20apublic Wheel_Scroll_Lines As Long
Global LPPREVWNDPROC AS Long
PUBLIC SNGX AS SINGLE, SNGY AS SINGLE 'Mouse Coordinate PUBLIC INTSHIFT AS INTEGER' Mouse Buttons PUBLIC BWAY AS Boolean 'Mouse Direction PUBLIC BMOUSEFLAG AS BOOLEAN' Mouse Event Activation Sign
'********************************************************** ************************ ** function name: hook '** input: byval hwnd (long) - window handle' ** output : No '** function description: Install the mouse hook' ** global variable: '** Call Module:' ** Author: Ye Fan '** Japan: December 31, 2002 "** Modify:' ** Japan: '** version: version 1.0' ********************************************** ******************************************************** Public Sub Hook (Byval Hwnd As Long) LPPREVWndProc = SETWINDOWLONG ( HWND, GWL_WNDPROC, Addressof WindowProc) Gets the scroll line value in "Control Panel" Call SystemParametersInfo (SPI_GETWHEELLLLLIN, 0, WHEEL_SCROLL_LINES, 0) end sub '**************************** *********************************************************** ***** '** function name: unhook' ** input: BYVAL HWND (long) - Window handle '** output: no' ** function description: Uninstall mouse hook '** global variable:' * * Call Module: '** Author: Ye Fan' ** Japan: December 31, 2002 '** Modifier:' ** Japan: '** Version: Version 1.0' ***** *********************************************************** ************************* PUBLIC SUB UnHook (Byval Hwnd As Long) Dim LngreturnValue As Long LngreturnValue = SetWindowlong (HWND, GWL_WNDPROC, LPPREVWNDPROC) End Sub
'********************************************************** ************************ ** function name: windowproc '** input: BYVAL HW (long) - Window handle' **: byval UMSG (long) - message type '**: byval wparam (long) -' **: byval lpaam (long) - '** output: (long) -' ** function description: window function '** global variable : '** Call Module:' ** Author: Ye Fan '** Japan: December 31, 2002' ** Modifier: '** Japan:' ** Edition: Version 1.0 '** *********************************************************** ******************************* Private Function WindowProc (Byval HW As Long, Byval WParam As Long, BYVAL LPARAM As Long AS Long Dim Pt As POINTL SELECT CASE UMSG CASE WM_MOUSEWHEEL 'Scroll Dim Wzdelta, WKEYS AS INTEGER' WZDELTA Transfer Roller is slow, this value is less than zero indicates that the roller is scrolling (in the user direction), 'greater than zero means the roller forward scrolling (in the display direction) WZDELTA = HiWord (WPARAM) 'WKEYS indicates whether there is Ctrl = 8, Shift = 4, mouse button (left = 2, medium = 16, right = 2, additional) Press, allow composite WKEYS = loword (wparam)' Pt mouse Coordinate pt.x = loword (lparam) Pt.y = HiWord (LPARAM) '------------------------------------- - IF WZDELTA <0 THEN 'Direction BWAY = True Else' Dragon Direction BWAY = FALSE End IF '-------------------------- ------------------------ 'Convert the screen coordinates to Form1. Window coordinate ScreenToClient HW, Pt SNGX = Pt.x SNGY = Pt.Y Intshift =
WKEYS BMOUSEFLAG = TRUE 'Rolling Sign Case Else WINDOWPROC = CallWindowProc (LPPREVWNDPROC, HW, UMSG, WPARAM, LPARAM) End Selectens Function' ****************************** *********************************************************** * '** function name: HiWord' ** input: longin (long) - 32-bit value '** output: (Integer) - 32-bit value low 16 ** function description: Take 32-bit value 16-bit '** global variable:' ** Call Module: '** Author: Ye Fan' ** Japan: December 31, 2002 "** Modifier: '** Japan:' ** Version: version 1.0 '****************************************************** **************************************** PUBLIC FUNCTION HIWORD (Longin As Long) AS Integer 'Removes 32-bit values of high 16-bit Hiword = (Longin and & Hffff0000) / & H10000nd Function
'********************************************************** ************************ ** function name: loword '** input: longin (long) - 32-bit value' ** output : (Integer) - 32-bit value low 16-bit '** function description: Remove 32-bit value low 16 ** global variable:' ** Call Module: '** Author: Ye Fan' ** Day Period: December 31, 2002 '** Modifier:' ** Japan: '** Version: Version 1.0' ******************** *********************************************************** ** Public Function Loword (Longin As Long) AS Integer 'Removes 32-bit value low 16-bit loword = longin and & hfff & end function
