在vb中實現(xiàn)鼠標手勢
1.什么是鼠標手勢:
我的理解,按著鼠標某鍵(一般是右鍵)移動鼠標,然后放開某鍵,程序會識別你的移動軌跡,做出相應的響應.
2.實現(xiàn)原理:
首先說明一下,我在網(wǎng)上沒有找到相關的文檔,我的方法未必與其他人是一致的,實際效果感覺還可以.
鼠標移動的軌跡我們可以將其看成是許多小段直線組成的,然后這些直線的方向就是鼠標在這段軌跡中的方向了.
3.實現(xiàn)代碼:
還要說明一下,
a)要捕獲鼠標的移動事件,可以使用vb中的mousemove事件,但這個會受到一些限制(例如,在webbrowser控件上就沒有這個事件).于是這個例子中,我用win api,在程序中安裝個鼠標鉤子,這樣就能夠捕獲整個程序的鼠標事件了.
b)這個里只是個能捕獲鼠標向上,下,左,右的移動的例子.(呵呵,其實這四方向一般也足夠了:))
新建standrad exe,添加一個module
form1的代碼如下
option explicit
private sub form_load()
call installmousehook
end sub
private sub form_queryunload(cancel as integer, unloadmode as integer)
call uninstallmousehook
end sub
module1的代碼如下
option explicit
public const htclient as long = 1
private hmousehook as long
private 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 as long
y as long
end type
public type mousehookstruct
pt as pointapi
hwnd as long
whittestcode 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 long
public 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
public declare function unhookwindowshookex lib "user32" _
(byval hhook as long) as long
public const wh_keyboard as long = 2
public const wh_mouse as long = 7
public const hc_sysmodaloff = 5
public const hc_sysmodalon = 4
public const hc_skip = 2
public const hc_getnext = 1
public const hc_action = 0
public const hc_noremove as long = 3
public const wm_lbuttondblclk as long = &h203
public const wm_lbuttondown as long = &h201
public const wm_lbuttonup as long = &h202
public const wm_mbuttondblclk as long = &h209
public const wm_mbuttondown as long = &h207
public const wm_mbuttonup as long = &h208
public const wm_rbuttondblclk as long = &h206
public const wm_rbuttondown as long = &h204
public const wm_rbuttonup as long = &h205
public const wm_mousemove as long = &h200
public 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 long
public const mk_rbutton as long = &h2
public 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 integer
public const vk_lbutton as long = &h1
public const vk_rbutton as long = &h2
public const vk_mbutton as long = &h4
dim mpt as pointapi
const ptgap as single = 5 * 5
dim predir as long
dim mouseeventdsp as string
dim 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 long
dim cancel as boolean
cancel = false
on error goto due
dim i&
dim nmouseinfo as mousehookstruct
dim thwindowfrompoint as long
dim tpt as pointapi
if 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
mouseeventdsp = ""
cancel = true
case wm_rbuttonup
debug.print mouseeventdsp
cancel = true
case wm_mousemove
if vkpress(vk_rbutton) then
call getmouseevent(nmouseinfo.pt)
end if
end select
end if
end if
if cancel then
mousehookproc = 1
else
mousehookproc = callnexthookex(hmousehook, icode, wparam, lparam)
end if
exit function
due:
end function
public sub uninstallmousehook()
if hmousehook <> 0 then
call unhookwindowshookex(hmousehook)
end if
hmousehook = 0
end sub
public function vkpress(vkcode as long) as boolean
if (getasynckeystate(vkcode) and &h8000) <> 0 then
vkpress = true
else
vkpress = false
end if
end function
public function getmouseevent(npt as pointapi) as long
dim cx&, cy&
dim rtn&
rtn = -1
cx = npt.x - mpt.x: cy = -(npt.y - mpt.y)
if cx * cx + cy * cy > ptgap then
if cx > 0 and abs(cy) <= cx then
rtn = 0
elseif cy > 0 and abs(cx) <= cy then
rtn = 1
elseif cx < 0 and abs(cy) <= abs(cx) then
rtn = 2
elseif cy < 0 and abs(cx) <= abs(cy) then
rtn = 3
end if
mpt = npt
if predir <> rtn then
mouseeventdsp = mouseeventdsp & debugdir(rtn)
predir = rtn
end if
end if
getmouseevent = rtn
end function
public function debugdir(ndir&) as string
dim tstr$
select case ndir
case 0
tstr = "右"
case 1
tstr = "上"
case 2
tstr = "左"
case 3
tstr = "下"
case else
tstr = "無"
end select
debug.print timer, tstr
debugdir = tstr
end function
運行程序后,在程序窗口上,按著右鍵移動鼠標,immediate window就會顯示出鼠標移動的軌跡了.
這里面的常數(shù) ptgap 就是"鼠標移動的軌跡我們可以將其看成是許多小段直線組成的"中的小段的長度的平方.里面用到的api函數(shù)的用法,可以參考msdn.這里我就懶說了.
lingll ([email protected])
2004-7-23
沒有注釋?懶啊,各位就將就著看吧:)
網(wǎng)站運營seo文章大全提供全面的站長運營經(jīng)驗及seo技術!
