明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: highflybir

[【高飞鸟】] 越飞越高讲堂(2)CAD的API编程指南(上)--DynamicWrapperX

    [复制链接]
发表于 2011-4-24 23:07 | 显示全部楼层
本帖最后由 highflybird 于 2011-4-24 23:12 编辑

(vlax-get-or-create-object "DynamicWrapperX")这样也不行吗?

用这个试下看能创建(vlax-get-or-create-object "DynamicWrapper") 么?这个是早期的版本。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2011-4-24 23:08 | 显示全部楼层
但是单独执行
(if  ... (progn1 ... ) (progn2 ...)) 中的progn1 语段就可以了

  1. _1$
  2. ; 出错后重置
  3. _$ (setq wrap (vlax-create-object "DynamicWrapperX"))
  4. #<VLA-OBJECT 001ca940>
  5. _$ (vlax-invoke wrap 'Register "user32.dll" "MessageBoxW" "i=hwwu" "r=l")
  6. 1810872
  7. _$
  8. _$ (vlax-invoke wrap 'MessageBoxW hCAD "Hello,DynWrap" "Test for API" 2)
  9. _1$
  10. ; 出错后重置
  11. _$
  12. _$
  13. _$ (vlax-invoke wrap 'Register "kernel32" "GetCommandLine" "r=s")
  14. 1817424
  15. _$ (vlax-invoke wrap 'GetCommandLine)
  16. ""D:\\Program Files\\AutoCAD 2004\\acad.exe" /nologo /p Tssd2006S"
  17. _$ (vlax-invoke wrap 'Register "kernel32" "Beep" "i=uu")
  18. 1881880
  19. _$ (vlax-invoke wrap 'Beep 800 1000)
  20. nil
  21. _$

发表于 2011-4-24 23:12 | 显示全部楼层
本帖最后由 chlh_jd 于 2011-4-24 23:14 编辑

谢谢斑竹的大力帮助!!!
去掉后面X,不能创建.
发表于 2011-4-24 23:38 | 显示全部楼层
这个有点曲高和寡了,WindowAPI一不小心整个程序都会崩溃
发表于 2011-4-25 21:15 | 显示全部楼层
葱白一下楼主。。。
发表于 2011-4-25 23:18 | 显示全部楼层
提个问题
鼠标滚轮的滚动方向可以用VB或其他语言获取,VLISP怎么用"user32.dll"获取呢?
搜索了网页:大致获得下列信息
JavaScript(原文网址:http://www.fengfly.com/plus/view-67848-1.html)

  1. <html>
  2. <head>
  3. <title>JavaScript判断鼠标滚轮滚动方向- www.fengfly.com </title>
  4. <script type="text/javascript">
  5. function handle(delta) {
  6.     var s = delta + ": ";
  7.     if (delta <0)
  8.         s += "您在向下滚……";
  9.     else
  10.         s += "您在向上滚……";
  11.     document.getElementById('delta').innerHTML = s;
  12. }//from www.fengfly.com

  13. function wheel(event){
  14.     var delta = 0;
  15.     if (!event) event = window.event;
  16.     if (event.wheelDelta) {
  17.         delta = event.wheelDelta/120;
  18.         if (window.opera) delta = -delta;
  19.     } else if (event.detail) {
  20.         delta = -event.detail/3;
  21.     }
  22.     if (delta)
  23.         handle(delta);
  24. }

  25. /* www.fengfly.com */
  26. if (window.addEventListener)
  27. window.addEventListener('DOMMouseScroll', wheel, false);
  28. window.onmousewheel = document.onmousewheel = wheel;
  29. </script>
  30. </head>
  31. <body>
  32. <div id="delta">滚动中轮试试~请选按着中轮滚动,激活后可以不按,直接滚动。</div>
  33. </body>
  34. </html>
复制代码

MSDN帮助

  1. WM_MOUSEWHEEL
  2. fwKeys = LOWORD(wParam); // key flags
  3. zDelta = (short) HIWORD(wParam); // wheel rotation
  4. xPos = (short) LOWORD(lParam); // horizontal position of pointer
  5. yPos = (short) HIWORD(lParam); // vertical position of pointer
  6. ...
  7. //Zdelta为负向前滚动,为正向后滚动
复制代码

VB6.0写法

  1. Private Type MSLLHOOKSTRUCT     '鼠标HOOK时lParam指针指向的结构
  2.     pt As POINTAPI
  3.     dwMouseData As Long
  4.     dwFlags As Long
  5.     dwTime As Long
  6.     dwExtraInfo As Long
  7. End Type
  8. Private Const WM_MOUSEWHEEL As Long = &H20A

  9. Private Sub objHookLL_MouseHook(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long, lRet As Long)
  10.     '鼠标HOOK事件.
  11.     '要吃了当前消息,把lRet = -1即可.
  12.     If Code = HC_ACTION And wParam = WM_MOUSEWHEEL Then
  13.         Dim stMLL As MSLLHOOKSTRUCT        
  14.         Call CopyMemory(ByVal VarPtr(stMLL), ByVal lParam, Len(stMLL))      
  15.         With stMLL
  16.             Debug.Print .dwMouseData / 65536        '输出滚轮状态
  17.             '在这里可以得到鼠标坐标以及其它信息
  18.         End With
  19.     End If
  20.     txtMCode.Text = Code
  21.     txtMwParam.Text = wParam
  22.     txtMlParam.Text = lParam
  23.     Debug.Print "   M = " & Code, wParam, lParam
  24. End Sub
发表于 2011-4-26 11:11 | 显示全部楼层
chlh_jd 发表于 2011-4-25 23:18
提个问题
鼠标滚轮的滚动方向可以用VB或其他语言获取,VLISP怎么用"user32.dll"获取呢?
搜索了网页:大致 ...

如果要在程序中获取滚轮方向,可以用getmessage获取。
如果要做钩子,恐怕不能用vlisp实现,哪怕用API方式去实现。因为lisp函数不能定制自己的回调函数。这个地方我研究了很久,也没成功。
发表于 2011-4-27 13:11 | 显示全部楼层
只需要取得滚轮方向就可以了,getmessage怎么写呢
发表于 2011-4-27 15:57 | 显示全部楼层
本帖最后由 highflybird 于 2011-4-27 16:22 编辑
chlh_jd 发表于 2011-4-27 13:11
只需要取得滚轮方向就可以了,getmessage怎么写呢


  1. (vl-load-com)
  2. ;;;*********************************************************************
  3. ;;;启动加载段-----------------------------------------------------------
  4. ;;;装入win32 API 函数---------------------------------------------------
  5. (defun LoadAPI (DWX / dbName)
  6.   ;; Library
  7.   (vlax-invoke DWX 'Register "KERNEL32" "GetLastError" "r=l")               
  8.   ;; Message
  9.   (vlax-invoke DWX 'Register "USER32" "GetMessage" "i=plll" "r=l")
  10.   (vlax-invoke DWX 'Register "USER32" "TranslateMessage" "i=l" "r=l")
  11.   (vlax-invoke DWX 'Register "USER32" "DispatchMessage" "i=l" "r=l")
  12.   (vlax-invoke DWX 'Register "USER32" "SendMessageW" "i=llll" "r=l")
  13.   ;; memory
  14.   (vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")
  15.   (vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")
  16.   (vlax-invoke DWX 'Register "MSVCRT" "realloc" "i=pl" "r=p")
  17.   (vlax-invoke DWX 'Register "MSVCRT" "free" "i=p")
  18.   (vlax-invoke DWX 'Register "MSVCRT" "_msize" "i=p" "r=l")
  19. )

  20. (defun c:test()
  21.   (setq dwx (vlax-create-object "DynamicWrapperX"))
  22.   (loadAPI DWX)
  23.   (vl-catch-all-apply 'MsgProc (list DWX))
  24.   (princ)
  25. )
  26. ;;;处理对话框的各种消息
  27. (defun MsgProc (DWX / ptr whwd pMsg aMsg bMsg ret isExit)
  28.   (setq isExit T)
  29.   (setq ptr (vlax-invoke DWX 'calloc 1 28))
  30.   (while (and
  31.     (/= (setq Ret (vlax-invoke DWX 'GetMessage ptr 0 0 0)) 0)    ;接收各种消息
  32.     isExit       ;是否退出
  33.   )
  34.     (if (= Ret -1)
  35.       (progn
  36. (vlax-invoke DWX 'free ptr)
  37. (exit)
  38.       )
  39.     )
  40.     (setq whwd (vlax-invoke DWX 'numget ptr  0))   ;消息所属的窗口
  41.     (setq pMsg (vlax-invoke DWX 'numget ptr  4))   ;消息的标识符
  42.     (setq aMsg (vlax-invoke DWX 'numget ptr  8))   ;消息的附加信息
  43.     (setq bMsg (vlax-invoke DWX 'numget ptr 12))   ;消息的附加信息
  44.     (vlax-invoke DWX 'TranslateMessage ptr)    ;转换消息
  45.     (vlax-invoke DWX 'DispatchMessage ptr)    ;派送消息
  46.     (if (and (= pMsg 257) (= aMsg 27))
  47.       (setq isExit nil)
  48.     )
  49.     (if (= pMsg  522)
  50.       (progn
  51. (princ "\n你按了鼠标滚轮.")
  52. (if (> aMsg 0)
  53.    (princ "向前滚动!")
  54.    (princ "向后滚动!")
  55. )
  56.       )
  57.     )
  58.   )
  59.   (vlax-invoke DWX 'free ptr)
  60. )


发表于 2011-4-28 14:32 | 显示全部楼层
太强了!~可以正确给出滚轮信息,我再学习下,看看能不能把ACAD的缩放反应屏蔽掉、把滚幅求出来!
非常感谢!~
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-28 18:22 , Processed in 2.478098 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表