右键菜单的简单实现

yxpxa

OpenDCL没有右键菜单，我用按钮控件简单组合了一个，按照这个方法，窗口顶部的下拉菜单也能模拟出来，甚至比右键菜单简单些，不需提取x y坐标。这是在我的 dtx 文本编辑里已实现的，现发布出来请大家提提意见。

2. 
   
3. ;;OpenDCL右键菜单的实现
   
4. ;;原创，小蜜蜂，小东空间，2013-6-23
   
5. (defun c:rmenu( / ssr lt)
   
6. (setq ssr "Rmenu_Form1_RightMneu" Lt '("1" "2" "3" "4" "5") ;;5个菜单控件，不够可以加
   
7.        *Namecap* '("菜单1" "背景-蓝色" "背景-红色" "背景-青色" "退出")
   
8.        *ss-rigthmenu* (mapcar '(lambda(x)(strcat ssr x)) Lt))
   
9. 
   
10.    (dcl_Project_Load "Rmenu.odcl" t)
    
11.    (dcl_Form_Show Rmenu_Form1)
    
12.    (princ)
    
13. )
    
14. ;;初始化窗口
    
15. (defun c:Rmenu_Form1_OnInitialize (/)
    
16. (setq *RM-ent* (mapcar '(lambda(x)(eval (read x)))  *ss-rigthmenu*)) ;;控件数组
    
17. (Def_Clicked_Fun)
    
18. (move_mouse_color)
    
19. )
    
20. 
    
21. (defun c:Rmenu_Form1_PictureBox1_OnRightClick (/)
    
22. (show_hidee_cs t)
    
23. (right_menue_pos *x^_^x* *y$$$$_$$$$Y*)
    
24. )
    
25. 
    
26. (defun c:Rmenu_Form1_PictureBox1_OnMouseMove (Flags X Y /)(setq *x^_^x* x *y$$$$_$$$$Y* y))
    
27. (defun c:Rmenu_Form1_PictureBox1_OnClicked (/)(show_hidee_cs nil))
    
28. 
    
29. 
    
30. 
    
31. ;;设置菜单显示的位置
    
32. (defun right_menue_pos(x y)
    
33. (setq D (- y 23)) ;;23为每条菜单的高度
    
34. (foreach a (mapcar 'cons *RM-ent* *Namecap*)
    
35.    (dcl_Control_SetPos (car a) x (setq d (+ d 23)))
    
36.    (dcl_Control_SetCaption (car a) (cdr a)))
    
37. )
    
38. 
    
39. 
    
40. ;;定义菜单单击事件
    
41. (defun Def_Clicked_Fun( / dcf)
    
42. (setq dcf '("fun1" "fun2" "fun3" "fun4" "fun5")) ;;单击响应函数列表
    
43. (foreach x (mapcar 'cons *ss-rigthmenu* dcf)
    
44.   (eval (read (strcat "(defun c:" (car x) "_OnClicked (/)"
    
45.         "(" (cdr x) " (dcl_Control_GetCaption " (car x) ")))"))))
    
46. )
    
47. 
    
48. 
    
49. ;;定义鼠标滑过菜单的高亮显示
    
50. (defun move_mouse_color()
    
51. (foreach x *ss-rigthmenu*
    
52.    (eval (read (strcat "(defun c:" x "_OnMouseMove (Flags X Y / xxLt)"
    
53.       "(setq xxLt (mapcar '(lambda(y)(list y -16 -19)) (vl-remove "" x "" *ss-rigthmenu*))"
    
54.        "     xxLt (cons (list "" x "" -3 -16) xxLt))"
    
55.       "(foreach y xxLt "
    
56.       "(dcl_Control_SetBackColor (eval (read (car y))) (cadr y))"
    
57.       "(dcl_Control_SetForeColor (eval (read (car y))) (caddr y))))"))))
    
58. )
    
59. 
    
60. 
    
61. ;;菜单的切换显示
    
62. (defun show_hidee_cs(c)
    
63. (foreach x *RM-ent* (dcl_Control_SetVisible x c))
    
64. )
    
65. 
    
66. ;;调用自定义函数
    
67. (defun fun1( ss )
    
68. (show_hidee_cs nil)
    
69.   (dcl_MessageBox (strcat "你点击了 " ss "  ") "提示" 2 2)
    
70. )
    
71. (defun fun2( ss )
    
72. (show_hidee_cs nil)
    
73. (dcl_Control_SetBackColor Rmenu_Form1_PictureBox1 5)
    
74. )
    
75. (defun fun3( ss )
    
76. (show_hidee_cs nil)
    
77. (dcl_Control_SetBackColor Rmenu_Form1_PictureBox1 1)
    
78. )
    
79. (defun fun4( ss )
    
80. (show_hidee_cs nil)
    
81. (dcl_Control_SetBackColor Rmenu_Form1_PictureBox1 4)
    
82. )
    
83. (defun fun5( ss )
    
84. (dcl_Form_Close Rmenu_Form1)
    
85. )
    
86. 
    
87. 
    
88. 
    
89. 
    
90. 
    
91. 
    
92. 
    

<br /> ;;OpenDCL右键菜单的实现<br /> ;;原创，小蜜蜂，小东空间，2013-6-23<br /> (defun c:rmenu( / ssr lt)<br /> (setq ssr "Rmenu_Form1_RightMneu" Lt '("1" "2" "3" "4" "5") ;;5个菜单控件，不够可以加<br />        *Namecap* '("菜单1" "背景-蓝色" "背景-红色" "背景-青色" "退出")<br />        *ss-rigthmenu* (mapcar '(lambda(x)(strcat ssr x)) Lt))<br /> <br />    (dcl_Project_Load "Rmenu.odcl" t)<br />    (dcl_Form_Show Rmenu_Form1)<br />    (princ) <br /> )<br /> ;;初始化窗口<br /> (defun c:Rmenu_Form1_OnInitialize (/)<br /> (setq *RM-ent* (mapcar '(lambda(x)(eval (read x)))  *ss-rigthmenu*)) ;;控件数组<br /> (Def_Clicked_Fun)<br /> (move_mouse_color)<br /> )<br /> <br /> (defun c:Rmenu_Form1_PictureBox1_OnRightClick (/)<br /> (show_hidee_cs t)<br /> (right_menue_pos *x^_^x* *y$$$$_$$$$Y*)<br /> )<br /> <br /> (defun c:Rmenu_Form1_PictureBox1_OnMouseMove (Flags X Y /)(setq *x^_^x* x *y$$$$_$$$$Y* y))<br /> (defun c:Rmenu_Form1_PictureBox1_OnClicked (/)(show_hidee_cs nil))<br /> <br /> <br /> <br /> ;;设置菜单显示的位置<br /> (defun right_menue_pos(x y)<br /> (setq D (- y 23)) ;;23为每条菜单的高度<br /> (foreach a (mapcar 'cons *RM-ent* *Namecap*)<br />    (dcl_Control_SetPos (car a) x (setq d (+ d 23)))<br />    (dcl_Control_SetCaption (car a) (cdr a)))<br /> )<br /> <br /> <br /> ;;定义菜单单击事件<br /> (defun Def_Clicked_Fun( / dcf)<br /> (setq dcf '("fun1" "fun2" "fun3" "fun4" "fun5")) ;;单击响应函数列表<br /> (foreach x (mapcar 'cons *ss-rigthmenu* dcf)<br />   (eval (read (strcat "(defun c:" (car x) "_OnClicked (/)"<br />         "(" (cdr x) " (dcl_Control_GetCaption " (car x) ")))"))))<br /> )<br /> <br /> <br /> ;;定义鼠标滑过菜单的高亮显示<br /> (defun move_mouse_color()<br /> (foreach x *ss-rigthmenu*<br />    (eval (read (strcat "(defun c:" x "_OnMouseMove (Flags X Y / xxLt)"<br />       "(setq xxLt (mapcar '(lambda(y)(list y -16 -19)) (vl-remove "" x "" *ss-rigthmenu*))"<br />        "     xxLt (cons (list "" x "" -3 -16) xxLt))"<br />       "(foreach y xxLt "<br />       "(dcl_Control_SetBackColor (eval (read (car y))) (cadr y))"<br />       "(dcl_Control_SetForeColor (eval (read (car y))) (caddr y))))"))))<br /> )<br /> <br /> <br /> ;;菜单的切换显示<br /> (defun show_hidee_cs(c)<br /> (foreach x *RM-ent* (dcl_Control_SetVisible x c))<br /> )<br /> <br /> ;;调用自定义函数<br /> (defun fun1( ss )<br /> (show_hidee_cs nil)<br />   (dcl_MessageBox (strcat "你点击了 " ss "  ") "提示" 2 2)<br /> )<br /> (defun fun2( ss )<br /> (show_hidee_cs nil)<br /> (dcl_Control_SetBackColor Rmenu_Form1_PictureBox1 5)<br /> )<br /> (defun fun3( ss )<br /> (show_hidee_cs nil)<br /> (dcl_Control_SetBackColor Rmenu_Form1_PictureBox1 1)<br /> )<br /> (defun fun4( ss )<br /> (show_hidee_cs nil)<br /> (dcl_Control_SetBackColor Rmenu_Form1_PictureBox1 4)<br /> )<br /> (defun fun5( ss )<br /> (dcl_Form_Close Rmenu_Form1)<br /> )<br /> <br /> <br /> <br /> <br /> <br /> <br /> <br />

源码共享如下：

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:右键菜单测试.rar 
下载次数:82  文件大小:2.2 KB 
下载权限: 不限 以上  [免费赚D豆]

Gdlprfcu

cad自身就可以自定义菜单，为何还要这样做，使用menucmd函数让它显示不是更好吗？

牢固

Gdlprfcu 发表于 2013-6-23 08:44
cad自身就可以自定义菜单，为何还要这样做，使用menucmd函数让它显示不是更好吗？

楼主演示的对话框中的右键菜单使用，非CAD中的右键菜单！

Gdlprfcu

牢固 发表于 2013-6-23 11:23
楼主演示的对话框中的右键菜单使用，非CAD中的右键菜单！

cad中使用和对话框中使用不是一样的吗？

XDSoft

Gdlprfcu 发表于 2013-6-23 12:35
cad中使用和对话框中使用不是一样的吗？

你这个对话框是ODCL做的吗？ 把代码贴上论坛吧。

Gdlprfcu

XDSoft 发表于 2013-6-23 13:23
你这个对话框是ODCL做的吗？ 把代码贴上论坛吧。

对话框是OPENDCL做的，但代码是花了我很多心思和精力写的，虽然到现在为止还是个未完成之作，但还不想去公布源码，sorry.

小妖妖

请问那个是什么LISP编辑器啊？怎么样能够让他识别LISP内部函数啊 ？

lt77887788

大神，只能膜拜了·························