晓东CAD家园-论坛-XDRX_API应用-让LISP控制WINDOWS消息循环（给ACAD注入钩子）监控键盘鼠标消息-关于WINDOWS系统的消息循环可以网络搜索，参考文献。WINDOWS系统的所有软件都是通过消息循环和系统交互，我们按下键盘或者移动鼠标，WINDOWS系统会把消息发送到AUTOCAD ...

XDSoft 发表于 2018-1-8 14:13:45

让LISP控制WINDOWS消息循环（给ACAD注入钩子）监控键盘鼠标消息

关于WINDOWS系统的消息循环可以网络搜索，参考文献。

WINDOWS系统的所有软件都是通过消息循环和系统交互，我们按下键盘或者移动鼠标，WINDOWS系统会把消息发送到AUTOCAD，AUTOCAD接受消息处理并返回信息给系统。

那AUTOCAD接受到的系统键盘消息，通过ARX的钩子相关函数，可以截获，这个消息应用程序处理后可以继续传给AUTOCAD后续操作，也可以截获，让AUTOCAD不知道有这个“消息”过来，AUTOCAD也就不能继续响应消息然后操作。
一般的钩子函数定义如下：
BOOL HOOK(MSG *pMsg)
{
switch(pMsg->message){
case WM_KEYDOWN:
case WM_SYSKEYDOWN:
if (...)
{
return TRUE; // TRUE 截获消息，不让AUTOCAD继续处理。
}
break;
}
return FALSE;// 返回FALSE，AUTOCAD可以继续接受该消息
}

那A/VLISP能不能也截获消息处理呢，不能，LISP没提供这样的功能。

下面通过XDRX API提供给LISP的自定义函数，来完成上面的操作。

API提供的“钩子”相关的函数有：
xdrx-hook-register
xdrx-hook-enable
xdrx-hook-status
xdrx-hook-remove
xdrx-hook-tracemouse
xdrx-hook-block-messageloop
xdrx-system-keystate
xdrx-system-ctrl-down
xdrx-system-ctrl-shift-down
xdrx-system-ctrl-alt-shift-down
xd::hook:register
xd::hook:enable
xd::hook:remove

xdrx-hook-block-messageloop函数的作用相当于上面说的return TRUE,终止消息继续给AUTOCAD。

LISP的典型钩子回调函数结构如下：

(defun hook (hwnd msg wparam lparam time pos)
;|
hwnd -- 窗口句柄
msg --- 消息
wparam -- 主参数
lparam ---- 第二参数
time ------- 发生时间
pos------- 鼠标屏幕坐标
|;

(cond ((= msg WM_KEYUP) ;按键抬起
)
((= msg WM_KEYDOWN) ;键按下
(setq txt (chr wparam))
)
((= msg WM_SYSKEYDOWN)) ;系统键按下
((= msg WM_CHAR)
)
((= msg WM_MOUSEWHEEL) ;拨动滚轮
)
((= msg WM_LBUTTONUP) ;鼠标左键弹起
)
((= msg WM_LBUTTONDOWN) ;鼠标左键按下
)
((= msg WM_LBUTTONDBLCLK) ;鼠标左键双击
)
((= msg WM_RBUTTONUP) ;鼠标右键弹起
)
((= msg WM_RBUTTONDOWN) ;鼠标右键按下
)
((= msg WM_RBUTTONDBLCLK) ;鼠标右键双击
)
((= msg WM_MBUTTONUP) ;鼠标中键弹起
)
((= msg WM_MBUTTONDOWN) ;鼠标中键按下
)
((= msg WM_MBUTTONDBLCLK) ;鼠标中键双击
)
((= msg WM_MOUSEMOVE) ;鼠标移动
)
((= msg WM_PAINT) ;屏幕绘制
)
((= msg WM_HOTKEY) ;热键
)
((= msg WM_INPUT) ;输入
)
((= msg WM_VSCROLL) ;屏幕滚动
)
)
)

下面通过一个ODCL的捕获鼠标热键的程序说明：
下面程序会把键盘的按键，包括CTRL,SHIFT,ALT和字母键的组合，实时写到文本框里面。

