VB: how to disable the mouse pointer from entering a certain area

Source: Internet
Author: User
We know that clipcursor can restrict the pointer to a specified area, so how can we prevent the mouse from entering a certain area? The answer is to use the mouse hook, the wh_mouse_ll Hook can be used in Windows NT 4.0 SP3 and later systems. The special feature of this hook is that no DLL is required. In addition, this hook uses a struct, Which is briefly described as follows:
Typedef struct {
Point pt;
DWORD mousedata;
DWORD flags;
DWORD time;
Ulong_ptr dwextrainfo;
} Msllhookstruct, * pmsllhookstruct;

Members

PT
Specifies a point structure that contains the X-and y-coordinates of the cursor, in screen coordinates.
Mousedata
If the message is wm_mousewheel, the high-order word of this Member is the wheel delta. the low-order word is reserved. A positive value indicates that the wheel was rotated forward, away from the user; a negative value indicates that the wheel was rotated backward, toward the user. one wheel click is defined as wheel_delta, Which is 120.

If the message is wm_xbuttondown, wm_xbuttonup, lower, wm_ncxbuttondown, lower, or lower, the high-order word specifies which X button was pressed or released, and the low-order word is reserved. this value can be one or more of the following values. otherwise,MousedataIs not used.

Xbutton1
The first X button was pressed or released.
Xbutton2
The second X button was pressed or released.
Flags
Specifies the event-injected flag. An application can use the following value to test the mouse flags.

Value Purpose
Llmhf_injected Test the event-injected flag.
0
Specifies whether the event was injected. The value is 1 if the event was injected; otherwise, it is 0.
1-15
Reserved.
Time
Specifies the time stamp for this message.
Dwextrainfo
Specifies extra information associated with the message.

Let's talk about the Code:
A module and a form (called form1)

Module code:
Option explicit
Private declare sub copymemory lib "kernel32.dll" alias "rtlmovememory" (byref destination as any, byref source as any, byval length as long)
Private declare function ptinrect lib "USER32" (lprect as rect, byval X as long, byval y as long) as long
Private declare function setwindowshookex lib "USER32" alias "setwindowshookexa" (byval idhook as long, byval lpfn as long, byval hmod as long, byval dwthreadid as long) as long
Private declare function unhookwindowshookex lib "USER32" (byval hhook as long) as long
Private declare function callnexthookex lib "USER32" (byval hhook as long, byval ncode as long, byval wparam as long, lparam as any) as long
Private const hc_action = 0
Private const wh_mouse_ll as long = 14
Private const wm_mousemove = & h200

Public type rect
Left as long
Top as long
Right as long
Bottom as long
End type

Private type pointapi
X as long
Y as long
End type

Private type msllhookstruct
Pt as pointapi
Mousedata as long
Flags as long
Time as long
Dwextrainfo as long
End type

Public hhook as long
Public HDR as rect
Public sub enablehook (hrect as rect)
RT = hrect
If hhook = 0 then
Hhook = setwindowshookex (wh_mouse_ll, addressof hookproc, app. hinstance, 0)
End if
End sub
Public sub freehook ()
If hhook <> 0 then
Call unhookwindowshookex (hhook)
Hhook = 0
End if
End sub

Public Function hookproc (byval ncode as long, byval wparam as long, byval lparam as long) as long
Dim typmhs as msllhookstruct, Pt as pointapi
If ncode <0 then
Hookproc = callnexthookex (hhook, ncode, wparam, lparam)
Exit Function
End if
If wparam = wm_mousemove then
Call copymemory (typmhs, byval lparam, lenb (typmhs ))
PT = typmhs.pt
If ptinrect (RTL, Pt. X, Pt. Y) <> 0 then
Hookproc = 1' cancel the action to be completed
Else
Form1.caption = "mouse cursor at" + CSTR (Pt. X) + "," + CSTR (Pt. Y)
Hookproc = 0' to complete the pending operations
End if
End if
End Function

Form code:
Option explicit
Const hwnd_topmost =-1
Const hwnd_notopmost =-2
Const swp_nosize = & H1
Const swp_nomove = & H2
Const swp_noactivate = & H10
Const swp_showwindow = & h40
Private declare sub setwindowpos lib "USER32" (byval hwnd as long, byval hwndinsertafter as long, byval X as long, byval y as long, byval CX as long, byval Cy as long, byval wflags as long)

Private sub form_activate ()
'Set the window as the topmost window to facilitate observation
Setwindowpos me. hwnd, hwnd_topmost, 0, 0, 0, 0, swp_noactivate or swp_showwindow or swp_nomove or swp_nosize
End sub
Private sub form_load ()
Dim RT as rect
With RT
. Left = 0
. Right = 400
. Top = 0
. Bottom = 300
End
Enablehook RT
End sub

Private sub form_unload (cancel as integer)
Freehook
End sub

It should be pointed out that there is a problem with the ptinrect statement in the API browser that comes with VB. Although no error is reported when calling it, it cannot determine whether the specified vertex is in rect. Therefore, its statement is modified.

In addition, this section of my program prohibits the mouse pointer from entering the (0, 0)-(400,300) area. During debugging, the close button of the form may be located in this area. At this time, remember to press Alt + F4 to close the window

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.