[原创作品]模仿面向对象实现动态DCL代码生成器(开源)

不死猫

动态DCL的方法有很多,我曾经也发过3种制作的方案.
今天带来的是更加直观的模仿面向对象,为控件赋属性的方法.
定义函数如下:
(dcl-make 名称)
用于定义一个新的dcl控件
(dcl-put 控件 属性 值)
用于设置控件的属性
(dcl-get 控件 属性)
用于获取控件的属性
(dcl-add 控件 子控件)
用于把子控件添加到父控件上面

这几个函数源码在下面提供免费下载.
源码免币下载:

====================================
简单测试1

2. (defun c:tt1()
   
3.   (vl-load-com)
   
4. ;定义控件并设置属性
   
5.   (setq dialog (dcl-make "dialog"))
   
6.   (dcl-put 'dialog "name" "test")
   
7.   (dcl-put 'dialog "label" "测试1")
   
8.   
   
9.   (setq button1 (dcl-make "button"))
   
10.   (dcl-put 'button1 "key" "button1")
    
11.   (dcl-put 'button1 "label" "点我")
    
12.   (dcl-put 'button1 "width" "20")
    
13.   (dcl-put 'button1 "height" "1")
    
14. ;定义完成
    
15.   
    
16. ;从内向外添加
    
17.   (dcl-add 'dialog 'button1)
    
18.   
    
19. ;制作
    
20.   (setq dcl (dcl-convert dialog))
    
21.   (dcl-show dcl)
    
22. )

(defun c:tt1()<br />   (vl-load-com)<br /> ;定义控件并设置属性<br />   (setq dialog (dcl-make "dialog"))<br />   (dcl-put 'dialog "name" "test")<br />   (dcl-put 'dialog "label" "测试1")<br />   <br />   (setq button1 (dcl-make "button"))<br />   (dcl-put 'button1 "key" "button1")<br />   (dcl-put 'button1 "label" "点我")<br />   (dcl-put 'button1 "width" "20")<br />   (dcl-put 'button1 "height" "1")<br /> ;定义完成<br />   <br /> ;从内向外添加<br />   (dcl-add 'dialog 'button1)<br />   <br /> ;制作<br />   (setq dcl (dcl-convert dialog))<br />   (dcl-show dcl)<br /> )

执行结果:
简单测试2

2. (defun c:tt2()
   
3.   (vl-load-com)
   
4. ;定义控件并设置属性
   
5.   (setq dialog (dcl-make "dialog"))
   
6.   (dcl-put 'dialog "name" "test")
   
7.   (dcl-put 'dialog "label" "test")
   
8.   
   
9.   (setq boxed_column1 (dcl-make "boxed_column"))
   
10.   (dcl-put 'boxed_column1 "label" "ok")
    
11.   
    
12.   (setq edit_box1 (dcl-make "edit_box"))
    
13.   (dcl-put 'edit_box1 "key" "editbox1")
    
14.   (dcl-put 'edit_box1 "label" "输入1")
    
15.   (dcl-put 'edit_box1 "width" "20")
    
16.   (dcl-put 'edit_box1 "height" "1")
    
17.   
    
18.   (setq edit_box2 (dcl-make "edit_box"))
    
19.   (dcl-put 'edit_box2 "key" "editbox2")
    
20.   (dcl-put 'edit_box2 "label" "输入2")
    
21.   (dcl-put 'edit_box2 "width" "20")
    
22.   (dcl-put 'edit_box2 "height" "1")
    
23. ;定义完成
    
24.   
    
25. ;从内向外添加
    
26.   (dcl-add 'boxed_column1 'edit_box1)
    
27.   (dcl-add 'boxed_column1 'edit_box2)
    
28.   (dcl-add 'dialog 'boxed_column1)
    
29.   
    
30. ;制作
    
31.   (setq dcl (dcl-convert dialog))
    
32.   (dcl-show dcl)
    
33. )

(defun c:tt2()<br />   (vl-load-com)<br /> ;定义控件并设置属性<br />   (setq dialog (dcl-make "dialog"))<br />   (dcl-put 'dialog "name" "test")<br />   (dcl-put 'dialog "label" "test")<br />   <br />   (setq boxed_column1 (dcl-make "boxed_column"))<br />   (dcl-put 'boxed_column1 "label" "ok")<br />   <br />   (setq edit_box1 (dcl-make "edit_box"))<br />   (dcl-put 'edit_box1 "key" "editbox1")<br />   (dcl-put 'edit_box1 "label" "输入1")<br />   (dcl-put 'edit_box1 "width" "20")<br />   (dcl-put 'edit_box1 "height" "1")<br />   <br />   (setq edit_box2 (dcl-make "edit_box"))<br />   (dcl-put 'edit_box2 "key" "editbox2")<br />   (dcl-put 'edit_box2 "label" "输入2")<br />   (dcl-put 'edit_box2 "width" "20")<br />   (dcl-put 'edit_box2 "height" "1")<br /> ;定义完成<br />   <br /> ;从内向外添加<br />   (dcl-add 'boxed_column1 'edit_box1)<br />   (dcl-add 'boxed_column1 'edit_box2)<br />   (dcl-add 'dialog 'boxed_column1)<br />   <br /> ;制作<br />   (setq dcl (dcl-convert dialog))<br />   (dcl-show dcl)<br /> )

执行结果:
简单测试3

2. (defun c:tt3()
   
3.   (vl-load-com)
   
4. ;定义控件并设置属性
   
5.   (setq dialog (dcl-make "dialog"))
   
6.   (dcl-put 'dialog "name" "test")
   
7.   (dcl-put 'dialog "label" "test")
   
8.   
   
9.   (setq boxed_column1 (dcl-make "boxed_column"))
   
10.   (dcl-put 'boxed_column1 "label" "ok")
    
11.   (setq boxed_row1 (dcl-make "boxed_row"))
    
12.   (dcl-put 'boxed_row1 "label" "列表")
    
13.   
    
14.   (setq edit_box1 (dcl-make "edit_box"))
    
15.   (dcl-put 'edit_box1 "key" "editbox1")
    
16.   (dcl-put 'edit_box1 "label" "输入1")
    
17.   (dcl-put 'edit_box1 "width" "20")
    
18.   (dcl-put 'edit_box1 "height" "1")
    
19.   
    
20.   (setq edit_box2 (dcl-make "edit_box"))
    
21.   (dcl-put 'edit_box2 "key" "editbox2")
    
22.   (dcl-put 'edit_box2 "label" "输入2")
    
23.   (dcl-put 'edit_box2 "width" "20")
    
24.   (dcl-put 'edit_box2 "height" "1")
    
25.   
    
26.   (setq edit_box3 (dcl-make "list_box"))
    
27.   (dcl-put 'edit_box3 "key" "list_box1")
    
28.   (dcl-put 'edit_box3 "width" "20")
    
29.   (dcl-put 'edit_box3 "height" "20")
    
30. ;定义完成
    
31.   
    
32. ;从内向外添加
    
33.   (dcl-add 'boxed_column1 'edit_box1)
    
34.   (dcl-add 'boxed_column1 'edit_box2)
    
35.   (dcl-add 'boxed_row1 'edit_box3)
    
36.   (dcl-add 'dialog 'boxed_column1)
    
37.   (dcl-add 'dialog 'boxed_row1)
    
38.   
    
39. ;制作
    
40.   (setq dcl (dcl-convert dialog))
    
41.   (dcl-show dcl)
    
42. )

(defun c:tt3()<br />   (vl-load-com)<br /> ;定义控件并设置属性<br />   (setq dialog (dcl-make "dialog"))<br />   (dcl-put 'dialog "name" "test")<br />   (dcl-put 'dialog "label" "test")<br />   <br />   (setq boxed_column1 (dcl-make "boxed_column"))<br />   (dcl-put 'boxed_column1 "label" "ok")<br />   (setq boxed_row1 (dcl-make "boxed_row"))<br />   (dcl-put 'boxed_row1 "label" "列表")<br />   <br />   (setq edit_box1 (dcl-make "edit_box"))<br />   (dcl-put 'edit_box1 "key" "editbox1")<br />   (dcl-put 'edit_box1 "label" "输入1")<br />   (dcl-put 'edit_box1 "width" "20")<br />   (dcl-put 'edit_box1 "height" "1")<br />   <br />   (setq edit_box2 (dcl-make "edit_box"))<br />   (dcl-put 'edit_box2 "key" "editbox2")<br />   (dcl-put 'edit_box2 "label" "输入2")<br />   (dcl-put 'edit_box2 "width" "20")<br />   (dcl-put 'edit_box2 "height" "1")<br />   <br />   (setq edit_box3 (dcl-make "list_box"))<br />   (dcl-put 'edit_box3 "key" "list_box1")<br />   (dcl-put 'edit_box3 "width" "20")<br />   (dcl-put 'edit_box3 "height" "20")<br /> ;定义完成<br />   <br /> ;从内向外添加<br />   (dcl-add 'boxed_column1 'edit_box1)<br />   (dcl-add 'boxed_column1 'edit_box2)<br />   (dcl-add 'boxed_row1 'edit_box3)<br />   (dcl-add 'dialog 'boxed_column1)<br />   (dcl-add 'dialog 'boxed_row1)<br />   <br /> ;制作<br />   (setq dcl (dcl-convert dialog))<br />   (dcl-show dcl)<br /> )

执行结果
下面玩个小循环

2. (defun c:tt4()
   
3. ;定义控件并设置属性
   
4.   (setq dialog (dcl-make "dialog"))
   
5.   (dcl-put 'dialog "name" "test")
   
6.   (dcl-put 'dialog "label" "测试4")
   
7.   (setq i 1 num 10)
   
8.   (repeat num
   
9.     (set (read (strcat "boxed_column" (itoa i))) (dcl-make "boxed_column"))
   
10.     (dcl-put (read (strcat "boxed_column" (itoa i))) "label" ":)")
    
11.     (setq i (1+ i))
    
12.   )
    
13. 
    
14.   (setq i 1)
    
15.   (repeat num
    
16.     (set (read (strcat "button" (itoa i))) (dcl-make "button"))
    
17.     (dcl-put (read (strcat "button" (itoa i))) "key" (strcat "button" (itoa i)))
    
18.     (dcl-put (read (strcat "button" (itoa i))) "label" (strcat "点我" (itoa i)))
    
19.     (dcl-put (read (strcat "button" (itoa i))) "width" "20")
    
20.     (dcl-put (read (strcat "button" (itoa i))) "height" "1")
    
21.     (setq i (1+ i))
    
22.   )
    
23. ;定义完成
    
24.   
    
25. ;从内向外添加
    
26.   (setq i 1)
    
27.   (repeat (1- num)
    
28.     (dcl-add (read (strcat "boxed_column" (itoa i))) (read (strcat "button" (itoa i))))
    
29.     (dcl-add (read (strcat "boxed_column" (itoa (1+ i)))) (read (strcat "boxed_column" (itoa i))))
    
30.     (setq i (1+ i))
    
31.   )
    
32.   (dcl-add 'dialog (read (strcat "boxed_column" (itoa i))))
    
33.   
    
34. ;制作
    
35.   (setq dcl (dcl-convert dialog))
    
36.   (dcl-show dcl)
    
37. )

(defun c:tt4()<br /> ;定义控件并设置属性<br />   (setq dialog (dcl-make "dialog"))<br />   (dcl-put 'dialog "name" "test")<br />   (dcl-put 'dialog "label" "测试4")<br />   (setq i 1 num 10)<br />   (repeat num<br />     (set (read (strcat "boxed_column" (itoa i))) (dcl-make "boxed_column"))<br />     (dcl-put (read (strcat "boxed_column" (itoa i))) "label" ":)")<br />     (setq i (1+ i))<br />   )<br /> <br />   (setq i 1)<br />   (repeat num<br />     (set (read (strcat "button" (itoa i))) (dcl-make "button"))<br />     (dcl-put (read (strcat "button" (itoa i))) "key" (strcat "button" (itoa i)))<br />     (dcl-put (read (strcat "button" (itoa i))) "label" (strcat "点我" (itoa i)))<br />     (dcl-put (read (strcat "button" (itoa i))) "width" "20")<br />     (dcl-put (read (strcat "button" (itoa i))) "height" "1")<br />     (setq i (1+ i))<br />   )<br /> ;定义完成<br />   <br /> ;从内向外添加<br />   (setq i 1)<br />   (repeat (1- num)<br />     (dcl-add (read (strcat "boxed_column" (itoa i))) (read (strcat "button" (itoa i))))<br />     (dcl-add (read (strcat "boxed_column" (itoa (1+ i)))) (read (strcat "boxed_column" (itoa i))))<br />     (setq i (1+ i))<br />   )<br />   (dcl-add 'dialog (read (strcat "boxed_column" (itoa i))))<br />   <br /> ;制作<br />   (setq dcl (dcl-convert dialog))<br />   (dcl-show dcl)<br /> )

执行结果:

源代码写了56行,就直接发了.

我爱lisp

猫老师的作品，我是需要三顾才能明白，几年后再来

479274135

跟随猫老师的脚步，慢慢学习

生活丨好无奈

支持，很给力

qyming

猫老师又出精品了

不死猫

横向的控件制作  只需添加一个row即可

2. (defun c:tt22()
   
3. ;定义控件并设置属性
   
4.         (setq dialog (dcl-make "dialog"))
   
5.         (dcl-put 'dialog "name" "test")
   
6.         (dcl-put 'dialog "label" "test")
   
7.        
   
8.         (setq boxed_column1 (dcl-make "boxed_column"))
   
9.         (dcl-put 'boxed_column1 "label" "ok")
   
10.         (setq row1 (dcl-make "row"))
    
11.        
    
12.         (setq edit_box1 (dcl-make "edit_box"))
    
13.         (dcl-put 'edit_box1 "key" "editbox1")
    
14.         (dcl-put 'edit_box1 "label" "输入1")
    
15.         (dcl-put 'edit_box1 "width" "20")
    
16.         (dcl-put 'edit_box1 "height" "1")
    
17.        
    
18.         (setq edit_box2 (dcl-make "edit_box"))
    
19.         (dcl-put 'edit_box2 "key" "editbox2")
    
20.         (dcl-put 'edit_box2 "label" "输入2")
    
21.         (dcl-put 'edit_box2 "width" "20")
    
22.         (dcl-put 'edit_box2 "height" "1")
    
23. ;定义完成
    
24.        
    
25. ;从内向外添加
    
26.         (dcl-add 'row1 'edit_box1)
    
27.         (dcl-add 'row1 'edit_box2)
    
28.         (dcl-add 'boxed_column1 'row1)
    
29.         (dcl-add 'dialog 'boxed_column1)
    
30.        
    
31. ;制作
    
32.         (setq dcl (dcl-convert dialog))
    
33.         (dcl-show dcl)
    
34. )

(defun c:tt22()<br /> ;定义控件并设置属性<br />         (setq dialog (dcl-make "dialog"))<br />         (dcl-put 'dialog "name" "test")<br />         (dcl-put 'dialog "label" "test")<br />         <br />         (setq boxed_column1 (dcl-make "boxed_column"))<br />         (dcl-put 'boxed_column1 "label" "ok")<br />         (setq row1 (dcl-make "row"))<br />         <br />         (setq edit_box1 (dcl-make "edit_box"))<br />         (dcl-put 'edit_box1 "key" "editbox1")<br />         (dcl-put 'edit_box1 "label" "输入1")<br />         (dcl-put 'edit_box1 "width" "20")<br />         (dcl-put 'edit_box1 "height" "1")<br />         <br />         (setq edit_box2 (dcl-make "edit_box"))<br />         (dcl-put 'edit_box2 "key" "editbox2")<br />         (dcl-put 'edit_box2 "label" "输入2")<br />         (dcl-put 'edit_box2 "width" "20")<br />         (dcl-put 'edit_box2 "height" "1")<br /> ;定义完成<br />         <br /> ;从内向外添加<br />         (dcl-add 'row1 'edit_box1)<br />         (dcl-add 'row1 'edit_box2)<br />         (dcl-add 'boxed_column1 'row1)<br />         (dcl-add 'dialog 'boxed_column1)<br />         <br /> ;制作<br />         (setq dcl (dcl-convert dialog))<br />         (dcl-show dcl)<br /> )

不死猫

liuhaixin88

不错，很好的示例

langjs

猫兄又鼓捣出新东西了

flowerson

哇！又有好东西了！支持。

yyzhan12

不错的思路

AbnerXk

支持一个！

xiaxiang

好东西都要玩隐藏。