在vb中实现鼠标手势
1.什么是鼠标手势:
我的理解,按着鼠标某键(一般是右键)移动鼠标,然后放开某键,程序会识别你的移动轨迹,做出相应的响应.
2.实现原理:
首先说明一下,我在网上没有找到相关的文档,我的方法未必与其他人是一致的,实际效果感觉还可以.
鼠标移动的轨迹我们可以将其看成是许多小段直线组成的,然后这些直线的方向就是鼠标在这段轨迹中的方向了.
3.实现代码:
还要说明一下,
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就会显示出鼠标移动的轨迹了.
这里面的常数 ptgap 就是"鼠标移动的轨迹我们可以将其看成是许多小段直线组成的"中的小段的长度的平方.里面用到的api函数的用法,可以参考msdn.这里我就懒说了.
lingll ([email protected])
2004-7-23
没有注释?懒啊,各位就将就着看吧:)
网站运营seo文章大全提供全面的站长运营经验及seo技术!
