列表数据引导用户点击
本帖最后由 dcl1214 于 2024-4-25 15:18 编辑(defun delsame (lst / s-car new)
;删除表中重复项，删除重复
(setq lst (vl-remove nil lst))
(while (setq s-car (car lst))
(if (vl-position s-car new)
()
(set 'new (cons s-car new))
)
(setq lst (cdr lst))
)
(setq new (reverse new))
new
)
(defun list>Split (lst len / g i gs)
;分段，点表拆分，拆分表，按照指定长度拆分表，按长度拆分表，表拆分，表分段，列表分割，列表分组，分段拆分表(另一个函数叫做sn:splitlst)（本函数是2018年0806日写的）,点表分割,按个数分割
;切分表lst成若干段长度为len的子表，子表的个数
(if (and len
(= (type len) 'int)
(> len 0)
lst
(= (type lst) 'list)
)
(if (= len 1)
(setq gs (mapcar 'list lst))
(progn
(while lst
(setq g nil)
(setq i 1)
(while (and lst (<= i len))
(setq cars (car lst))
(setq g (cons cars g))
(setq lst (cdr lst))
(setq i (1+ i))
)
(setq g (reverse g))
(setq gs (cons g gs))
)
(setq gs (reverse gs))
)
)
)
gs
)
(defun wire:list-fill-with-title (dot-pare-list keys
/ gen-row-string
content colum-widths
row-string
)
;;;将点表对变成有标题的listbox填充，列表填充，填充列表，\t方式填充列表，填充listbox
;;; :: dot-pare-list 数据源点表对
;;; :: keys 表头，如果没有表头则所有点表对的表头
;;; :: 返回排成行了的结果,第一行为表头
(defun gen-row-string (str-list width-list /)
;将字串按各列宽度串在一起
(apply 'strcat
(mapcar '(lambda (a b)
(if (not a)
(setq a "")
)
(if (not (= (type a) 'str))
(setq a (vl-princ-to-string a))
)
(setq a (strcat "|" a))
(while (< (strlen a) b)
(setq a (strcat a " "))
)
a
)
str-list
width-list
)
)
)
(if (and dot-pare-list
keys
(= (type dot-pare-list) 'list)
(= (type (car dot-pare-list)) 'list)
(= (type (caar dot-pare-list)) 'list)
(= (type (caaar dot-pare-list)) 'str)
(= (type keys) 'list)
(= (type (car keys)) 'str)
)
(progn
(if (not keys)
(setq keys
(DELSAME
(apply 'append
(mapcar '(lambda (a) (mapcar 'car a)) dot-pare-list)
)
)
)
)
(setq
content (mapcar
'(lambda (a)
(if (member 'nil a)
(print "wire:list-fill-with-title 遇到nil值")
)
(mapcar '(lambda (b)
(if (cdr (assoc b a))
(cdr (assoc b a))
""
)
)
keys
)
)
dot-pare-list
)
)
;;;计算列宽
(setq colum-widths
(mapcar
'(lambda (a)
(apply
'max
(mapcar
(function
(lambda (b)
(if (and b (= (type b) 'list) (= (length b) 1))
(setq b (car b))
(setq b (vl-princ-to-string b))
)
(strlen b)
)
)
a
)
)
)
(apply 'mapcar (cons 'list (cons keys content)))
)
)
(setq colum-widths
(mapcar '1+
(mapcar '(lambda (a)
(if (< a 3)
3
a
)
)
colum-widths
)
)
)
(setq row-string
(mapcar (function (lambda (a / str)
(setq str (gen-row-string a colum-widths))
(setq str (vl-string-left-trim "|" str))
)
)
(cons keys content)
)
)
)
)
row-string
)
(defun AddList (key lst)
;对话框控件填充
(IF (AND key lst)
(PROGN
(if (= (type lst) 'str)
(setq lst (list lst))
)
(start_list key)
(foreach x lst (AND X (= (type x) 'str) (add_list x)))
(end_list)
)
(PROGN
(start_list key)
(end_list)
)
)
lst
)
(defun $xuan-ze$ (label data f-c lst / $d$
$xuan-ze-xq$ _xz_dclagxh-dbd dclid
jz old_time si sql startNum tbn-agk
zds
)
;label 顶部提示语
;data 点表格式的数据，不是矩阵数据
;f-c 第一列的列名
;lst 预留参数
;|
;示例
($xuan-ze$ "请选择mo_xing_ming_cheng"
'((("id" . "3")
("an_gui_hao" . "HL-061-1")
("zhuan_yong_ke_hu" . "")
("guo_bie" . "0")
("guo_bie_biao_zhi" . "BSMI")
("zhen_jiao_shu" . "3")
("zhi_wan" . "直")
("e_ding_dian_liu" . "9A")
("e_ding_dian_ya" . "125V")
("zheng_shu_bian_hao" . "CI362060510465")
("ren_zheng_fan_wei_yan_se" . "")
("mo_xing_ming_cheng" . "台规三插")
("bei_zhu" . "")
)
(("id" . "7")
("an_gui_hao" . "HL-061-2")
("zhuan_yong_ke_hu" . "")
("guo_bie" . "33")
("guo_bie_biao_zhi" . "BSMI")
("zhen_jiao_shu" . "3")
("zhi_wan" . "3")
("e_ding_dian_liu" . "10A")
("e_ding_dian_ya" . "125V")
("zheng_shu_bian_hao" . "CI362060510465")
("ren_zheng_fan_wei_yan_se" . "")
("mo_xing_ming_cheng" . "台规三插")
("bei_zhu" . "")
)
(("id" . "8")
("an_gui_hao" . "HL-028")
("zhuan_yong_ke_hu" . "")
("guo_bie" . "巴西")
("guo_bie_biao_zhi" . "UC")
("zhen_jiao_shu" . "2")
("zhi_wan" . "直")
("e_ding_dian_liu" . "2.5A")
("e_ding_dian_ya" . "250V")
("zheng_shu_bian_hao" . "TüV 23.1140")
("ren_zheng_fan_wei_yan_se" . "")
("mo_xing_ming_cheng" . "8字尾")
("bei_zhu" . "")
)
(("id" . "9")
("an_gui_hao" . "HL-028")
("zhuan_yong_ke_hu" . "")
("guo_bie" . "巴西")
("guo_bie_biao_zhi" . "UC")
("zhen_jiao_shu" . "2")
("zhi_wan" . "直")
("e_ding_dian_liu" . "7A")
("e_ding_dian_ya" . "125V")
("zheng_shu_bian_hao" . "TüV 23.1140")
("ren_zheng_fan_wei_yan_se" . "")
("mo_xing_ming_cheng" . "8字尾")
("bei_zhu" . "")
)
(("id" . "10")
("an_gui_hao" . "HL-061-3")
("zhuan_yong_ke_hu" . "")
("guo_bie" . "台湾")
("guo_bie_biao_zhi" . "BSMI")
("zhen_jiao_shu" . "3")
("zhi_wan" . "直")
("e_ding_dian_liu" . "11A")
("e_ding_dian_ya" . "125V")
("zheng_shu_bian_hao" . "CI362060510465")
("ren_zheng_fan_wei_yan_se" . "")
("mo_xing_ming_cheng" . "台规三插")
("bei_zhu" . "")
)
)
"mo_xing_ming_cheng"
nil
)
|;
(defun _xz_dcl (lst / f p lst dcl-n file)
(setq dcl-n "_xz_dcl")
(SETQ F (VL-FILENAME-DIRECTORY (VL-FILENAME-MKTEMP)))
(SETQ P (STRCAT F "\\" DCL-N))
(if(findfile p)
(VL-FILE-DELETE P)
)
(or(and (setq w (cdr (assoc "width" lst)))
(= (type w) 'str)
(= (type (read w)) 'int)
)
(setq w "100")
)
(setq lst (list
"head:list_box {"
" is_enabled = false ;"
" fixed_height = true ;"
" height = 2 ;"
" vertical_margin = none ;"
" horizontal_margin = none ;"
"}"
""
"xz:dialog {"
" key = \"xz\" ;"
" :paragraph {"
" :head {"
" key = \"h\" ;"
" }"
" :list_box {"
" height = 18 ;"
" key = \"d\" ;"
(strcat " width = " w " ;")
" vertical_margin = none ;"
" horizontal_margin = none ;"
" }"
" }"
" :button {"
" height = 3 ;"
" is_cancel = true ;"
" key = \"tc\" ;"
" label = \"< < < 返回上一级\" ;"
" }"
"}"
)
)
(setq p nil)
(setq p (STRCAT f "\\xz.dcl"))
(if(setq file (open p "w"))
(progn
(foreach line lst
(write-line line file)
)
(close file)
)
)
(if(findfile p)
p
nil
)
)
(defun $xuan-ze-xq$
(data/ _xiangqing_dcl dcl_id
dqyi keys s sjs
startnumstr str-l
)
(defun _xiangqing_dcl (texts / tmp_folder tmp_file tmp_lst)
(defun $rows$ (texts)
(mapcar
(function
(lambda (a / s)
(setq
s
(mapcar
(function
(lambda (b)
(list
" :text {"
" fixed_width = true ;"
(strcat " label = \""
(car b)
"\" ;"
)
" width = 30 ;"
" vertical_margin = none ;"
" horizontal_margin = none ;"
" }"
" :text {"
(strcat " label = \""
(cdr b)
"\" ;"
)
" width = 60 ;"
" vertical_margin = none ;"
" horizontal_margin = none ;"
" }"
)
)
)
a
)
)
(setq s (apply 'append s))
(setq s
(cons " :concatenation { fixed_width = true ;"
s
)
)
(setq
s
(append
s
(list
" vertical_margin = none ; horizontal_margin = none ; }"
)
)
)
)
)
texts
)
)
(setq tmp_folder (strcat (vl-filename-directory (vl-filename-mktemp))
"\\"
)
tmp_file (strcat
tmp_folder
"xiangqing.dcl"
)
)
(if
(findfile tmp_file)
(vl-file-delete tmp_file)
)
(setq texts (vl-remove-if-not
(function (lambda (a) (= (type (cdr a)) 'str)))
texts
)
)
(if (> (length texts) 70)
(setq texts (list>Split texts 2))
(setq texts (mapcar 'list texts))
)
(setq tmp_lst
(append
(list (LIST "xq:dialog {"))
(list (list " label = \"详情预览\" ;"))
($rows$ texts)
(list (LIST " ok_only;"))
(list
(list
" vertical_margin = none ;"
)
)
(list (LIST "}"))
)
)
(setq tmp_lst (apply 'append tmp_lst))
(if (setq file (open tmp_file "w"))
(progn
(cond((= (type tmp_lst) 'STR)
(write-line tmp_lst file)
)
((= (type tmp_lst) 'LIST)
(foreach line tmp_lst
(write-line line file)
)
)
)
(close file)
)
(setq tmp_file nil)
)
;(_sensor:lst->dat tmp_file tmp_lst T NIL)
tmp_file
)
(setq s DATA)
(setq dcl_id (load_dialog (_xiangqing_dcl s)))
(new_dialog "xq" dcl_id)
(start_dialog)
(unload_dialog dcl_id)
)
(defun $d$ (data old_time / new_time pass_time pick si)
(setq new_time (read (substr (rtos (getvar "date") 2 15) 9 6)))
(setq pass_time (- new_time old_time))
(setq pick (get_tile "d"))
(setq pick (atoi pick))
(setq si (nth pick data))
(if(<= pass_time 4)
($xuan-ze-xq$ si)
)
(list pick new_time)
)
(IF (NOT old_time)
(SETq
old_time (- (read (substr (rtos (getvar "date") 2 15) 9 6)) 4)
)
)
(setq zds (delsame (mapcar 'car (apply 'append data))))
(if f-c
(setq zds (cons f-c (vl-remove f-c zds)))
) ;第一列强制
(setq d nil)
(setq jz (wire:list-fill-with-title data zds))
(setq dclid (load_dialog (_xz_dcl lst)))
(new_dialog "xz" dclid "" (list -1 -1))
(and label (set_tile "xz" label))
(addlist "d" (cdr jz))
(addlist "h" (list (car jz)))
(action_tile "tc" "(setq pick(get_tile \"d\"))")
(action_tile
"d"
"(mapcar 'set(list 'd 'old_time)($d$ data old_time))"
)
(setq startNum (start_dialog))
(COND ((= STARTNUM 0) (princ)))
(unload_dialog dclid)
(if (and pick data)
(setq si (nth (atoi pick) data))
)
si ;返回给上一级
)
:handshake 来学习了 缺少函数：delsame，wire:list-fill-with-title，addlist，list>Split ssyfeng 发表于 2024-4-25 14:20
缺少函数：delsame，wire:list-fill-with-title，addlist，list>Split
缺少的函数已经补充了
页:
[1]