DCL 操作类

Free-Lancer · 发表于 2014-8-23 12:54:30

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 Free-Lancer 于 2014-8-23 14:14 编辑

lib.vlx 已包含

;; 填充列表
;; key --- key
;; val --- list
;; item --- 默认值
(defun DCL:AddList (key val item)
(start_list key)
(foreach n val
(add_list n)
)
(end_list)
(set_tile key (itoa item))
)
;;填充 slide
;; key ----- key
;; sldname --- slide name
;; color --- color (int)
(defun DCL:SlideImage (key sldname color / x y)
(setq x (dimx_tile key)
y (dimy_tile key)
)
(start_image key)
(fill_image 0 0 x y color)
(slide_image 0 0 x y sldname)
(end_image)
)
;;单色
;;key ------ key
;;color ---- color (int)
(defun DCL:ImageFillColor (key color)
(setq x (dimx_tile key)
y (dimy_tile key)
)
(start_image key)
(fill_image 0 0 x y color)
(slide_image 0 0 x y key)
(end_image)
(mode_tile key 1)
)
;;禁用 Image button
;; key ---- key
(defun DCL:ImageCrlDisable (key)
(mapcar
'(lambda (x)
(dcl:ImageFillColor x 253)
)
key
)
)
;;启用控件
;;clist --- key list
(defun dcl:CtrlEnable (clist)
(mapcar
'(lambda (x)
(mode_tile x 0)
)
clist
)
)
;;禁用控件
;;clist --- key list
(defun dcl:CtrlDisable (clist)
(mapcar
'(lambda (x)
(mode_tile x 1)
)
clist
)
)
;;清空 errtile 控件显示
(defun DCL:RsError ()
(set_tile "error" "")
)
;;设置 errtile 控件文字
;;var ----- string
(defun DCL:SetError (val)
(dcl:RsError)
(set_tile "error" val)
)
;;检查输入格式(数字)
;;input ---- $value
;;format ---- string
;;kk ---- key
(defun DCL:CheckIn (input format kk /)
(if (and (distof input 2) (> (atof input) 0))
(progn (dcl:RsError) input)
(progn
(dcl:SetError (strcat "无效的" format "输入"))
(mode_tile kk 2)
nil
)
)
)
;; Radio 组 Action
;; keylst ---- radio key list
;; def ---- key
(defun Dcl:RadioAction (keylst def / action)
(defun actionx ()
(mapcar '(lambda (x)
(if (= x def)
(set_tile x "1")
(set_tile x "0")
)
)
keylst
)
)
(foreach x keylst
(action_tile x "(actionx)")
)
)
;;初始化 Radio 组
;; keylst ---- radio key list
;; def ---- key
(defun DCL:RadioInit (keylst def)
(mapcar '(lambda (x)
(if (= x def)
(set_tile x "1")
(set_tile x "0")
)
)
keylst
)
)
;;获取 Radio 组的选中 key
;;keylst ----- radio key list
(defun DCL:RadioStatus (keylst)
(car
(vl-remove-if '(lambda (x) (= (get_tile x) "0")) keylst)
)
)
;;=============================================================
;;获取控件值
;;lst ---- key list
(defun DCL:Gettile (lst)
(mapcar '(lambda (x)
(get_tile x)
)
lst
)
)
;;批量设置控件值
;;kl ------ key list
;;pl ------ list
(defun DCL:Settile (kl pl)
(mapcar '(lambda (x y)
(set_tile x y)
)
kl
pl
)
)
;;;=============================================================
;;将DCL表写出文件
(defun DCL:Make (lst / flname ofile)
(setq FlName (vl-filename-mktemp (strcat "FYDCL" ".dcl"))
oFile (open FlName "w")
)
(foreach fStream lst (write-line fStream oFile)) ;写入文件
(close oFile) ;_关闭文档
flname
)
;;加载 DCL 文件
(defun DCL:Load (flname na / id)
(setq id (load_dialog FlName))
(if (not (new_dialog na id ""))
(progn (alert "对话框加载失败!") (exit))
)
id
)

