源码DCL通用函数再次修改版！
本帖最后由 AbnerXk 于 2014-7-21 13:22 编辑初版界面：
此函数原作者为：llsheng_73 在此感谢。
新版界面：
(defun c:tt()
(setq lst '((" " ("xxx1 个人工具" "xxx2 个人工具" "xxx3 个人工具" "xxx4 个人工具" "xxx5 个人工具" "xxx6 个人工具"))))
(Dcl-ButtonM "xx工具" lst nil "帮助字符串")
)
;; titl:标题; buttons:按钮列表; flag:nil先行后列T先列后行 helpstr: nil "帮助字符串"
(defun Dcl-ButtonM (titl buttons flag helpstr / a b bq1 bq2 bqb c DivlstTh lsxth wh cmds csz ctl d dcl dclfile dclhandle divlst divth fileid i is_cancel kbnil key lst1 lsx n sk-cmdunknown sk-rctcmds str str_lst tem tems true tx v vr x y zbcd zhcfb)
(or (and helpstr (/= helpstr "")) (setq helpstr "!!!死心吧,没写呢!!!"))
(defun strsplist (str / i)
(if(setq i (vl-string-search " " str))
(list (substr str 1 i)
(vl-string-trim " " (substr str (+ 2 i)))
)
)
)
(defun makedcl (str_lst / fileID dclHandle);临时生成对话框文件，用完需删除
(setq dclfile (vl-filename-mktemp nil nil ".dcl")
fileID(open dclfile "w")
)
(cond ((= (type str_lst) 'str) (write-line str_lst fileID))
((= (type str_lst) 'list)
(foreach n str_lst (write-line n fileID))
)
)
(close fileID)
(setq dclHandle (load_dialog dclfile))
)
(setq vr 0)
(setqb (if flag
":column{ label = \""
":row{children_alignment = top ;\n
children_fixed_height = true ;\n label = \""
)
c (if flag
":row{children_alignment = top ;\n
children_fixed_height = true ;\nlabel = \""
":column{label = \""
)
d '("ESC")
a (strcat (vl-string-translate
"$~"
"AB"
(vl-filename-base (vl-filename-mktemp))
)
":dialog{label=\""
titl
"\";\n"
b
"\";\n"
)
)
(setq kbnil '())
(foreach x buttons
(setq lsx (last x))
(setq a (strcat a c (car x) "\";\n"))
(setq tem 0)
(setq csz 500)
(setq lsxth (length lsx))
(if (or (> lsxth 70) (= lsxth 70))
(setq wh 6)
(setq wh 5)
)
(setq divlst (Div-List lsx wh))
(setq zbcd (length (nth (- (length divlst) 1) divlst)))
(setq DivlstTh (length divlst))
(if (and (< zbcd wh) (/= zbcd wh))
(progn
(setq bq1 (- wh zbcd))
(repeat bq1
(setq tems (rtos tem))
(setq bqb (append (nth (- DivlstTh 1) divlst) (list (strcat "~" tems " "))))
(setq divlst (append (vl-remove (nth (- DivlstTh 1) divlst) divlst) (list bqb)))
(setq divth DivlstTh)
(setq tem (1+ tem))
)
)
)
(if (or (and (< divth 10) (/= divth 10) (/= divth nil)) (<= DivlstTh 10))
(progn
(setq bq2 (- 10 DivlstTh))
(repeat bq2
(repeat wh (setq kbnil (append kbnil (list (strcat "~" (rtos csz) " ")))) (setq csz (1+ csz)))
)
)
)
(setq zhcfb (Div-List kbnil wh))
(setq divlst (append divlst zhcfb))
(foreach v divlst
(setq a (strcat a ":row{\n"))
(foreach y v
(setqb (strsplist y)
a (if b
(strcat a
":button {key =\""
(car b)
"\";label=\""
(last b)
"\";"
(if (= (substr (car b) 1 1) "~")
"is_enabled = false ;" "\n")
"width = 15 ;"
"height = 2.5 ;"
"}\n"
)
(strcat a "spacer_0;\n")
)
d (if (/= (car b) nil)
(cons (car b) d)
d
)
)
)
":button {key =\"" (car b) "\";label=\""
(setq a (strcat a "}\n"))
)
(setq a (strcat a "}\n"))
);End foreach
(setqd(cdr (REVERSE d))
a(strcat a
(if flag
"} spacer_1;:row"
"} spacer_1;:row"
)
"{alignment = centered ;fixed_width = true ;
:button{fixed_width = true ;width = 4 ;height = 2 ;key = \"help\";label = \" 帮助 \";}\n"
":button{fixed_width = true ;width = 4 ;height = 2 ;key=\"cancel\";label=\" 取消 \";
is_cancel = true;is_default = true;}}}"
)
dcl(makedcl a)
lst1 '()
i1
)
(foreach key d
(setq tx (strcat "(action_tile \""
key
"\"\"(done_dialog "
(itoa i)
")\")"
)
lst1 (cons tx lst1)
i(1+ i)
)
)
(new_dialog (substr a 1 8) dcl)
(action_tile "cancel" "(done_dialog 0)")
(action_tile "help" "(alert helpstr)")
(eval (read (strcat "(progn" (apply 'strcat lst1) ")")))
(setq ctl (start_dialog))
(unload_dialog dcl)
(vl-file-delete dclfile)
(if (/= ctl 0)
(progn
(setq cmds(nth (- ctl 1) d))
;;检查命令是否~开头,有就去掉,如果运行中没有更改该命令button的enable值,这句可以不要
(if (= (substr cmds 1 1) "~") (setq cmds (substr cmds 2 (1- (strlen cmds)))))
;;
;;设置未知命令反应器
;(if (= sk-rctCmds nil)
;(setq sk-rctCmds (vlr-command-reactor nil '((:vlr-unknownCommand . sk-cmdunknown))))
;(vlr-add sk-rctCmds)
;)
;新的命令判断方式,代码更短
(cond
((boundp (read (strcat "c:" cmds)))
(princ "\n")
(eval (read (strcat "(c:" cmds ")")))
)
((boundp (read cmds))
(princ "\n")
(eval (read (strcat "(" cmds ")")))
)
(t (princ "\n")(vl-load-com)(vl-cmdf cmds))
)
)
)
)
;;;拆分表
(defun Div-List (lst num / ptn1 ptn2)
(while (> (length lst) num)
(repeat num
(setq ptn1 (cons (car lst) ptn1)
lst (cdr lst)
)
)
(setq ptn2 (cons (reverse ptn1) ptn2)
ptn1 '()
)
)
(if (>= (length lst) 1)
(setq ptn2 (cons lst ptn2))
)
(reverse ptn2)
)
此次修改只考虑了一个"column"，因为我只会用到一个，如果有其他需求，请自行理清其中逻辑关系再修改；
自定义按钮将按行排列，数量在70个以下一行按钮数量为5个，超出则一行按钮为6个，如果按钮够多，可再增加判断；
集思广益，如有更好的想法，可一起讨论并继续完善。
取之于明，还之于明，函数下载：
不错感谢分享 谢谢楼主分享，学习中 面板不错，值得借鉴 谢谢LZ 共享一直用老迈的！！！！ 谢谢分享。 这是那个ODCL面板，还是DCL面板？好像ODCl面板！
tianyi1230 发表于 2014-7-22 11:36 static/image/common/back.gif
这是那个ODCL面板，还是DCL面板？好像ODCl面板！
这是DCL面板。 好东西，谢谢分享。 谢谢分享，看一下
一直用老迈的对话框，这个也挺好 谢谢楼主的无私奉献
(setq lst '((" " ("xxx1 个人工具" "xxx2 个人工具" "xxx3 个人工具" "xxx4 个人工具" "xxx5 个人工具" "xxx6 个人工具"))))
请教下，xxx1是要替换成对应LSP的快捷命令吗？