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

894768025 · 发表于 2023-2-1 11:23

感谢分享,学习研究一下

wmh-3816 · 发表于 2023-2-1 19:19

谢谢楼主分享

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

本帖最后由 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 
)

726613 · 发表于 2023-2-2 08:21

谢谢分享。

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

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

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

zml84 · 发表于 2023-2-3 07:22

wzg356 发表于 2023-2-2 13:19
多年前就在你的博客上掏了不少干货，包含这个。。。。

相互学习，共同进步！

hn10183051 · 发表于 2023-2-3 08:04

能给个完整的示例吗？大佬

wzg356 · 发表于 2023-2-9 23:10

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

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

wzg356 · 发表于 2023-2-13 22:08

20230213更，增加为5种控件，改进应用体验，还可与图面交互

zj20190405 · 发表于 2023-2-22 12:37

wzg356 发表于 2023-2-13 22:08
20230213更，增加为5种控件，改进应用体验，还可与图面交互

谢谢大佬分享

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

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

本帖子中包含更多资源

评分

评分