;; 填充列表 
;; key ---   key 
;; val ---   list 
;; item ---  默认值 
(defun DCL:AddList (key val item) 
  (start_list key) 
  (foreach n val 
    (add_list n) 
  ) 
  (end_list) 
  (set_tile key (itoa item)) 
) 
;;填充 slide 
;; key   ----- key 
;; sldname --- slide name 
;; color   --- color (int) 
(defun DCL:SlideImage (key sldname color / x y) 
  (setq        x (dimx_tile key) 
        y (dimy_tile key) 
  ) 
  (start_image key) 
  (fill_image 0 0 x y color) 
  (slide_image 0 0 x y sldname) 
  (end_image) 
) 
;;单色 
;;key ------ key 
;;color ---- color (int) 
(defun DCL:ImageFillColor (key color) 
  (setq        x (dimx_tile key) 
        y (dimy_tile key) 
  ) 
  (start_image key) 
  (fill_image 0 0 x y color) 
  (slide_image 0 0 x y key) 
  (end_image) 
  (mode_tile key 1) 
) 
;;禁用 Image button 
;; key ---- key 
(defun DCL:ImageCrlDisable (key) 
  (mapcar 
    '(lambda (x) 
       (dcl:ImageFillColor x 253) 
     ) 
    key 
  ) 
) 
;;启用控件 
;;clist ---  key list 
(defun dcl:CtrlEnable (clist) 
  (mapcar 
    '(lambda (x) 
       (mode_tile x 0) 
     ) 
    clist 
  ) 
) 
;;禁用控件 
;;clist ---  key list 
(defun dcl:CtrlDisable (clist) 
  (mapcar 
    '(lambda (x) 
       (mode_tile x 1) 
     ) 
    clist 
  ) 
) 
;;清空 errtile 控件显示 
(defun DCL:RsError () 
  (set_tile "error" "") 
) 
;;设置 errtile 控件 文字 
;;var ----- string 
(defun DCL:SetError        (val) 
  (dcl:RsError) 
  (set_tile "error" val) 
) 
;;检查输入格式(数字) 
;;input  ---- $value 
;;format ---- string 
;;kk     ---- key 
(defun DCL:CheckIn (input format kk /) 
  (if (and (distof input 2) (> (atof input) 0)) 
    (progn (dcl:RsError) input) 
    (progn 
      (dcl:SetError (strcat "无效的" format "输入")) 
      (mode_tile kk 2) 
      nil 
    ) 
  ) 
) 
;; Radio 组 Action 
;; keylst ---- radio key list 
;; def    ---- key 
(defun Dcl:RadioAction (keylst def / action) 
  (defun actionx () 
    (mapcar '(lambda (x) 
               (if (= x def) 
                 (set_tile x "1") 
                 (set_tile x "0") 
               ) 
             ) 
            keylst 
    ) 
  ) 
  (foreach x keylst 
    (action_tile x "(actionx)") 
  ) 
) 
;;初始化 Radio 组 
;; keylst ---- radio key list 
;; def    ---- key 
(defun DCL:RadioInit (keylst def) 
  (mapcar '(lambda (x) 
             (if (= x def) 
               (set_tile x "1") 
               (set_tile x "0") 
             ) 
           ) 
          keylst 
  ) 
) 
;;获取 Radio 组的选中 key 
;;keylst ----- radio key list 
(defun DCL:RadioStatus (keylst) 
  (car 
    (vl-remove-if '(lambda (x) (= (get_tile x) "0")) keylst) 
  ) 
) 
;;============================================================= 
;;获取 控件 值 
;;lst ---- key list 
(defun DCL:Gettile (lst) 
  (mapcar '(lambda (x) 
             (get_tile x) 
           ) 
          lst 
  ) 
) 
;;批量设置控件值 
;;kl  ------ key list 
;;pl  ------ list 
(defun DCL:Settile (kl pl) 
  (mapcar '(lambda (x y) 
             (set_tile x y) 
           ) 
          kl 
          pl 
  ) 
) 
;;;============================================================= 
;;将DCL表写出文件 
(defun DCL:Make (lst / flname ofile) 
  (setq        FlName (vl-filename-mktemp (strcat "FYDCL" ".dcl")) 
        oFile  (open FlName "w") 
  ) 
  (foreach fStream lst (write-line fStream oFile)) ;写入文件 
  (close oFile) ;_关闭文档 
  flname 
) 
;;加载 DCL 文件 
(defun DCL:Load (flname na / id) 
  (setq id (load_dialog FlName)) 
  (if (not (new_dialog na id "")) 
    (progn (alert "对话框加载失败!") (exit)) 
  ) 
  id 
)

Free-Lancer · 发表于 2014-8-23 13:19:37

DCL 编写推荐用飞诗版主这个编辑器ListDCLediter，直观，省得自己码代码

lucas3 · 发表于 2014-8-23 13:48:49

本帖最后由 lucas3 于 2014-8-23 14:10 编辑

谢谢大师，分享，飞诗的编辑器很早接触过，只是不太会用，
大师的第一个贴里面的代码格式出了问题，可能跟表情符号有关，就自动认为是表情符号了，

;;加载 DCL 文件
(defun DCL<img src="static/image/smiley/default/sweat.gif" smilieid="10" border="0" alt="" />oad (flname na / id)
(setq id (load_dialog FlName))
(if (not (new_dialog na id ""))
(progn (alert "对话框加载失败!") (exit))
)
id
)

建议直接上传文件或者使用代码格式中使用空格分开

;;加载 DCL 文件
(defun DCL:load (flname na / id)
(setq id (load_dialog FlName))
(if (not (new_dialog na id ""))
(progn (alert "对话框加载失败!") (exit))
)
id
)

像大写的Ｌ:Ｌ就是认为是汗水符号，换一个小写就没事了

Free-Lancer · 发表于 2014-8-23 14:17:33

lucas3 发表于 2014-8-23 13:48
谢谢大师，分享，飞诗的编辑器很早接触过，只是不太会用，
大师的第一个贴里面的代码格式出了问题，可能跟 ...

谢谢提醒，已修改，勾选“禁用表情”即可

拉契 · 发表于 2014-8-23 22:15:15

从楼主这学到了不少东西！感谢！顶起！

czx663 · 发表于 2014-8-24 07:13:19

{:soso_e179:}总有惊喜

xtdwynij · 发表于 2014-8-25 10:24:06

前些日子学了对话框。呵呵感谢楼主贡献的工具。

pxt2015 · 发表于 2017-12-10 07:55:47

谢谢楼主分享，DCL操作类函数汇总

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

[教学] DCL 操作类

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

点评

评分

评分

浏览过的版块