多层面板修改
本帖最后由 love1030312 于 2014-12-17 11:49 编辑论坛大神们的程序 在此感谢此程序原作者
我想修改下帮助文件 不要通用了 改成单个的
论坛所有面板程序字体颜色都是黑色
能否换成其他颜色这样比较新颖哈哈 不知道能否实现这功能;;示例qq
(defun c:qq ( / titl titl0 msg lst switch
main more-1 more-2
more-3 more-4 more-5 )
;通用定义
(setq titl0 "xx工具箱 v20141203")
(setq msg
(strcat
"\nmade by lostbalance"
)
)
(setq switch "main 主页面(&Z)")
;;================================
(defun main()
(setq *panel-num* 0)
(setq lst
'(
(
("命令组1"
(
"FUNC1 命令1"
"FUNC2 命令2"
"FUNC3 命令3"
"more-1 =汇总= (&W)"
)
)
("命令组2"
(
"FUNC4 命令4"
"FUNC5 命令5"
"FUNC6 命令6"
"more-2 =汇总= (&E)"
)
)
("命令组3"
(
"FUNC7 命令7"
"FUNC8 命令8"
"FUNC9 命令9"
"more-3 =汇总= (&R)"
)
)
)
(
("命令组4"
(
"FUNC10 命令10"
"FUNC11 命令11"
"FUNC12 命令12"
"more-4 =汇总= (&S)"
)
)
("命令组5"
(
"FUNC13 命令13"
"FUNC14 命令14"
"FUNC15 命令15"
"more-5 =汇总= (&D)"
)
)
)
)
)
(WYB-panel titl0 msg lst switch nil nil)
)
(defun more-1 (/ titl lst)
(setq *panel-num* 1)
(setq titl "命令组1")
(setq lst
'(
(
(""
(
"FUNC1 命令1 (&S)"
"FUNC2 命令2 (&D)"
"FUNC3 命令3 (&F)"
)
)
(""
(
"FUNCA1 命令A1 (&W)"
"FUNCA2 命令A2 (&E)"
)
)
)
)
)
(WYB-panel titl msg lst switch 20 nil)
)
(defun more-2 (/ titl lst)
(setq *panel-num* 2)
(setq titl "命令组2")
(setq lst
'(
(
(""
(
"FUNC4 命令4 (&S)"
"FUNC5 命令5 (&D)"
"FUNC6 命令6 (&F)"
)
)
(""
(
"FUNCB1 命令B1 (&W)"
"FUNCB2 命令B2 (&E)"
"FUNCB3 命令B3 (&R)"
)
)
)
)
)
(WYB-panel titl msg lst switch 20 nil)
)
(defun more-3 (/ titl lst)
(setq *panel-num* 3)
(setq titl "命令组3")
(setq lst
'(
(
(""
(
"FUNC7 命令7 (&S)"
"FUNC8 命令8 (&D)"
"FUNC9 命令9 (&F)"
)
)
(""
(
"~FUNCC1 命令C1 (&W)"
"~FUNCC2 命令C2 (&E)"
"~FUNCC3 命令C3 (&R)"
)
)
)
)
)
(WYB-panel titl msg lst switch 20 nil)
)
(defun more-4 (/ titl lst)
(setq *panel-num* 4)
(setq titl "命令组4")
(setq lst
'(
(
(""
(
"FUNC10 命令10 (&S)"
"FUNC11 命令11 (&D)"
"FUNC12 命令12 (&F)"
)
)
(""
(
"~FUNCD1 命令D1 (&W)"
"~FUNCD2 命令D2 (&E)"
"~FUNCD3 命令D3 (&R)"
)
)
)
)
)
(WYB-panel titl msg lst switch 20 nil)
)
(defun more-5 (/ titl lst)
(setq *panel-num* 5)
(setq titl "命令组5")
(setq lst
'(
(
(""
(
"FUNC13 命令13 (&S)"
"FUNC14 命令14 (&D)"
"FUNC15 命令15 (&F)"
)
)
(""
(
"FUNCE1 命令E1 (&W)"
"FUNCE2 命令E2 (&E)"
"FUNCE3 命令E3 (&R)"
)
)
)
)
)
(WYB-panel titl msg lst switch 20 nil)
)
(cond
((= *panel-num* 1)(more-1))
((= *panel-num* 2)(more-2))
((= *panel-num* 3)(more-3))
((= *panel-num* 4)(more-4))
((= *panel-num* 5)(more-5))
((main))
)
(princ)
)
;;==========================================
;;5.3 多层面板
;;(WYB-panel titl msg lst switch bwidth flag)
;;titl: 标题
;;msg: 帮助提示
;;buttons:按钮列表(命令前加"~"，按钮变灰|名称后面加"(&字母)"，设置面板按钮的快捷键)
;;switch: 下按钮(str，"快捷键 命令名")，nil取消
;;Bwidth: 按钮的宽度，nil为自动调整
;;flag: nil 先行后列|T 先列后行
;;==========================================
;;v1.0 by llsheng-73 edata
;;v1.1 by lostbalance 20141203
;;==========================================
(defun WYB-panel ( titl msg buttons switch Bwidth flag
/ strsplist makedcl dclfile lst-s lst-t cmdlst
dcl-str Bwidth-str cmd-n dcl act act-lst i ctl cmd
)
(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 (lst / fileid dclhandle)
(setq dclfile (vl-filename-mktemp nil nil ".dcl")
fileid(open dclfile "w")
)
(cond
((= (type lst) 'str) (write-line lst fileid))
((= (type lst) 'list) (foreach n lst (write-line n fileid)))
)
(close fileid)
(setq dclhandle (load_dialog dclfile))
)
(if Bwidth (setq Bwidth-str (strcat "fixed_width = true; width = " (rtos Bwidth) "; "))(setq Bwidth-str ""))
(if flag
(setq
lst-s "\n:column{ label = \""
lst-t "\n:row{ children_alignment = top; children_fixed_height = true; label = \""
)
(setq
lst-s "\n:row{ children_alignment = top; children_fixed_height = true; label = \""
lst-t "\n:column{label = \""
)
)
(setq
cmdlst '("esc")
dcl-str (strcat (vl-string-translate "$~" "ab" (vl-filename-base (vl-filename-mktemp)))
":dialog{label=\"" titl "\";"
)
)
(foreach xxx buttons
(if (listp xxx);列集合
(progn
(setq dcl-str (strcat dcl-str "\nspacer_1;" lst-s "\";"))
(foreach xx xxx
(if (listp xx);命令列
(progn
(setq dcl-str (strcat dcl-str lst-t (car xx) "\";"))
(foreach x (last xx)
(setq
cmd-n (strsplist x)
dcl-str (if cmd-n
(strcat dcl-str "\n:button{ " Bwidth-str
"key =\"" (car cmd-n) "\"; label=\"" (last cmd-n) "\"; "
(if (= (substr (car cmd-n) 1 1) "~") "is_enabled = false; " "")
"}"
)
(strcat dcl-str "\nspacer_0;")
)
cmdlst (if (/= (car cmd-n) nil) (cons (car cmd-n) cmdlst) cmdlst)
)
)
(setq dcl-str (strcat dcl-str "}"))
)
(setq dcl-str (strcat dcl-str "\nspacer_0;"))
)
)
(setq dcl-str (strcat dcl-str "}"))
)
)
)
(setq cmdlst (cdr (reverse cmdlst))
dcl-str (strcat dcl-str "\nspacer_1;\n:row{ alignment = centered; fixed_width = true; \nspacer_0;")
)
(if (and switch (setq cmd-n (strsplist switch)))
(setq
dcl-str (strcat dcl-str
"\n:button{ fixed_width = true; width = 4; key = \"" (car cmd-n) "\"; label = \"" (last cmd-n) "\";}")
cmdlst (if (/= (car cmd-n) nil) (cons (car cmd-n) cmdlst) cmdlst)
)
)
(if msg
(setq dcl-str (strcat dcl-str "\n:button{ fixed_width = true; width = 4; key = \"help\"; label = \" 帮助 \";}"))
)
(setq
dcl-str (strcat dcl-str
"\n:button{ fixed_width = true; width = 4; key=\"cancel\"; label=\" 关闭 \"; is_cancel = true;is_default = true;}}}")
dcl (makedcl dcl-str)
act-lst '()
i 1
)
(foreach key cmdlst
(setq act (strcat "(action_tile \"" key "\"\"(done_dialog " (itoa i) ")\")")
act-lst (cons act act-lst)
i (1+ i)
)
)
(new_dialog (substr dcl-str 1 8) dcl)
(action_tile "cancel" "(done_dialog 0)")
(if msg (action_tile "help" "(alert msg)"))
(eval (read (strcat "(progn" (apply 'strcat act-lst) ")")))
(setq ctl (start_dialog))
(unload_dialog dcl)
(vl-file-delete dclfile)
(if (/= ctl 0)
(progn
(setq cmd (nth (- ctl 1) cmdlst))
;;检查命令是否~开头,有就去掉,如果运行中没有更改该命令button的enable值,这句可以不要
(if (= (substr cmd 1 1) "~") (setq cmd (substr cmd 2 (1- (strlen cmd)))))
(cond ;新的命令判断方式,代码更短
((boundp (read (strcat "c:" cmd)))(princ "\n")(eval (read (strcat "(c:" cmd ")"))))
((boundp (read cmd))(princ "\n")(eval (read (strcat "(" cmd ")"))))
(t (princ "\n")(vl-cmdf cmd))
)
)
)
) 字体改别的颜色用opendcl~~~~~~~~~~~~~~~~~~~~~~~~
页:
[1]