最近写的一个dcl驱动函数库，求批评

山人就是画坑的 · 发表于 2015-10-31 10:33:41

不多说直接上代码，希望各位给予指点。。

;dcl初始化
;dlgname ：用于指定对话框的字符串
;dcl_str：dcl字符串
(defun vic-dcl-Init (dlgname dcl_str / #dcl_f #dcl_file #dcl_id)
(setq #dcl_file (vl-filename-mktemp "DclTemp.dcl"))
(setq #dcl_f (open #dcl_file "w"))
(write-line (strcat dlgname ":dialog{\n" dcl_str "\n}") #dcl_f)
(close #dcl_f)
;================结束file，载入file
(setq #dcl_id (load_dialog #dcl_file))
)
;循环显示对话框启动函数
;dlgname ：用于指定对话框的字符串。
;dcl_id ：由 load_dialog 获得的 DCL 文件标识符。
;actionlst ：设定控件动作函数列表
;applist ：控件回调函数列表
(defun vic-dcl-startloop (dcl_id dlgname actionlst applist / what_next)
(setq what_next 2)
(while (>= what_next 2) ;Begin display loop.
(if (null (new_dialog dlgname dcl_id)) ;Initialize dialog
(exit) ;box, exit if nil
); endif ;returned.
(mapcar 'eval actionlst)
(setq what_next (start_dialog)) ;Display dialog box.
(eval (cdr (assoc what_next applist)))
)
)
;只显示一次对话框启动函数
;dlgname ：用于指定对话框的字符串。
;dcl_id ：由 load_dialog 获得的 DCL 文件标识符。
;actionlst ：设定控件动作函数列表
;applist ：控件回调函数列表
(defun vic-dcl-startonce (dcl_id dlgname actionlst applist / what_next)
(if (null (new_dialog dlgname dcl_id)) ;Initialize dialog
(exit) ;box, exit if nil
); endif ;returned.
(mapcar 'eval actionlst)
(setq what_next (start_dialog)) ;Display dialog box.
(eval (cdr (assoc what_next applist)))
)
;dcl结束
(defun vic-dcl-End (dcl_id)
(unload_dialog dcl_id)
(princ)
)
;设置dcl参数
;lst :key value 键值对表
(defun vic-dcl-setvalues (lst)
(mapcar 'set_tile (mapcar 'vl-princ-to-string (mapcar 'car lst)) (mapcar 'vl-princ-to-string (mapcar 'cdr lst)))
)
;设置dcl对象显示模式
;lst :key mode 键值对表
;Value Description
;0--- 可用
;1--- 不可用
;2--- 设置焦点
;3--- 选择编辑框内容
;4--- 高亮image_button开关
(defun vic-dcl-setmodes (lst)
(mapcar 'mode_tile (mapcar 'vl-princ-to-string (mapcar 'car lst)) (mapcar 'cdr lst))
)
;获取dcl对象属性
;lst: key列表或字符串
(defun vic-dcl-getvalues (lst)
(cond
((listp lst)(mapcar 'get_tile lst))
((= (type lst) 'str) (get_tile lst))
(t nil)
)
)
;获取dcl对象属性
;lst: key/attr点对表
(defun vic-dcl-getattrs (lst)
(mapcar 'get_attr (mapcar 'vl-princ-to-string (mapcar 'car lst)) (mapcar 'vl-princ-to-string (mapcar 'cdr lst)))
)
;设置dcl对象动作
;key：对象键值
;func-args：调用函数参数表
;示例：
;("buttonkey" (func args) (func1 arg1 arg2))
(defun vic-dcl-setaction (key-func-args / strr)
(action_tile
(car key-func-args)
(substr
(setq strr
(vl-princ-to-string
(mapcar '(lambda (x)
(cons (car x)
(mapcar '(lambda (y) (vl-prin1-to-string y)) (cdr x))
)
)
(cdr key-func-args)
)
))
2 (- (strlen strr) 2)))
)
;定义布局函数
;layoutname:容器名称 - row column等
; layoutlst:容器属性点对表
; lst:控件列表
(defun vic-dcl-setLayout (layoutname layoutlst lst)
(strcat ":" layoutname "{\n"
(if (and (listp layoutlst) (>= (length layoutlst) 1))
(strcat
(vic-lst->str
(vic-dcl-listsplit layoutlst)
";\n"
)
";\n")
""
)
(vic-lst->str lst "\n")
"\n}")
)
;|定义一个控件
;itemname 控件名称
lst：定义控件属性的点对表
示例：
(vic-dcl-addItem "button"
'((key . "hah")
(label . "hello")
(width . 2)
(action . "(hh)")
))|;
(defun vic-dcl-addItem (itemname lst)
(if (and (listp lst) (>= (length lst) 1))
(strcat
":" itemname "{\n"
(vic-lst->str
(vic-dcl-listsplit lst)
";\n")
";\n}"
)
)
)
;工具函数
(defun vic-dcl-listsplit (lst)
(mapcar
'(lambda (x / first)
(vic-lst->str
(mapcar '(lambda (x) (strcase x t)) (mapcar 'vl-prin1-to-string (list (car x) (cdr x))))
" = ")
)
lst)
)
;;;=====================================
;;;函数：lst->str
;;;列表转成字符串
;;;参数：lst：要转换的列表
;;;del：分隔符
;;;=====================================
(defun vic-lst->str (lst del)
(if (cdr lst)
(strcat (car lst) del (vic-lst->str (cdr lst) del))
(car lst)
)
)
;添加列表数据
;key：列表框key
;lst：数据列表
;operation:
;整数，指定要执行的列表操作的类型。可以指定下列值之一：
;1 修改选定列表的内容
;2 附加新的列表项
;3 删除旧列表，创建新列表（缺省设置）
;index:
;整数，指定后续 add_list 调用要修改的列表项。列表中的第一项序号为 0。如果未指定该参数，则 index 的缺省值为 0。
;如果 start_list 不执行修改操作，则忽略 index 参数。
;operation index 如果不指定则为 nil
(defun vic-dcl-addlist (key lst operation index)
(cond
((and (null operation) (null index))
(start_list key)
)
((and (null index) operation)
(start_list key operation)
)
(t (start_list key operation index))
)
(mapcar 'add_list (mapcar 'vl-princ-to-string lst))
(end_list)
)
;刷新数据 by fsxm
;(defun dcl:list-set (key lst / change sym sym_fun update)
; (or (listp lst) (setq lst nil))
; (setq sym_fun (read (strcat key ":list_box_fun")))
; (or (eval sym_fun) (set sym_fun 'vl-princ-to-string))
; (setq sym (read (strcat key ":list_box_data")))
; (set sym lst)
; (start_list key)
; (mapcar 'add_list (mapcar (eval sym_fun) lst))
; (end_list)
; lst
;)
;取表 by fsxm
;(defun dcl:list-get (key)
; (eval (read (strcat key ":list_box_data")))
;)
;取当前项 by fsxm
;(defun dcl:list-getv (key / index a data)
; (cond ((/= (setq index (get_tile key)) "")
; (setq data (dcl:list-get key))
; (mapcar (function (lambda (a) (nth a data)))
; (read (strcat "(" index ")"))
; )
; )
; )
;)
;设转换函数 by fsxm
;(defun dcl:list-setf (key sym_fun / sym)
; (setq sym (read (strcat key ":list_box_fun")))
; (set sym sym_fun)
;)
;;加载幻灯片 by fsxm
;key 图像或图像按钮key
;sld 幻灯片或颜色代码
(defun vic-dcl-loadsld (key sld / x y)
(setq x (dimx_tile key))
(setq y (dimy_tile key))
(start_image key)
(cond ((numberp sld) (fill_image 0 0 x y sld))
(t
(fill_image 0 0 x y -2)
(slide_image 0 0 x y sld)
)
)
(end_image)
)
;示例
(defun c:tt (/ dcl-id firstimage firstimagebutton firstlist firstpoplist hah1action hah2action hahaaction hahmode im1action im2action layout1 layout2 layout3 layout4 layout5 lst1action lst2action onebutton threebutton twobutton)
(setq onebutton (vic-dcl-addItem "button" '((key . "hah")(label . "one")(width . 2) (value . "nihao"))))
(setq twobutton (vic-dcl-addItem "button" '((key . "hah1")(label . "two")(width . 2) (value . "nihao1"))))
(setq threebutton (vic-dcl-addItem "button" '((key . "hah2")(label . "three")(width . 2) (value . "nihao2"))))
(setq firstlist (vic-dcl-addItem "list_box" '((key . "lst1"))))
(setq firstimage (vic-dcl-addItem "image" '((key . "im1") (width . 30)(aspect_ratio . 0.66))))
(setq firstimagebutton (vic-dcl-addItem "image_button" '((key . "im2") (width . 30)(aspect_ratio . 0.66) (allow_accept . true))))
(setq firstpoplist (vic-dcl-addItem "popup_list" '((key . "lst2") (edit_width . 4))))
(setq layout1 (vic-dcl-setLayout "boxed_column" '((label . "onebutton")) (list onebutton twobutton threebutton )))
(setq layout2 (vic-dcl-setLayout "column" "" (list firstlist firstimage firstimagebutton)))
(setq layout3 (vic-dcl-setLayout "row" "" (list layout1 layout2)))
(setq layout4 (vic-dcl-setLayout "row" "" (list firstpoplist "ok_cancel;")))
(setq layout5 (vic-dcl-setLayout "column" "" (list layout3 layout4)))
(setq dcl-id (vic-dcl-Init "nihao" layout5))
(setq hahaaction '(vic-dcl-setaction '("hah"
(print (vic-dcl-getvalues '("lst1" "lst2")))
(done_dialog 5))))
(setq hah1action '(vic-dcl-setaction '("hah1" (vic-dcl-addlist "lst1" '(5 6 7 8) 1 2))))
(setq hah2action '(vic-dcl-setaction '("hah2"
;(princ (vic-dcl-getattrs '(("hah2" . "label"))))
(done_dialog 7))))
(setq lst1action '(vic-dcl-addlist "lst1" '( 1 2 3 4) nil nil)
lst2action '(vic-dcl-addlist "lst2" '(1 2 3 4) nil nil)
im1action '(vic-dcl-loadsld "im1" 2)
im2action '(vic-dcl-loadsld "im2" 3)
hahmode '(vic-dcl-setmodes '( ("hah1" . 1)("im2" . 4))))
(vic-dcl-startonce dcl-id "nihao"
(list
hahaaction hah1action hah2action
lst1action lst2action
im1action im2action hahmode
)
'((5 getpoint)(7 print "nihao2"))
)
(vic-dcl-End dcl-id)
)

;dcl初始化 
;dlgname ：用于指定对话框的字符串 
;dcl_str：dcl字符串 
(defun vic-dcl-Init (dlgname dcl_str / #dcl_f #dcl_file #dcl_id) 
  (setq #dcl_file (vl-filename-mktemp "DclTemp.dcl")) 
  (setq #dcl_f (open #dcl_file "w")) 
  (write-line (strcat dlgname ":dialog{\n" dcl_str "\n}") #dcl_f) 
  (close #dcl_f) 
  ;================结束file，载入file 
  (setq #dcl_id (load_dialog #dcl_file)) 
) 
;循环显示对话框启动函数 
;dlgname ：用于指定对话框的字符串。 
;dcl_id ：由 load_dialog 获得的 DCL 文件标识符。 
;actionlst ：设定控件动作函数列表 
;applist ：控件回调函数列表 
(defun vic-dcl-startloop (dcl_id dlgname actionlst applist / what_next) 
  (setq what_next 2) 
  (while (>= what_next 2)                    ;Begin display loop. 
    (if (null (new_dialog dlgname dcl_id)) ;Initialize dialog 
      (exit) ;box, exit if nil 
    ); endif ;returned. 
    (mapcar 'eval actionlst) 
    (setq what_next (start_dialog))          ;Display dialog box. 
    (eval (cdr (assoc what_next applist))) 
  ) 
) 
;只显示一次对话框启动函数 
;dlgname ：用于指定对话框的字符串。 
;dcl_id ：由 load_dialog 获得的 DCL 文件标识符。 
;actionlst ：设定控件动作函数列表 
;applist ：控件回调函数列表 
(defun vic-dcl-startonce (dcl_id dlgname actionlst applist / what_next) 
  (if (null (new_dialog dlgname dcl_id)) ;Initialize dialog 
    (exit) ;box, exit if nil 
  ); endif ;returned. 
  (mapcar 'eval actionlst) 
  (setq what_next (start_dialog))          ;Display dialog box. 
  (eval (cdr (assoc what_next applist))) 
) 
;dcl结束 
(defun vic-dcl-End (dcl_id) 
  (unload_dialog dcl_id) 
  (princ) 
) 
;设置dcl参数 
;lst :key value 键值对表 
(defun vic-dcl-setvalues (lst) 
  (mapcar 'set_tile (mapcar 'vl-princ-to-string (mapcar 'car lst)) (mapcar 'vl-princ-to-string (mapcar 'cdr lst))) 
) 
;设置dcl对象显示模式 
;lst :key mode 键值对表 
;Value    Description 
;0---      可用 
;1---      不可用 
;2---      设置焦点 
;3---      选择编辑框内容 
;4---      高亮image_button开关 
(defun vic-dcl-setmodes (lst) 
  (mapcar 'mode_tile (mapcar 'vl-princ-to-string (mapcar 'car lst)) (mapcar 'cdr lst)) 
) 
;获取dcl对象属性 
;lst: key列表或字符串 
(defun vic-dcl-getvalues (lst) 
  (cond 
    ((listp lst)(mapcar 'get_tile lst)) 
    ((= (type lst) 'str) (get_tile lst)) 
    (t nil) 
  ) 
) 
;获取dcl对象属性 
;lst: key/attr点对表 
(defun vic-dcl-getattrs (lst) 
  (mapcar 'get_attr (mapcar 'vl-princ-to-string (mapcar 'car lst)) (mapcar 'vl-princ-to-string (mapcar 'cdr lst))) 
) 
;设置dcl对象动作 
;key： 对象键值 
;func-args：调用函数 参数表 
;示例： 
;("buttonkey" (func args) (func1 arg1 arg2)) 
(defun vic-dcl-setaction (key-func-args / strr) 
  (action_tile 
    (car key-func-args) 
    (substr 
      (setq strr 
        (vl-princ-to-string 
          (mapcar '(lambda (x) 
                     (cons (car x) 
                       (mapcar '(lambda (y) (vl-prin1-to-string y)) (cdr x)) 
                     ) 
                   ) 
            (cdr key-func-args) 
          ) 
        )) 
      2 (- (strlen strr) 2))) 
) 
;定义布局函数 
;layoutname:容器名称 - row column等 
; layoutlst:容器属性点对表 
; lst:控件列表 
(defun vic-dcl-setLayout (layoutname layoutlst lst) 
  (strcat ":" layoutname  "{\n" 
    (if (and (listp layoutlst) (>= (length layoutlst) 1)) 
      (strcat 
        (vic-lst->str 
          (vic-dcl-listsplit layoutlst) 
          ";\n" 
        ) 
        ";\n") 
      "" 
    ) 
    (vic-lst->str lst "\n") 
    "\n}") 
) 
;|定义一个控件 
;itemname 控件名称 
lst：定义控件属性的点对表 
示例： 
(vic-dcl-addItem "button" 
'((key . "hah") 
(label . "hello") 
(width . 2) 
(action . "(hh)") 
))|; 
(defun vic-dcl-addItem (itemname lst) 
  (if (and (listp lst) (>= (length lst) 1)) 
    (strcat 
      ":" itemname "{\n" 
      (vic-lst->str 
        (vic-dcl-listsplit lst) 
        ";\n") 
      ";\n}" 
    ) 
  ) 
) 
;<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>函数 
(defun vic-dcl-listsplit (lst) 
  (mapcar 
    '(lambda (x / first) 
       (vic-lst->str 
         (mapcar '(lambda (x) (strcase x t)) (mapcar 'vl-prin1-to-string (list (car x) (cdr x)))) 
         " = ") 
     ) 
    lst) 
) 
;;;===================================== 
;;;函数：lst->str 
;;;列表转成字符串 
;;;参数：lst：要转换的列表 
;;;del：分隔符 
;;;===================================== 
(defun vic-lst->str  (lst del) 
  (if  (cdr lst) 
    (strcat (car lst) del (vic-lst->str (cdr lst) del)) 
    (car lst) 
  ) 
) 
;添加列表数据 
;key：列表框key 
;lst：数据列表 
;operation: 
;整数，指定要执行的列表操作的类型。可以指定下列值之一： 
;1 修改选定列表的内容 
;2 附加新的列表项 
;3 删除旧列表，创建新列表（缺省设置） 
;index: 
;整数，指定后续 add_list 调用要修改的列表项。列表中的第一项序号为 0。如果未指定该参数，则 index 的缺省值为 0。 
;如果 start_list 不执行修改操作，则忽略 index 参数。 
;operation index 如果不指定则为 nil 
(defun vic-dcl-addlist (key lst operation index) 
  (cond 
    ((and (null operation) (null index)) 
      (start_list key) 
    ) 
    ((and (null index) operation) 
      (start_list key operation) 
    ) 
    (t (start_list key operation index)) 
  ) 
  (mapcar 'add_list (mapcar 'vl-princ-to-string lst)) 
  (end_list) 
) 
;刷新数据 by fsxm 
;(defun dcl:list-set (key lst / change sym sym_fun update) 
;  (or (listp lst) (setq lst nil)) 
;  (setq sym_fun (read (strcat key ":list_box_fun"))) 
;  (or (eval sym_fun) (set sym_fun 'vl-princ-to-string)) 
;  (setq sym (read (strcat key ":list_box_data"))) 
;  (set sym lst) 
;  (start_list key) 
;  (mapcar 'add_list (mapcar (eval sym_fun) lst)) 
;  (end_list) 
;  lst 
;) 
;取表 by fsxm 
;(defun dcl:list-get (key) 
;  (eval (read (strcat key ":list_box_data"))) 
;) 
;取当前项 by fsxm 
;(defun dcl:list-getv (key / index a data) 
;  (cond  ((/= (setq index (get_tile key)) "") 
;          (setq data (dcl:list-get key)) 
;          (mapcar (function (lambda (a) (nth a data))) 
;            (read (strcat "(" index ")")) 
;          ) 
;        ) 
;  ) 
;) 
;设转换函数 by fsxm 
;(defun dcl:list-setf (key sym_fun / sym) 
;  (setq sym (read (strcat key ":list_box_fun"))) 
;  (set sym sym_fun) 
;) 
 
;;加载幻灯片 by fsxm 
;key 图像或图像按钮key 
;sld 幻灯片或颜色代码 
(defun vic-dcl-loadsld (key sld / x y) 
  (setq x (dimx_tile key)) 
  (setq y (dimy_tile key)) 
  (start_image key) 
  (cond  ((numberp sld) (fill_image 0 0 x y sld)) 
    (t 
      (fill_image 0 0 x y -2) 
      (slide_image 0 0 x y sld) 
    ) 
  ) 
  (end_image) 
) 
 
;示例 
(defun c:tt (/ dcl-id firstimage firstimagebutton firstlist firstpoplist hah1action hah2action hahaaction hahmode im1action im2action layout1 layout2 layout3 layout4 layout5 lst1action lst2action onebutton threebutton twobutton) 
  (setq onebutton (vic-dcl-addItem "button" '((key . "hah")(label . "one")(width . 2) (value . "nihao")))) 
  (setq twobutton (vic-dcl-addItem "button" '((key . "hah1")(label . "two")(width . 2) (value . "nihao1")))) 
  (setq threebutton (vic-dcl-addItem "button" '((key . "hah2")(label . "three")(width . 2) (value . "nihao2")))) 
  (setq firstlist (vic-dcl-addItem "list_box" '((key . "lst1")))) 
  (setq firstimage (vic-dcl-addItem "image" '((key . "im1") (width . 30)(aspect_ratio . 0.66)))) 
  (setq firstimagebutton (vic-dcl-addItem "image_button" '((key . "im2") (width . 30)(aspect_ratio . 0.66) (allow_accept . true)))) 
  (setq firstpoplist (vic-dcl-addItem "popup_list" '((key . "lst2") (edit_width . 4)))) 
  (setq layout1 (vic-dcl-setLayout "boxed_column" '((label . "onebutton")) (list onebutton twobutton threebutton ))) 
  (setq layout2 (vic-dcl-setLayout "column" "" (list firstlist firstimage firstimagebutton))) 
  (setq layout3 (vic-dcl-setLayout "row" "" (list layout1 layout2))) 
  (setq layout4 (vic-dcl-setLayout "row" "" (list firstpoplist "ok_cancel;"))) 
  (setq layout5 (vic-dcl-setLayout "column" "" (list layout3 layout4))) 
  (setq dcl-id (vic-dcl-Init "nihao" layout5)) 
  (setq hahaaction '(vic-dcl-setaction '("hah" 
                                          (print (vic-dcl-getvalues '("lst1" "lst2"))) 
                                          (done_dialog 5)))) 
  (setq hah1action '(vic-dcl-setaction '("hah1" (vic-dcl-addlist "lst1" '(5 6 7 8) 1 2)))) 
  (setq hah2action '(vic-dcl-setaction '("hah2" 
                                          ;(princ (vic-dcl-getattrs '(("hah2" . "label")))) 
                                          (done_dialog 7)))) 
  (setq lst1action  '(vic-dcl-addlist "lst1" '( 1 2 3 4) nil nil) 
    lst2action '(vic-dcl-addlist "lst2" '(1 2 3 4) nil nil) 
    im1action '(vic-dcl-loadsld "im1" 2) 
    im2action '(vic-dcl-loadsld "im2" 3) 
    hahmode '(vic-dcl-setmodes '( ("hah1" . 1)("im2" . 4)))) 
  (vic-dcl-startonce dcl-id "nihao" 
    (list 
      hahaaction hah1action hah2action 
      lst1action lst2action 
      im1action im2action hahmode 
    ) 
    '((5 getpoint)(7 print "nihao2")) 
  ) 
  (vic-dcl-End dcl-id) 
)

伪书虫86 · 发表于 2015-10-31 13:38:11

MARK

mmmmmm · 发表于 2015-10-31 16:29:32

建议将action定义直接加载AddItem里面一起定义，现在这样上下交错的，debug起来会不太方便，而且代码更长。
另外每个控件都给定义个变量，且这些变量仅组织DCL结构时才使用，似乎可以再优化一下。

山人就是画坑的 · 发表于 2015-11-1 10:49:06

mmmmmm 发表于 2015-10-31 16:29
建议将action定义直接加载AddItem里面一起定义，现在这样上下交错的，debug起来会不太方便，而且代码更长。 ...

控件的action属性是可以在定义的时候直接定义的，不过这个action属性有限制，也很少有人直接使用的，而action_tile函数却需要在new_dialog和start_dialog之间使用，所以还是得分开。。
每个控件都定义一个变量确实是有点多，但是没有想到太好的办法既能保证条理清晰又能保证代码少。。。

429014673 · 发表于 2015-11-1 11:32:23

来个GIF

mmmmmm · 发表于 2015-11-1 13:10:39

本帖最后由 mmmmmm 于 2015-11-1 22:42 编辑

山人就是画坑的发表于 2015-11-1 10:49
控件的action属性是可以在定义的时候直接定义的，不过这个action属性有限制，也很少有人直接使用的，而ac ...

我说的意思不是action属性，而是Action_tile对应的函数，对单一控件，肯定一般的过程是先set_tile赋值，然后直接定义其action_tile函数。没必要在对所有控件赋值后再定义各自的动作。这样从程序运行上没有问题，但是在代码的维护上不如集中设定好。

控件定义的问题上，可能你可以考虑使用类似矩阵的方式，先分解成控件组，再组合之。
一个比较粗糙的概念是构建一个标准3*3的矩形格式（允许被定义成Radio_boxed_column、boxed_column、column之类的格式），
| X0 Y0 Z0 |
| X1 Y1 Z1 |
| X2 Y2 Z2 |
预定义其中的9个变量，然后根据控件实际位置定义相应的变量，没有的就设置成NIL，然后由程序按照矩阵结构将9个变量组合成一个控件组。跟CAD图块定义类似，重复使用变量来构建更多的控件组。最后再参照同样方式组合控件组。可能这样变量依然不能减少太多，但是会相对来说条理可能会更好些。

另外，因为要在程序中写DCL，在定义控件时大量输入label，key啊之类的是件比较无趣体力活，建议使用自定义的缩写，减少输入工作量，也剪短代码。
我把这些思路大概写了两段函数供你参考（没有测试）：
(Defun _DefObj (tile data / ABC KEY KEYS RTN)
  (setq keys '(("::A" . "aligment")
         ("::AA" . "allow_accept")
         ("::AR" . "aspect_ratio")
         ("::BI" . "big_increment")
         ("::C" . "color")
         ("::CA" . "children_alignment")
         ("::CFH" . "children_fixed_height")
         ("::CFW" . "children_fixed_width")
         ("::EL" . "edit_limit")
         ("::EW" . "edit_width")
         ("::IF" . "initial_focus")
         ("::IB" . "is_bold")
         ("::MXV" . "max_value")
         ("::MNV" . "min_value")
         ("::MS" . "multiple_select")
         ("::SI" . "small_increment")
         ("::T" . "tabs")
         ("::V" . "value")
         ("::L" . "label")
         ("::LO" . "layout")
         ("::K" . "key")
         ("::M" . "mnemonic")
         ("::FW" . "fixed_width")
         ("::FH" . "fixed_height")
         ("::W" . "width")
         ("::H" . "height")
         ("::IE" . "is_enabled")
         ("::ITS" . "is_tab_stop")
         ("::ID" . "is_default")
         ("::IC" . "is_cancel")
      )
rtn  (strcat ": " tile "{")
  )
  (foreach val data
(setq key (car val)
   val (cdr val)
)
(if (setq abc (cdr (assoc key keys)))
   (setq key abc)
)
(if (or (/= (type val) 'str)
      (member (strcase key) '("LABEL" "VALUE" "KEY"))
)
   (setq val (vl-prin1-to-string val))
)
(setq rtn (strcat rtn key "=" val ";"))
  )
  (setq rtn (strcat rtn "}"))
)
(Defun _DefMatrix (mode / VAR RTN)
;;; Global vars  *dcl00 *dcl01 *dcl02 / *dcl10 *dcl11 *dcl12 / *dcl20 *dcl21 *dcl22
  (setq rtn (strcat ":" mode "{"))
  (cond ((wcmatch mode "radio_*")
   (foreach var (list *dcl00 *dcl01 *dcl02    *dcl10
      *dcl11 *dcl12 *dcl20    *dcl21
      *dcl22
   )
   (if var
      (setq rtn (strcat rtn var))
   )
   )
)
((wcmatch mode "*column")
   (setq rtn (strcat rtn ": row {"))
   (foreach var (list *dcl00 *dcl01 *dcl02)
   (if var
      (setq rtn (strcat rtn var))
   )
   )
   (setq rtn (strcat rtn "}"))
   (setq rtn (strcat rtn ": row {"))
   (foreach var (list *dcl10 *dcl11 *dcl12)
   (if var
      (setq rtn (strcat rtn var))
   )
   )
   (setq rtn (strcat rtn "}"))
   (setq rtn (strcat rtn ": row {"))
   (foreach var (list *dcl20 *dcl21 *dcl22)
   (if var
      (setq rtn (strcat rtn var))
   )
   )
   (setq rtn (strcat rtn "}"))
)
((wcmatch mode "*row")
   (setq rtn (strcat rtn ": column {"))
   (foreach var (list *dcl00 *dcl10 *dcl20)
   (if var
      (setq rtn (strcat rtn var))
   )
   )
   (setq rtn (strcat rtn "}"))
   (setq rtn (strcat rtn ": column {"))
   (foreach var (list *dcl01 *dcl11 *dcl21)
   (if var
      (setq rtn (strcat rtn var))
   )
   )
   (setq rtn (strcat rtn "}"))
   (setq rtn (strcat rtn ": column {"))
   (foreach var (list *dcl02 *dcl12 *dcl22)
   (if var
      (setq rtn (strcat rtn var))
   )
   )
   (setq rtn (strcat rtn "}"))
)
  )
  (setq rtn (strcat rtn "}"))
)

你现在的方式过于复杂，可能自己用可以，推广的话，太复杂不容易被理解和接受。

hbgsw · 发表于 2015-11-1 16:27:39

mark，养肥了在来看。

shenhung · 发表于 2015-11-2 00:33:02

弱弱的問下..這樣寫DCL. 不知道有什麼特別好處.~

xiaolong1487 · 发表于 2015-11-2 02:50:59

好东西啊！谢谢分享！

xiaolong1487 · 发表于 2015-11-2 02:57:01

结尾没有删除临时DCL文件！

账号		自动登录	找回密码
密码			注册

[函数] 最近写的一个dcl驱动函数库，求批评

点评

评分