[源码]窗口右键菜单及下拉菜单的实现

yxp

菜单的增加和减少，只需要改动3个地方
1    LISP代码  *Namecap* 菜单名称
2    Lisp代码 菜单点击事件中对应的响应函数 dcf 定义
3   Odcl窗口  对应的图像按钮增减及改名

2. ;;===============================================================
   
3. ;;OpenDCL右键菜单的实现
   
4. ;;原创，小蜜蜂，QQ:9034589  2013-6-23
   
5. ;;===============================================================
   
6. (defun c:rmenu( / ssr lt *ss-rigthmenu*)
   
7. (setq ssr "Rmenu_Form1_RightMneu" n 0
   
8.        *Namecap* '("菜单1" "背景-蓝色" "背景-红色" "前景-青色" "前景-黑色" "退出"))
   
9. (repeat (length *Namecap*)
   
10.    (setq *ss-rigthmenu* (cons (strcat ssr (itoa (setq n (1+ n)))) *ss-rigthmenu*)))
    
11. 
    
12.    (dcl_Project_Load "Rmenu.odcl" t)
    
13.    (dcl_Form_Show Rmenu_Form1)
    
14.    (princ)
    
15. )
    
16. ;;初始化窗口
    
17. (defun c:Rmenu_Form1_OnInitialize (/)
    
18. (setq *RM-ent* (mapcar '(lambda(x)(eval (read x)))  *ss-rigthmenu*)) ;;控件数组
    
19. (Def_Clicked_Fun)
    
20. (move_mouse_color *ss-rigthmenu*)
    
21. )
    
22. 
    
23. (defun c:Rmenu_Form1_PictureBox1_OnRightClick (/)
    
24. (right_menue_pos *x^_^x* *y^_^y*)
    
25. )
    
26. 
    
27. (defun c:Rmenu_Form1_PictureBox1_OnMouseMove (Flags X Y /)(setq *x^_^x* x *y^_^Y* y))
    
28. (defun c:Rmenu_Form1_PictureBox1_OnClicked (/)(show_hidee_cs nil))
    
29. 
    
30. 
    
31. 
    
32. 
    
33. ;;设置菜单显示的位置
    
34. ;;窗口宽度 ww 高度 wh;  菜单宽度 cw 高度 ch
    
35. (defun right_menue_pos(x y / d zch xx yy nn)
    
36. (setq ww 600 wh 340 cw 100 ch 24 nn (length *Namecap*) zch (* nn ch))
    
37. (cond
    
38.    ((and (< x (- ww cw)) (> y (- wh zch))) (setq xx x yy (- wh zch))) ;;第一象限显示
    
39.    ((and (< x (- ww cw)) (< y (- wh zch))) (setq xx x yy y)) ;;第四象限
    
40.    ((and (> x (- ww cw)) (< y (- wh zch))) (setq xx (- x cw) yy y)) ;;第三象限
    
41.    ((and (> x (- ww cw)) (> y (- wh zch))) (setq xx (- x cw) yy (- wh zch)))  ;;第二象限
    
42. )
    
43. (setq d (- yy ch)) ;;23为每条菜单的高度
    
44. (foreach a (mapcar 'cons *RM-ent* *Namecap*)
    
45.    (dcl_Control_ZOrder (car a) 1)  ;;提到最顶端显示，如果已经是最前就不需要
    
46.    (dcl_Control_SetPos (car a) xx (setq d (+ d ch)) cw ch)
    
47.    (dcl_Control_SetCaption (car a) (cdr a))
    
48.    )
    
49. (show_hidee_cs t)
    
50. )
    
51. 
    
52. 
    
53. ;;定义菜单单击事件
    
54. (defun Def_Clicked_Fun( / dcf)
    
55. (setq dcf '("fun1" "fun2" "fun3" "fun4" "fun5" "fun6")) ;;单击响应函数列表
    
56. (foreach x (mapcar 'cons *ss-rigthmenu* dcf)
    
57.   (eval (read (strcat "(defun c:" (car x) "_OnClicked (/)"
    
58.         "(" (cdr x) " (dcl_Control_GetCaption " (car x) ")))"))))
    
59. )
    
60. 
    
61. 
    
62. ;;定义鼠标滑过菜单的高亮显示
    
63. (defun move_mouse_color(L / )
    
64. (setq *#$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$%^&* L)
    
65. (foreach x L
    
66.    (eval (read (strcat "(defun c:" x "_OnMouseMove (Flags X Y / xxLt er)"
    
67.       "(setq xxLt (mapcar '(lambda(y)(list y -16 -19)) *#$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$%^&*)"
    
68.        "     xxLt (subst (list "" x "" -3 -16)(assoc "" x "" xxLt) xxLt)"
    
69.        "*LTMenu* (cons " x " (car *LTMenu*)) er (cdr *LTMenu*))"  ;;防止菜单闪烁
    
70.       "(if (and er (/= er (car *LTMenu*))) (foreach y xxLt "
    
71.       "(dcl_Control_SetBackColor (eval (read (car y))) (cadr y))"
    
72.       "(dcl_Control_SetForeColor (eval (read (car y))) (caddr y)))))"))))
    
73. )
    
74. 
    
75. 
    
76. ;;菜单的切换显示
    
77. (defun show_hidee_cs(c)
    
78. (foreach x *RM-ent* (dcl_Control_SetVisible x c))
    
79. )
    
80. 
    
81. ;;调用自定义函数
    
82. (defun fun1( ss )
    
83. (show_hidee_cs nil)
    
84. (dcl_MessageBox (strcat "你点击了 " ss "  ") "提示" 2 2)
    
85. )
    
86. 
    
87. 
    
88. (defun fun2( ss )
    
89. (show_hidee_cs nil)
    
90. (dcl_Control_SetBackColor Rmenu_Form1_PictureBox1 5)
    
91. )
    
92. (defun fun3( ss )
    
93. (show_hidee_cs nil)
    
94. (dcl_Control_SetBackColor Rmenu_Form1_PictureBox1 1)
    
95. )
    
96. (defun fun4( ss )
    
97. (show_hidee_cs nil)
    
98. (dcl_Control_SetBackColor Rmenu_Form1_Label1 4)
    
99. )
    
100. (defun fun5( ss )
     
101. (show_hidee_cs nil)
     
102. (dcl_Control_SetBackColor Rmenu_Form1_Label1 -22)
     
103. )
     
104. (defun fun6( ss )
     
105. (dcl_Form_Close Rmenu_Form1)
     
106. )
     
107. 
     
108. 
     
109. 
     
110. 
     
111. 
     
112. 
     
113. 
     

;;===============================================================<br /> ;;OpenDCL右键菜单的实现<br /> ;;原创，小蜜蜂，QQ:9034589  2013-6-23<br /> ;;===============================================================<br /> (defun c:rmenu( / ssr lt *ss-rigthmenu*)<br /> (setq ssr "Rmenu_Form1_RightMneu" n 0<br />        *Namecap* '("菜单1" "背景-蓝色" "背景-红色" "前景-青色" "前景-黑色" "退出"))<br /> (repeat (length *Namecap*)<br />    (setq *ss-rigthmenu* (cons (strcat ssr (itoa (setq n (1+ n)))) *ss-rigthmenu*)))<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 *ss-rigthmenu*)<br /> )<br /> <br /> (defun c:Rmenu_Form1_PictureBox1_OnRightClick (/)<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 /> ;;设置菜单显示的位置<br /> ;;窗口宽度 ww 高度 wh;  菜单宽度 cw 高度 ch<br /> (defun right_menue_pos(x y / d zch xx yy nn)<br /> (setq ww 600 wh 340 cw 100 ch 24 nn (length *Namecap*) zch (* nn ch))<br /> (cond<br />    ((and (< x (- ww cw)) (> y (- wh zch))) (setq xx x yy (- wh zch))) ;;第一象限显示 <br />    ((and (< x (- ww cw)) (< y (- wh zch))) (setq xx x yy y)) ;;第四象限<br />    ((and (> x (- ww cw)) (< y (- wh zch))) (setq xx (- x cw) yy y)) ;;第三象限<br />    ((and (> x (- ww cw)) (> y (- wh zch))) (setq xx (- x cw) yy (- wh zch)))  ;;第二象限<br /> )<br /> (setq d (- yy ch)) ;;23为每条菜单的高度<br /> (foreach a (mapcar 'cons *RM-ent* *Namecap*)<br />    (dcl_Control_ZOrder (car a) 1)  ;;提到最顶端显示，如果已经是最前就不需要<br />    (dcl_Control_SetPos (car a) xx (setq d (+ d ch)) cw ch)<br />    (dcl_Control_SetCaption (car a) (cdr a))<br />    )<br /> (show_hidee_cs t)<br /> )<br /> <br /> <br /> ;;定义菜单单击事件<br /> (defun Def_Clicked_Fun( / dcf)<br /> (setq dcf '("fun1" "fun2" "fun3" "fun4" "fun5" "fun6")) ;;单击响应函数列表<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(L / )<br /> (setq *#$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$%^&* L)<br /> (foreach x L<br />    (eval (read (strcat "(defun c:" x "_OnMouseMove (Flags X Y / xxLt er)"<br />       "(setq xxLt (mapcar '(lambda(y)(list y -16 -19)) *#$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$%^&*)"<br />        "     xxLt (subst (list "" x "" -3 -16)(assoc "" x "" xxLt) xxLt)"<br />        "*LTMenu* (cons " x " (car *LTMenu*)) er (cdr *LTMenu*))"  ;;防止菜单闪烁<br />       "(if (and er (/= er (car *LTMenu*))) (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 /> <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_Label1 4)<br /> )<br /> (defun fun5( ss )<br /> (show_hidee_cs nil)<br /> (dcl_Control_SetBackColor Rmenu_Form1_Label1 -22)<br /> )<br /> (defun fun6( ss )<br /> (dcl_Form_Close Rmenu_Form1)<br /> )<br /> <br /> <br /> <br /> <br /> <br /> <br /> <br />

ODCL环境自理
源码下载

pengfei2010

感谢楼主的无私分享 谢谢

479274135

感谢分享  ................................

tianyi1230

我来捧场，哈哈，又是沙发啊，

海盗曹

厉害啊，学习了

品茗新秀

出现; 错误: no function definition: DCL_PROJECT_LOAD

wyl605

这么好的东东
能教一下ODCL环境自理

品茗新秀

学习了,你用的是哪个版本 opendcl没找到有后缀为**.arx

品茗新秀

还有想把窗口放CAD的右上方,应在哪一句上修改,用哪个代码

一克拉沙

不错，不过只带下拉菜单的代码，就像结构计算V1.0演示的那样，贴出了看看啊。

lenovo1x1

hao 。存下来 备用

薰衣草-花语

很好，下载了作为参考