本帖最后由 highflybird 于 2011-4-24 23:12 编辑
(vlax-get-or-create-object "DynamicWrapperX")这样也不行吗？
用这个试下看能创建(vlax-get-or-create-object "DynamicWrapper") 么？这个是早期的版本。
但是单独执行
(if... (progn1 ... ) (progn2 ...)) 中的progn1 语段就可以了
_1$
; 出错后重置
_$ (setq wrap (vlax-create-object "DynamicWrapperX"))
#<VLA-OBJECT 001ca940>
_$ (vlax-invoke wrap 'Register "user32.dll" "MessageBoxW" "i=hwwu" "r=l")
1810872
_$
_$ (vlax-invoke wrap 'MessageBoxW hCAD "Hello,DynWrap" "Test for API" 2)
_1$
; 出错后重置
_$
_$
_$ (vlax-invoke wrap 'Register "kernel32" "GetCommandLine" "r=s")
1817424
_$ (vlax-invoke wrap 'GetCommandLine)
"\"D:\\Program Files\\AutoCAD 2004\\acad.exe\" /nologo /p Tssd2006S"
_$ (vlax-invoke wrap 'Register "kernel32" "Beep" "i=uu")
1881880
_$ (vlax-invoke wrap 'Beep 800 1000)
nil
_$
本帖最后由 chlh_jd 于 2011-4-24 23:14 编辑
谢谢斑竹的大力帮助！！！
去掉后面X，不能创建.
这个有点曲高和寡了，WindowAPI一不小心整个程序都会崩溃
葱白一下楼主。。。
提个问题
鼠标滚轮的滚动方向可以用VB或其他语言获取，VLISP怎么用"user32.dll"获取呢？
搜索了网页：大致获得下列信息
JavaScript(原文网址：http://www.fengfly.com/plus/view-67848-1.html)
<html>
<head>
<title>JavaScript判断鼠标滚轮滚动方向- www.fengfly.com </title>
<script type="text/javascript">
function handle(delta) {
var s = delta + ": ";
if (delta <0)
s += "您在向下滚……";
else
s += "您在向上滚……";
document.getElementById('delta').innerHTML = s;
}//from www.fengfly.com
function wheel(event){
var delta = 0;
if (!event) event = window.event;
if (event.wheelDelta) {
delta = event.wheelDelta/120;
if (window.opera) delta = -delta;
} else if (event.detail) {
delta = -event.detail/3;
}
if (delta)
handle(delta);
}
/* www.fengfly.com */
if (window.addEventListener)
window.addEventListener('DOMMouseScroll', wheel, false);
window.onmousewheel = document.onmousewheel = wheel;
</script>
</head>
<body>
<div id="delta">滚动中轮试试~请选按着中轮滚动，激活后可以不按，直接滚动。</div>
</body>
</html>
MSDN帮助
WM_MOUSEWHEEL
fwKeys = LOWORD(wParam); // key flags
zDelta = (short) HIWORD(wParam); // wheel rotation
xPos = (short) LOWORD(lParam); // horizontal position of pointer
yPos = (short) HIWORD(lParam); // vertical position of pointer
...
//Zdelta为负向前滚动，为正向后滚动
VB6.0写法
Private Type MSLLHOOKSTRUCT '鼠标HOOK时lParam指针指向的结构
pt As POINTAPI
dwMouseData As Long
dwFlags As Long
dwTime As Long
dwExtraInfo As Long
End Type
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Sub objHookLL_MouseHook(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long, lRet As Long)
'鼠标HOOK事件.
'要吃了当前消息,把lRet = -1即可.
If Code = HC_ACTION And wParam = WM_MOUSEWHEEL Then
Dim stMLL As MSLLHOOKSTRUCT
Call CopyMemory(ByVal VarPtr(stMLL), ByVal lParam, Len(stMLL))
With stMLL
Debug.Print .dwMouseData / 65536 '输出滚轮状态
'在这里可以得到鼠标坐标以及其它信息
End With
End If
txtMCode.Text = Code
txtMwParam.Text = wParam
txtMlParam.Text = lParam
Debug.Print " M = " & Code, wParam, lParam
End Sub
chlh_jd 发表于 2011-4-25 23:18 static/image/common/back.gif
提个问题
鼠标滚轮的滚动方向可以用VB或其他语言获取，VLISP怎么用"user32.dll"获取呢？
搜索了网页：大致 ...
如果要在程序中获取滚轮方向，可以用getmessage获取。
如果要做钩子，恐怕不能用vlisp实现，哪怕用API方式去实现。因为lisp函数不能定制自己的回调函数。这个地方我研究了很久，也没成功。
只需要取得滚轮方向就可以了，getmessage怎么写呢
本帖最后由 highflybird 于 2011-4-27 16:22 编辑
chlh_jd 发表于 2011-4-27 13:11 http://bbs.mjtd.com/static/image/common/back.gif
只需要取得滚轮方向就可以了，getmessage怎么写呢
(vl-load-com)
;;;*********************************************************************
;;;启动加载段-----------------------------------------------------------
;;;装入win32 API 函数---------------------------------------------------
(defun LoadAPI (DWX / dbName)
;; Library
(vlax-invoke DWX 'Register "KERNEL32" "GetLastError" "r=l")
;; Message
(vlax-invoke DWX 'Register "USER32" "GetMessage" "i=plll" "r=l")
(vlax-invoke DWX 'Register "USER32" "TranslateMessage" "i=l" "r=l")
(vlax-invoke DWX 'Register "USER32" "DispatchMessage" "i=l" "r=l")
(vlax-invoke DWX 'Register "USER32" "SendMessageW" "i=llll" "r=l")
;; memory
(vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")
(vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")
(vlax-invoke DWX 'Register "MSVCRT" "realloc" "i=pl" "r=p")
(vlax-invoke DWX 'Register "MSVCRT" "free" "i=p")
(vlax-invoke DWX 'Register "MSVCRT" "_msize" "i=p" "r=l")
)
(defun c:test()
(setq dwx (vlax-create-object "DynamicWrapperX"))
(loadAPI DWX)
(vl-catch-all-apply 'MsgProc (list DWX))
(princ)
)
;;;处理对话框的各种消息
(defun MsgProc (DWX / ptr whwd pMsg aMsg bMsg ret isExit)
(setq isExit T)
(setq ptr (vlax-invoke DWX 'calloc 1 28))
(while (and
(/= (setq Ret (vlax-invoke DWX 'GetMessage ptr 0 0 0)) 0) ;接收各种消息
isExit ;是否退出
)
(if (= Ret -1)
(progn
(vlax-invoke DWX 'free ptr)
(exit)
)
)
(setq whwd (vlax-invoke DWX 'numget ptr0)) ;消息所属的窗口
(setq pMsg (vlax-invoke DWX 'numget ptr4)) ;消息的标识符
(setq aMsg (vlax-invoke DWX 'numget ptr8)) ;消息的附加信息
(setq bMsg (vlax-invoke DWX 'numget ptr 12)) ;消息的附加信息
(vlax-invoke DWX 'TranslateMessage ptr) ;转换消息
(vlax-invoke DWX 'DispatchMessage ptr) ;派送消息
(if (and (= pMsg 257) (= aMsg 27))
(setq isExit nil)
)
(if (= pMsg522)
(progn
(princ "\n你按了鼠标滚轮.")
(if (> aMsg 0)
(princ "向前滚动!")
(princ "向后滚动!")
)
)
)
)
(vlax-invoke DWX 'free ptr)
)
太强了！~可以正确给出滚轮信息，我再学习下，看看能不能把ACAD的缩放反应屏蔽掉、把滚幅求出来！
非常感谢！~