通用的对话框DCL赋值与取值函数

言戲無軍 · 发表于 2022-3-11 15:50:28

本帖最后由言戲無軍于 2022-3-13 10:35 编辑

dcl对话框界面可以用飞诗dcl编辑器生成，dcl对话框的赋值与取值对新手来说入门比较难，论坛上有很多通用的函数，一直没有满意的，故写下此2函数。
抛转引玉一起交流，水平有限轻拍。附带了dcl完整测试程序文件。新增dcl创建函数 dcl_create

dcl_setTile 赋值
dcl_getTile 取值
dcl_create

;;说明:对dcl对话框进行批量赋值及初始化
;;参数:lst: 控件keys 和值组成的表
;;返回:
(defun dcl_setTile(lst / a)
(mapcar
'(lambda(x)
(cond
((= (type (cadr x)) 'list)
(start_list (car x) );;(caadr x)
(mapcar 'add_list (val2str(cadadr x)))
(end_list)
(setq a (caadr x))
(if (= (type a) 'LIST)
(set_tile (car x)
(vl-string-right-trim " " (apply 'strcat (mapcar '(lambda(y)(strcat y " "))(val2str a))))
)
(set_tile (car x) (val2str(caadr x)))
)
)
(t (set_tile (car x) (val2str (cadr x))) )
)
)
lst
)
)
;;说明:获取对话框控件值需要注意的是没有进行数据合法性检查，自行增加
;;参数:lst: 控件keys和值组成的表即变量保存列表*vars&vals*
;;返回:获取的控件变量
;;说明:
(defun dcl_getTile(lst / lst0 key v)
;(setq lst0 lst)
(mapcar
'(lambda(x)
(setq key (car x))
(setq v (get_tile key))
(cond
((= (type (cadr x)) 'list)
(setq a (caadr x))
(if (/= (type a) 'LIST)
(setq v (atoi v))
(setq v (read (strcat "(" v ")")))
)
(list key (list v (cadadr x)))
)
(t (list key (str2val v (cadr x))) ) ;;(str2val "123.5" 10.1)
)
)
lst
)
)

;;说明:对dcl对话框进行批量赋值及初始化 
;;参数:lst: 控件keys 和 值组成的表 
;;返回: 
(defun dcl_setTile(lst / a) 
  (mapcar 
    '(lambda(x) 
       (cond 
         ((= (type (cadr x)) 'list)   
           (start_list (car x) );;(caadr x) 
           (mapcar 'add_list   (val2str(cadadr x))) 
           (end_list) 
           (setq a (caadr x)) 
           (if (= (type a)  'LIST) 
             (set_tile (car x) 
               (vl-string-right-trim " " (apply 'strcat (mapcar '(lambda(y)(strcat y " "))(val2str a))))                
             )                           
             (set_tile (car x) (val2str(caadr x))) 
           )            
         ) 
         (t (set_tile (car x) (val2str (cadr x))) ) 
       ) 
     ) 
    lst   
  )    
) 
;;说明:获取对话框控件值 需要注意的是没有进行数据合法性检查，自行增加 
;;参数:lst: 控件keys和值组成的表 即变量保存列表*vars&vals* 
;;返回:获取的控件变量 
;;说明: 
(defun dcl_getTile(lst / lst0  key v) 
  ;(setq lst0 lst) 
  (mapcar 
    '(lambda(x) 
       (setq key (car x)) 
       (setq v (get_tile key)) 
       (cond 
         ((= (type (cadr x)) 'list) 
           (setq a (caadr x)) 
           (if (/= (type a)  'LIST) 
             (setq v (atoi v)) 
             (setq v (read (strcat "(" v ")")))             
           ) 
           (list key (list v (cadadr x)))                      
         ) 
         (t  (list key (str2val v (cadr x)))  )  ;;(str2val "123.5" 10.1) 
       ) 
     ) 
    lst 
  ) 
)

传入的lst要求是2维表

(setq *vars&vals* ;;;全局变量用于初始化及保存dcl中所有的值 (setq *vars&vals* nil)
'(
("op1" 1);radio1选则1选中 0不选 1选中
("op2" 0);radio1选则2未选中 0不选 1选中
("edit1" 123.5);;editbox实数
("edit2" "asbda");;editbox字符串
("tog1" 0);;toggle复选框 0不选 1选中。
("pop1" (2 (0.2 0.5 1.0 2.0 5.0)) ) ;;popuplist下拉框列表 0 代表默认为列表中第一个值1代表第二个...
;(0.2 0.5 1.0 2.0 5.0)代表下拉列表框中显示的值
("list1" ((1) ("物品1" "物品2" "物品3" "物品4")) ) ;;listbox下拉框列表 1 代表默认为列表中第二个值2代表第三个...
;;("物品1" "物品2" "物品3" "物品4")list1中显示的值 ;如果列表支持多选 1换为表 (1) (1 2 3)等
)
)

(defun dcl_Create ( / dcl des dcl_id)
(setq dcl (vl-filename-mktemp nil nil ".dcl"))
(setq des (open dcl "w"))
(write-line (apply 'strcat dclLst )des)
(close des)
(setq dcl_id (load_dialog dcl))
(vl-file-delete dcl)
(setq dlg (car (vl-remove-if-not '(lambda (x) (wcmatch x "*dialog*")) dcllst)))
(setq dlg (car (LM:str->lst dlg ":" )))
(if (null (new_dialog dlg dcl_id))
(exit)
)
dcl_id
)

顺便附上对话框dcl文件转lisp文件程序，也就是程序中用到的dcllist 就不用单独打包dcl文件了。

hhh454 · 发表于 2022-3-12 20:07:14

本帖最后由 hhh454 于 2022-3-12 20:18 编辑

;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings

(defun LM:str->lst ( str del / len lst pos )
(setq len (1+ (strlen del)))
(while (setq pos (vl-string-search del str))
      (setq lst (cons (substr str 1 pos) lst)
            str (substr str (+ pos len))
      )
)
(reverse (cons str lst))
)

xyp1964 · 发表于 2022-3-12 20:34:11

(defun LM:str->lst (str del / n lst n1)
  (setq n (1+ (strlen del)))
  (while (setq n1 (vl-string-search del str))
(setq lst (cons (substr str 1 n1) lst)
      str (substr str (+ n1 n))
)
  )
  (vl-remove "" (reverse (cons str lst)))
)

言戲無軍 · 发表于 2022-4-5 13:21:04

kozmosovia 发表于 2022-4-2 16:30
https://www.zhihu.com/column/vldcl

膜拜了 vl dcl太专业了只是自由度差了点，入门有点难

liuyj · 发表于 2022-3-11 15:57:41

函数不全，缺val2str

言戲無軍 · 发表于 2022-3-11 16:03:44

在附件中，下载即可。

20060510412 · 发表于 2022-3-12 10:23:34

LM:str->lst
缺少这个函数

至野异族 · 发表于 2022-3-12 21:48:37

这个思路比较好，借鉴了，多谢分享

20060510412 · 发表于 2022-3-12 23:32:57

非常实用，dcl的设置流程得到了大大简化，多谢楼主。

AndyWang · 发表于 2022-3-15 09:23:03

非常感谢楼主的分享

hnfsf · 发表于 2022-3-28 22:27:20

这个思路很不错，多谢分享

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

[源码] 通用的对话框DCL赋值与取值函数

本帖子中包含更多资源

评分