(defun c:tt ()
(setq odcl-data
'("YWt6A2YXAAAh3q+ZBuKTJsUwKi9qI/1OYh86Xl9frzx8ON3ysnVmUlK6Jtb29vdoaHSydoxmezrS"
"zu26uLTmFh8Xn02Pa1XdcwgC/mE+nNVNeOsP4U0OYRVmUFYev6KaoEeVQohAGZHLqZss4OA1hb32"
"XvRmZK96v4RQkzt03ZY5fKlu6ghxxE9+Yf6XHN46AIvKxNonZOif+jIW6Ndfursu3cocrGlo7T+X"
"97byUBdLdXA3AXEk3qO42tk1KGTJFxNPUIOZ20EUKInmSx8nrRtSWBtSX9NoZxFIgOwcQxgusqYS"
"5KHzYX/DJU/keNTfAla+glsQ9HC15/hPVu2ralRpOJjZ1u1W+p0sbZiamORv/ZTg5rEiQE8orfOD"
"JkIec85jq9xjPRbrbXK3Jjw4JZswHzqklMm1nIjBy9a4IgjI07Lwy+U0hcJBiodBxNI8I1uCtOAR"
"nIv8jjW8sXeBWgWd+oNASYAbmTllLEkuElspmdlIGcyh37bPbjTvm3HQ6y7Fk+PA6EXON2Alc9IZ"
"MOvg7K7zNdZxnPRCObuXLnAAaz4nGRHJQyoVkglnU77Tp3ArOsVyxpwty+6b6hpH9rWcwDGipSeT"
"7fKJ5dQtMfensXZB37ZBWIL2jj28W+rnX6kXfBOWunDHBXMledoDNuBp3lAklUwHN29gytyahdBN"
"ojGdffpHsetqm6XKsVQFQtqPd2UxFALtsKc/jZkSgbigKaSxaVVw54vh9hmhko3nh+FTOBkOY9Oh"
"F4XhrJ25F0E517zwbxBdAvpOApCGxpUcDUilqlD01t0MsLZjro9VTY5+KfDMVVlbwU8ab+AXucpS"
"XbKXGQROA+YgMkHYGWmH5VoC5A78Tq2XUJ/NUCLfdQIyGgCmbJUw96bW744QN742SL/Cdpc7Tlga"
"7AiW3xRzuvhuH7llCyh5wq40Jhii3/StZFHfJRhAlTD7E7GyIdBww8+DAK+F9O0hUWOnNZnW3Idw"
"I8fRD0OrI+6OYMyB4IitP4gVNimIR6CabbaoY/nw6r3TXU0me2MX34PEC9oO/6o11/moId1gJXKK"
"LPEWIEMM1DkSndf5AImaqx2Tq72C65ou8TUmUYv2UzFDfHgE1zla0WBHq13Ej6qdRIyUH6clPYtG"
"eckEor8E1zkKB5QvFN7pBAYBk9FcSWEWshybuytoVdGRhauciBQBoQWrtDTBgccIJionCicagcuo"
"JuonysMU7zviFU3Z1jkM98QpS4G5gQa6nyj1ySaaW89QlG+PKnEDg39nvMRW")
)
(defun c:hook-quit#OnClicked (/)
(xd::hook:remove "_hook-1")
(dcl-form-close hotkey-odcl/Form1)
(princ)
)
(defun c:hotkey-odcl/Form1#OnClose (UpperLeftX UpperLeftY /)
(xd::hook:remove "_hook-1")
(dcl-form-close hotkey-odcl/Form1)
(princ)
)
(defun c:hotkey-odcl/Form1#OnCancelClose (Reason /)
(xd::hook:remove "_hook-1")
(dcl-form-close hotkey-odcl/Form1)
(princ)
)
(defun c:hotkey-odcl/Form1#OnCancel (/)
(xd::hook:remove "_hook-1")
(dcl-form-close hotkey-odcl/Form1)
(princ)
)

(defun c:var1#OnSetFocus (/)
(setq #var-name (dcl-Control-GetProperty var1 "VarName"))
)
(defun c:var2#OnSetFocus (/)
(setq #var-name (dcl-Control-GetProperty var2 "VarName"))
)
(defun c:var3#OnSetFocus (/)
(setq #var-name (dcl-Control-GetProperty var3 "VarName"))
)
(defun c:var4#OnSetFocus (/)
(setq #var-name (dcl-Control-GetProperty var4 "VarName"))
)
(defun _hook-1 (hwnd msg wparam lparam time pos)
(and (dcl-Form-IsActive hotkey-odcl/Form1)
(cond ((= msg WM_KEYDOWN)
(if (and (> wparam 46)
(< wparam 91)
(/= "" #var-name)
   )
   (progn
   (setq txt (chr wparam))
   (cond
      ((xdrx-system-ctrl-down)
      (dcl-Control-SetText
(eval (read #var-name))
(strcat "CTRL+" txt)
      )
      )
      ((xdrx-system-shift-down)
      (dcl-Control-SetText
(eval (read #var-name))
(strcat "SHIFT+" txt)
      )
      )
      ((xdrx-system-ctrl-shift-down)
      (dcl-Control-SetText
(eval (read #var-name))
(strcat "CTRL+SHIFT+" txt)
      )
      )
      ((xdrx-system-ctrl-alt-shift-down)
      (dcl-Control-SetText
(eval (read #var-name))
(strcat "CTRL+ALT+SHIFT+" txt)
      )
      )
   )
   (xdrx-hook-block-messageloop t) ;;阻断该消息让AUTOCAD继续处理。
   )
)
      )
      (T)
)
)
)
(setq #var-name "")
(xd::hook:register "_hook-1" t "dd")
(dcl-project-import odcl-data "123456")
(dcl-Form-Show hotkey-odcl/Form1)
(princ)
)

liuyj 发表于 2018-1-8 16:09:52

早就希望有这个功能了，这样可以对按下的键进行捕获

liunian0524 发表于 2018-1-9 08:08:09

感谢楼主分享

xyz002 发表于 2018-6-20 12:15:28

非常好，辛苦了

jinjieqin111 发表于 2021-1-11 11:36:07

多谢分享{:1_8:}

lizhaojun45 发表于 2022-5-27 19:24:06

(defun hook (hwnd msg wparam lparam time pos)
hwnd -- 窗口句柄
msg --- 消息，
大佬msg这个传入参数，怎么获取到

pxt2015 发表于 2022-12-17 15:54:18

本帖最后由 pxt2015 于 2022-12-17 15:57 编辑

钩子应用例子，光ctrl,alt.shift组合有啥意思，以下截图为网友arx开发的“单键快捷”工具，
可以设置键盘的箭头按键，F1-F12功能键，PageDown按键，也就是将键盘按键一网打尽。
版主能否给一个示例

页: [1]

晓东CAD家园-论坛's Archiver

让LISP控制WINDOWS消息循环（给ACAD注入钩子）监控键盘鼠标消息