（20230213更）通用DCL输入框----魔法交互，5种控件，edit_box数据检查现....
本帖最后由 wzg356 于 2023-2-28 17:51 编辑图片为下面例子的运行样子
20230213更，增加为5种控件，改进应用体验
20230209更，输入框数据检查改为实时现场纠错，免币源码在http://bbs.mjtd.com/forum.php?mo ... =1&extra=#pid908231“通用函数-坐标处理.lsp”里面，那个帖子的所有程序都直接用的这个通用输入框
主要用于参数设置、数据交换，也可与图面交互
主要是edit_box/toggle /popup_list/list_box 控件，随edit_box可以增加辅助botton，
数值edit_box可设置数据限制,输入数据检查，出错实时提示错误信息并现场要求纠正
自我感觉比较强了
具体应用自己研究母程序，
可少写了好多对话框
程序要下载
下面是应用示例-----也在源程序里面
其他说明也在母程序
应用肯定不限于下面例子，我自用程序涉及参数设置的大部分直接使用
;通用输入框;应用示例
;(getYESorNOdcl "YES OR NO?")
(defun getYESorNOdcl (str)
(TYdataset str nil 12 nil nil)
);返回1/0
;(getNUMdcl "输入数值" 5);返回整数或5---按取消返回初值
;(getNUMdcl "输入数值" 5.0);返回实数或5.0---按取消返回初值
;(getNUMdcl "输入数值" "A");返回字符串或"A"---按取消返回初值
;很少这样用，进一步控制参源码注释,在此不表
(defun getNUMdcl (str n)
(TYdataset ""(list(list str n))12 nil T)
)
;---------------
;多数情况简单点是这样，4种基本控件都有了
(defun c:yyy4 (/ l2 lst)
(setq l1 '("中国" "欧盟" "北美"))
(setq l2 '("100*100" "200*200" "500*500" "800*800"))
(setq lst '(0 0 45.0 55 105 "0"))
(setq lst(TYdataset
"参数设置" ;参数1--DCL标题
(list(list "标准"(list (car lst) l1));popup_list/key0
(list "规格" (list (cadr lst) l2 t));list_box/key1
(list "旋转(°)" (caddr lst));edit_box/key2
(list "是否加框" (list (setq a(cadddr lst))(if(= a "0")"1" "0")));toggle/key3
);参数2--据需求设定的控件及初值
12 NIL T
))
)
;---------------------
;可以在合适位置添加分割线或文字，也可用于参数4fun写表达式显示动态信息--自行参阅母程序交待
(defun c:yyy5 ( / a lst)
(setq lst '(0 100 45.0 0 "0"))
(setq lst(TYdataset
"参数设置" ;参数1--DCL标题
(list(list "参数1" (car lst));edit_box/key0
(list "参数2" (cadr lst));edit_box/key1
"----AB界-----";"spacer_0;"或其他字符串str，任何位置均可
;作用1仅紧凑控件就写"spacer_0;"控件或
;作用2:相应位置内容为str的text
(list "字高" (caddr lst));edit_box/key2
(list "精度" (list(cadddr lst)'("0" "0.0" "0.00" "0.000")));popup_list/key3
(list "勾选输出XYH" (list (setq a(last lst))(if(= a "0")"1" "0")));toggle/key4
);参数2--据需求设定的控件及初值
12 NIL T
))
)
;-------------------------------
;增加辅助botton及表达式参数增强控制示例
(defun c:yyy6 ( / lst)
(setq lst(TYdataset
"注册XX程序" ;参数1--DCL标题
(list(list "Cbutton申请码" "cfghh125gg");button/Akey0/edit_box/key0
(list "注册码" "联系QQ12345");edit_box/key1
);参数2--据需求设定的控件及初值
12
'(progn(mode_tile "key0" 1);锁定key0
;对母程序函数actAKEYS重定义，重设辅助botton动作
(defun actAKEYS nil(action_tile "Akey0" "(alert \"\\\n申请码已复制\")"))
;剪贴板设置函数自己找哈
)
T
))
;(注册验证程序 lst)
)
;---------------------------------
;popup_list/list_box用法及联动示例
;通过辅助botton实现与图面的交互示例
(defun c:yyy7 (/ lst yy0)
(setq lst '(0 0 45.0 "0"))
(setq l2 '(("100*100" "200*200" "500*500" "800*800")
(3.25 5.78 6.88 9.00)("3A" "3B" "3C" "3D")
))
(defun yyy0(lst / a lstnew p)
(setq lstnew(TYdataset "联动交互"
(list(list "标准"(list (car lst) '("中国" "欧盟" "北美")));popup_list/key0
(list "规格" (list (cadr lst) (nth (car lst) l2)t));list_box/key1
;(list "规格" (list (cadr lst) (nth (car lst) l2)t t));list_box/key1 2种样子
(list "》buttonTDW" (caddr lst));button/Akey2/;edit_box/key2
(list "是否加框" (list (setq a(cadddr lst))(if(= a "0")"1" "0")));toggle/key3
)
12
'(progn
(action_tile "key0" "(addlist \"key1\"(nth(atoi $value)l2))(set_tile \"key1\" \"0\")")
;popup_list/list_box联动
;注释下面这句话就可与图面交互
;(defun actAKEYS nil(action_tile "Akey2" "(alert \"\\\n功能脑补...\")"))
;对母程序函数actAKEYS重定义，重设Akey2辅助botton动作
)
T
))
(if(= (cadrlstnew)12)
(progn(setq p(getpoint "\n取得坐标"));图面交互;数据处理......略
(yyy0 (car lstnew))
)lstnew
)
)
(yyy0 '(0 0 45.0 "0"))
)
本帖最后由 zml84 于 2023-2-1 19:57 编辑
凑个热闹
https://mp.weixin.qq.com/s/56eTQA4wHbpTKMgzelIBCQ
;;;========================================================*
;;;测试
(defun C:TT ()
(ZL-INPUTBOX
"身份验证"
'(("editbox" "用户名：" "USER" "20")
("editbox" "口 令：" "" "20")
("popup_list"
"类 型："
("受限用户""一般用户" "超级管理员")
"20"
)
;;
("spacer_1")
("text" "这是一个说明文本。")
("说明" "更多说明..." "说明信息1\n说明信息2\n...")
)
)
)
---------------------------------------------------------------------
;;;=================================================================*
;;; 定义通用数据输入窗体 *
;;; *
;;;=================================================================*
;|注意，调用参数均为字符串形式 *
;;;返回：字符串列表 *
;;;日期：zml84 于 2012-06-20
;;;-----------------------------------------------------------------*
;;;示例： *
(ZL-INPUTBOX *
"显示的对话框名称" *
'(("editbox" *
"editbox显示的说明" *
"editbox显示值" *
"20" *
) *
("popup_list" *
"popup_list显示的说明" *
("列表值1" "列表值2" "...") *
"20" *
) *
) *
) *
;;;=================================================================*
;;|;
(vl-load-com)
;;;=================================================================*
(defun ZL-INPUTBOX (STR_DIANAME LST /
LIST->DCLTEMPFILENAME F1
STR_JG I N DCLID
LST_RESULT str_sm key_sm
)
;;==================================================================*
;;功能：根据控件信息表，生成DCL语言的文本 *
;; 注意，调用参数均为字符串形式 *
;;示例：(list->dcl '( "editbox" "editbox显示的说明" "editbox显示值""20") 100)
;;(list->dcl '( "popup_list" "popup_list显示的说明" ("列表值1" "列表值2" "...")"20") 101)
;;(list->dcl '( "popup_list" "popup_list显示的说明" "列表值1\\n列表值2\\n...""20") 102)
;;返回：与控件对应的dcl文本
;;日期：zml84 于 2012-06-20
(defun LIST->DCL (LST KEY_I / X)
(cond
;;
((wcmatch (car LST) "ZML84*")
(strcat
":button{"
(strcat "\nlabel=\""
(nth 0 LST)
"\";"
"\nis_enabled = false;"
)
"\n}\n"
)
)
;;标准按钮，点击后显示更多说明信息。
;;格式：("说明"按钮名称 信息)
;;示例：("说明" "更多说明..." "说明信息1\n说明信息2\n...")
((wcmatch (car LST) "说明")
(setq str_sm (nth 2 lst));_设置说明文本，供后面回调用
(strcat
":button{"
(strcat "\nlabel=\""
(nth 1 LST)
"\";"
(strcat "\nkey =\"KEY_SM\";")
"\nis_enabled = true;"
)
"\n}\n"
)
)
;;
((= (car LST) "editbox")
(strcat
":edit_box{"
"\nallow_accept = true ;"
(strcat "\nedit_width ="
(nth 3 LST)
";"
)
"\nfixed_width = true ;"
(strcat "\nkey =\"" (itoa KEY_I) "\";")
(strcat "\nlabel=\""
(nth 1 LST)
"\";"
)
(strcat "\nvalue=\""
(nth 2 LST)
"\";"
)
"\n}\n"
)
)
;;
((= (car LST) "popup_list")
(strcat
":popup_list{"
(strcat "\nwidth ="
(nth 3 LST)
";"
)
(strcat "\nlabel=\""
(nth 1 LST)
"\";"
)
(strcat "\nkey =\"" (itoa KEY_I) "\";")
(cond
((= (type (nth 2 LST)) 'STR)
(strcat "\nlist=\""
(nth 2 LST)
"\";"
)
)
((= (type (nth 2 LST)) 'list)
(strcat
"\nlist=\""
(apply
'strcat
(mapcar
'(lambda (X)
(strcat "\\n"
(vl-princ-to-string X)
)
)
(nth 2 LST)
)
)
"\";"
)
)
) ;_结束 cond
"\n}\n"
)
)
;;
((= (car LST) "text")
(strcat
":text{"
(strcat "\nlabel=\""
(nth 1 LST)
"\";"
)
"\n}\n"
)
)
;;
((= (car LST) "spacer_1")
(strcat"\n"
(nth 0 LST)
";\n"
)
)
;;; ((/= (LIST->DCL (cons "editbox" LST) KEY_I) "")
;;; (LIST->DCL (cons "editbox" LST) KEY_I)
;;; )
(t "")
) ;_结束 cond
) ;_结束defun
;;==================================================================*
;;功能：定义按下确定按钮后的操作
(defun GETINPUT (LEN / I N TMP)
(setq RESULTLIST '()
I 0
)
(repeat(length LST)
(setq N (nth I LST))
(cond
;;
((= (car N) "editbox")
(setq LST_RESULT
(cons (get_tile (itoa I)) LST_RESULT)
)
)
;;
((= (car N) "popup_list")
(setq TMP (nth 2 N))
;;tmp有两种格式：字符形式的 和 表形式
;;如果是字符格式的，就转换为表（以\n分割）
(cond
((= (type (nth 2 N)) 'STR)
(setq TMP "*INPUTBOX函数 有待完善*")
)
((= (type (nth 2 N)) 'list)
(setq TMP (nth (atoi (get_tile (itoa I))) TMP))
)
)
(setq LST_RESULT
(cons TMP LST_RESULT)
)
)
;;
;;
(t
(setq LST_RESULT
(cons NIL LST_RESULT)
)
)
)
(setq I (1+ I))
)
(setq LST_RESULT (reverse LST_RESULT))
) ;_结束defun
;;==================================================================*
(setq TEMPFILENAME (vl-filename-mktemp "dcltmp.dcl"))
(setq F1 (open TEMPFILENAME "w"))
;;组织头部
(setq STR_JG (strcat
"InputBox:dialog {"
(strcat "\nlabel =\"" STR_DIANAME "\";")
)
)
;;组织正文
(setq I 0)
(repeat (length LST)
(setq N (nth I LST))
(setq STR_JG (strcat STR_JG
(LIST->DCL N I)
)
)
(setq I (1+ I))
)
;;组织按钮、
(setq STR_JG
(strcat
STR_JG
"\nspacer_0;"
"\nok_cancel;"
;;zml个人信息
"\n:button{"
"\nlabel=\"ZML84作品，必属精品。\";"
"\nis_enabled = false;\n}\n"
;;
;;; "\n:text{"
;;; "\nlabel=\"ZML84作品，必属精品。\";"
;;; "\nis_enabled = false;"
;;; "\n}\n"
;;对话框结束
"\n}\n"
)
)
;;写入文件
(princ STR_JG F1)
;;关闭文件
(close F1)
(setq DCLID (load_dialog TEMPFILENAME))
(if(not (new_dialog "InputBox" DCLID ""))
(progn (alert "对话框加载失败!") (exit))
)
(action_tile
"accept"
"(GetInputLst ) (done_dialog 1)"
)
(if STR_SM
(action_tile
"KEY_SM"
"(if zl-msgbox (ZL-msgbox nil \"i\" STR_SM 0)(ALERT STR_SM))"
))
(start_dialog)
(unload_dialog DCLID)
(vl-file-delete TEMPFILENAME)
;;返回
LST_RESULT
) 本帖最后由 wzg356 于 2023-2-10 12:55 编辑
20230209更，输入框数据检查改为实时现场纠错，免币源码在http://bbs.mjtd.com/forum.php?mo ... =1&extra=#pid908231“通用函数-坐标处理.lsp”里面，那个帖子的所有程序都直接用的这个通用输入框
zml84 发表于 2023-2-1 19:53
凑个热闹
https://mp.weixin.qq.com/s/56eTQA4wHbpTKMgzelIBCQ
多年前就在你的博客上掏了不少干货，包含这个。。。。
能给个实例么？对着看容易明白 加载后运行事例代码就行，具体说明也在事例代码 bai2000 发表于 2023-1-31 12:57
能给个实例么？对着看容易明白
补充了，3个示例，加载程序后，从简单开始运行体验 感谢分享,学习研究一下 这是纯函数？没有快捷键？ 兄弟，厉害，多谢无私奉献，省了很多时间 谢谢楼主分享 感谢大佬分享！