DCL对话框添加菜单——API应用2

yxp

DCL 默认对话框是没有菜单的，既然可以调用 windows api 就可以随心所欲了
下面是一个给 DCL 添加菜单的示例，同样的方法可以给 DCL 添加一个右键菜单

1. ;;本例将调用 windows api 给 DCL 添加一个完整菜单
   
2. ;; by. yxp_xa   2018年6月23日
   
3. (defun c:sss()
   
4. (setq dcl_id (load_dialog "sss.dcl"))
   
5. (if (not (new_dialog "sss" dcl_id))(exit))
   
6. (add_menu_pop)
   
7. (start_dialog)
   
8. (unload_dialog dcl_id)
   
9. (princ)
   
10. )
    
11. 
    
12. ;;DCL窗口菜单
    
13. (defun add_menu_pop()
    
14. (setq DWX (vlax-create-object "DynamicWrapperX"))
    
15. (vlax-invoke DWX 'Register "user32" "FindWindowExW" "i=hhhw" "r=m")
    
16. (vlax-invoke DWX 'Register "user32" "SetMenu" "i=hh" "r=l")
    
17. (vlax-invoke DWX 'Register "user32" "CreateMenu" "r=l")
    
18. (vlax-invoke DWX 'Register "user32" "CreatePopupMenu" "r=l")
    
19. (vlax-invoke DWX 'Register "user32" "AppendMenuW" "i=plpw" "r=l")
    
20. (setq dcl (vlax-invoke DWX 'FindWindowExW 0 0 0 "DCL窗口菜单示例"))
    
21. (setq hMenu (vlax-invoke DWX 'CreateMenu)) ;;顶级菜单句柄
    
22. (setq menu (mapcar '(lambda(x)  ;;创建顶级菜单
    
23.     (list (vlax-invoke DWX 'CreatePopupMenu) x))
    
24.     (list "文件(&F)" "编辑(&E)" "帮助(&H)"))
    
25. )
    
26. (foreach x menu (vlax-invoke DWX 'AppendMenuW hMenu 16 (car x)(cadr x)))
    
27. (setq pop (list  ;;创建子菜单
    
28.     '((101 "文件 (&F)")(102 "打开 (&O)...")(103 "保存 (&S)")(104 "关闭 (&C)"))
    
29.     '((201 "复制 (&C)")(202 "粘贴 (&P)")(203 "剪切 (&X)"))
    
30.     '((301 "帮助 (&H)")(302 "注册 (&R)")(303 "关于 (&A)...")))
    
31. )
    
32. (mapcar '(lambda(x y)(foreach z y
    
33.     (vlax-invoke DWX 'AppendMenuW (car x) 0 (car z)(cadr z)))) menu pop)
    
34. (vlax-invoke DWX 'SetMenu dcl hMenu)
    
35. )
    
36. (princ)

;;本例将调用 windows api 给 DCL 添加一个完整菜单<br /> ;; by. yxp_xa   2018年6月23日<br /> (defun c:sss()<br /> (setq dcl_id (load_dialog "sss.dcl"))<br /> (if (not (new_dialog "sss" dcl_id))(exit))<br /> (add_menu_pop)<br /> (start_dialog)<br /> (unload_dialog dcl_id)<br /> (princ)<br /> )<br /> <br /> ;;DCL窗口菜单<br /> (defun add_menu_pop()<br /> (setq DWX (vlax-create-object "DynamicWrapperX"))<br /> (vlax-invoke DWX 'Register "user32" "FindWindowExW" "i=hhhw" "r=m")<br /> (vlax-invoke DWX 'Register "user32" "SetMenu" "i=hh" "r=l")<br /> (vlax-invoke DWX 'Register "user32" "CreateMenu" "r=l")<br /> (vlax-invoke DWX 'Register "user32" "CreatePopupMenu" "r=l")<br /> (vlax-invoke DWX 'Register "user32" "AppendMenuW" "i=plpw" "r=l")<br /> (setq dcl (vlax-invoke DWX 'FindWindowExW 0 0 0 "DCL窗口菜单示例"))<br /> (setq hMenu (vlax-invoke DWX 'CreateMenu)) ;;顶级菜单句柄<br /> (setq menu (mapcar '(lambda(x)  ;;创建顶级菜单<br />     (list (vlax-invoke DWX 'CreatePopupMenu) x))<br />     (list "文件(&F)" "编辑(&E)" "帮助(&H)"))<br /> )<br /> (foreach x menu (vlax-invoke DWX 'AppendMenuW hMenu 16 (car x)(cadr x)))<br /> (setq pop (list  ;;创建子菜单<br />     '((101 "文件 (&F)")(102 "打开 (&O)...")(103 "保存 (&S)")(104 "关闭 (&C)"))<br />     '((201 "复制 (&C)")(202 "粘贴 (&P)")(203 "剪切 (&X)"))<br />     '((301 "帮助 (&H)")(302 "注册 (&R)")(303 "关于 (&A)...")))<br /> )<br /> (mapcar '(lambda(x y)(foreach z y<br />     (vlax-invoke DWX 'AppendMenuW (car x) 0 (car z)(cadr z)))) menu pop)<br /> (vlax-invoke DWX 'SetMenu dcl hMenu)<br /> )<br /> (princ)

源码下载：

dwx自动注册工具下载：

yxp

xinxirong 发表于 2018-6-24 07:48
模块转非模块哪有那么容易。另外菜单命令的实现呢？

模块转换确实不能，这是完全两种数据类型，就像把 int 转换为 string，但是可以创建两套一模一样的窗口，点击切换时终止一个再调用另一个。
菜单命令的响应需要回调 lisp 函数，以函数的指针为参数，lisp 又不支持指针，还没想出来怎么操作，需要大神的参与或大家一起研究怎么处理。
我能想到的办法有以下几个：
1  找到 lisp 的函数指针。例如，在命令行里用 !setq ，可以查到 setq 的函数的一个编号，但不知道和指针的关系
2  通过 C# 或 C++ 设置一个外部函数，这个函数指针可以得到，再通过这个函数向命令行发送字符串来回调 lisp
3  通过 API 或 dwx 函数设置回调函数

zark

http://bbs.mjtd.com/thread-113505-1-1.html




避开API，兼容性会不会更强点

Kye

谢谢分享，给论坛注入了新能量，长知识了，这个也能实现DCL非模态对话框吧？

xinxirong

模块转非模块哪有那么容易。另外菜单命令的实现呢？

土木燃

膜拜大神！！！！！！！！6666

张大锤

还没学到DCL 对话框 但是 第一个调用DCL 就是我的开门砖

oistre

看到版主的教程，慢慢研究，谢谢谢谢

baitang36

学习了，很不错的功能。dwx给lisp加上了翅膀

陨落

纯lisp+外部exe实现，无视cad版本限制。