（20230213更）通用DCL输入框----魔法交互，5种控件，edit_box数据检查现....

wzg356 · 发表于 2023-1-31 12:22:03

本帖最后由 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(= (cadr  lstnew)12)
                     (progn(setq p(getpoint "\n取得坐标"));图面交互;数据处理......略
                              (yyy0 (car lstnew))
                     )lstnew
            )
      )
      (yyy0 '(0 0 45.0 "0"))
)

zml84 · 发表于 2023-2-1 19:53:21

本帖最后由 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->DCL TEMPFILENAME 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"
"(GetInput Lst ) (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
)

;;;=================================================================* 
;;;    定义通用数据输入窗体                                         * 
;;;                                                                 * 
;;;=================================================================* 
;|注意，调用参数均为字符串形式                                     * 
;;;返回：字符串列表                                                 * 
;;;日期：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->DCL  TEMPFILENAME       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" 
  "(GetInput  Lst ) (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-9 23:10:50

本帖最后由 wzg356 于 2023-2-10 12:55 编辑

20230209更，输入框数据检查改为实时现场纠错，免币源码在http://bbs.mjtd.com/forum.php?mo ... =1&extra=#pid908231“通用函数-坐标处理.lsp”里面，那个帖子的所有程序都直接用的这个通用输入框

wzg356 · 发表于 2023-2-2 13:19:01

zml84 发表于 2023-2-1 19:53
凑个热闹
https://mp.weixin.qq.com/s/56eTQA4wHbpTKMgzelIBCQ

多年前就在你的博客上掏了不少干货，包含这个。。。。

bai2000 · 发表于 2023-1-31 12:57:00

能给个实例么？对着看容易明白

wzg356 · 发表于 2023-1-31 13:07:07

加载后运行事例代码就行，具体说明也在事例代码

wzg356 · 发表于 2023-1-31 14:47:03

bai2000 发表于 2023-1-31 12:57
能给个实例么？对着看容易明白

补充了，3个示例，加载程序后，从简单开始运行体验

hn10183051 · 发表于 2023-1-31 15:59:32

229096767 · 发表于 2023-1-31 16:01:35

感谢分享,学习研究一下

liuhe · 发表于 2023-1-31 16:40:16

这是纯函数？没有快捷键？

zj20190405 · 发表于 2023-1-31 20:23:07

兄弟，厉害，多谢无私奉献，省了很多时间

中国梦 · 发表于 2023-1-31 22:19:12

谢谢楼主分享

guosheyang · 发表于 2023-2-1 09:35:20

感谢大佬分享！

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

[函数] （20230213更）通用DCL输入框----魔法交互，5种控件，edit_box数据检查现....

本帖子中包含更多资源

评分

本帖子中包含更多资源

评分

评分