(XD::Dcl:ButtonAction)Button控件动作设置

Free-Lancer

1. ;|
   
2. 仅定义按钮的回调函数
   
3. what 只可以为 "callback" 或 ("callbakc1" "callback2" ...)
   
4.            或 ("callback1" (int "callback2") ....)
   
5.            或 (2 3 4 ...)
   
6. 1 与图形交互时, what 为表 '(int callback) int 为dcl返回状态码 大于2
   
7. 2 定义控件间关联动作时
   
8.   a 单按钮 what 为 字符型回调函数名 _$klst 为控件名
   
9.   b 多按钮 what 为 回调函数表
   
10. 单键定义
    
11. (xd::dcl:buttonaction "k1" "callback") 控件间关联
    
12. (xd::dcl:buttonaction "k1" '(0 "callback"))结束对话框式回调
    
13. 批量定义
    
14. (xd::dcl:buttonaction '("k1" "k2" ...) '("callbakc1" (2 "callback2") ...))
    
15. |;
    
16. (defun XD::Dcl:ButtonAction (_$klst what / _sButtonAction)
    
17.   (defun _sButtonAction        (_$key _$callback)
    
18.     (cond
    
19.       ((= (type _$callback) 'INT)
    
20.        (action_tile
    
21.          _$key
    
22.          (strcat "(done_dialog " (itoa _$callback) ")")
    
23.        )
    
24.       )
    
25.       ((= (type _$callback) 'STR)
    
26.        (action_tile _$key (strcat "(" _$callback ")"))
    
27.       )
    
28.       (t)
    
29.     )
    
30.   )
    
31.   (if (listp _$klst)
    
32.     (while _$klst
    
33.       (_sButtonAction (car _$klst) (car what))
    
34.       (setq _$klst (cdr _$klst)
    
35.             what   (cdr what)
    
36.       )
    
37.     )
    
38.     (_sButtonAction _$klst _$callback)
    
39.   )
    
40. )
    

;|<br /> 仅定义按钮的回调函数<br /> what 只可以为 "callback" 或 ("callbakc1" "callback2" ...)<br />            或 ("callback1" (int "callback2") ....)<br />            或 (2 3 4 ...)<br /> 1 与图形交互时, what 为表 '(int callback) int 为dcl返回状态码 大于2<br /> 2 定义控件间关联动作时<br />   a 单按钮 what 为 字符型回调函数名 _$klst 为控件名<br />   b 多按钮 what 为 回调函数表<br /> 单键定义<br /> (xd::dcl:buttonaction "k1" "callback") 控件间关联<br /> (xd::dcl:buttonaction "k1" '(0 "callback"))结束对话框式回调<br /> 批量定义<br /> (xd::dcl:buttonaction '("k1" "k2" ...) '("callbakc1" (2 "callback2") ...))<br /> |;<br /> (defun XD::Dcl:ButtonAction (_$klst what / _sButtonAction)<br />   (defun _sButtonAction        (_$key _$callback)<br />     (cond<br />       ((= (type _$callback) 'INT)<br />        (action_tile<br />          _$key<br />          (strcat "(done_dialog " (itoa _$callback) ")")<br />        )<br />       )<br />       ((= (type _$callback) 'STR)<br />        (action_tile _$key (strcat "(" _$callback ")"))<br />       )<br />       (t)<br />     )<br />   )<br />   (if (listp _$klst)<br />     (while _$klst<br />       (_sButtonAction (car _$klst) (car what))<br />       (setq _$klst (cdr _$klst)<br />             what   (cdr what)<br />       )<br />     )<br />     (_sButtonAction _$klst _$callback)<br />   )<br /> )<br />

Free-Lancer

更新, 批量定义支持回调函数

Free-Lancer

更新，按钮总是要执行某些动作，对单个按钮，点下就执行，一个测试代码片断，尚未作出更多关联

1. (defun c:tt (/                   _k2_callback         _k4_callback  _k5_callback
   
2.              _k6_callback  strl                 fn               id
   
3.             )
   
4.   (defun _k4_callback ()
   
5.     (xd::dcl:seterror "hello")
   
6.   )
   
7. 
   
8.   (setq        strl          '("temp:dialog {"
   
9.                     "label = \"Button test\";"
   
10.                     "  :boxed_row {"
    
11.                     "    label = \"Input\";"
    
12.                     "    :edit_box { label = \"Num1\"; key = \"k1\";}"
    
13.                     "    :edit_box { label = \"Dist\"; key = \"k2\";}"
    
14.                     "    :edit_box { label = \"Totle\"; key = \"k3\";}"
    
15.                     "  }"
    
16.                     "  :boxed_row{"
    
17.                     "    label = \"button option\";"
    
18.                     "    :button { label = \"calc\"; key = \"k4\";}"
    
19.                     "    :button { label = \"Pick\"; key = \"k5\";}"
    
20.                     "    :button { label = \"select\"; key = \"k6\";}"
    
21.                     "  }"
    
22.                     "  ok_cancel;"
    
23.                     "  errtile;"
    
24.                     "}"
    
25.                    )
    
26.         fn          (xd::dcl:make strl)
    
27.         id          (xd::dcl:load fn "temp");_加载
    
28.         what_next 2
    
29.   )
    
30.   (while (>= what_next 2)   
    
31.     (XD::Dcl:ButtonAction
    
32.       '("k4" "k2" "k5" "k6" "k1" "k3")
    
33.       '("_k4_callback")
    
34.     )
    
35.     (xd::dcl:accept);_加载后先设置默认、定义动作
    
36.     (setq what_next (xd::dcl:show));_设置完成后显示对话框，控制权交DCL
    
37.   )
    
38.   (xd::dcl:unload id fn)
    
39.   (princ)
    
40. )

(defun c:tt (/                   _k2_callback         _k4_callback  _k5_callback<br />              _k6_callback  strl                 fn               id<br />             )<br />   (defun _k4_callback ()<br />     (xd::dcl:seterror "hello")<br />   )<br /> <br />   (setq        strl          '("temp:dialog {"<br />                     "label = \"Button test\";"<br />                     "  :boxed_row {"<br />                     "    label = \"Input\";"<br />                     "    :edit_box { label = \"Num1\"; key = \"k1\";}"<br />                     "    :edit_box { label = \"Dist\"; key = \"k2\";}"<br />                     "    :edit_box { label = \"Totle\"; key = \"k3\";}"<br />                     "  }"<br />                     "  :boxed_row{"<br />                     "    label = \"button option\";"<br />                     "    :button { label = \"calc\"; key = \"k4\";}"<br />                     "    :button { label = \"Pick\"; key = \"k5\";}"<br />                     "    :button { label = \"select\"; key = \"k6\";}"<br />                     "  }"<br />                     "  ok_cancel;"<br />                     "  errtile;"<br />                     "}"<br />                    )<br />         fn          (xd::dcl:make strl)<br />         id          (xd::dcl:load fn "temp");_加载<br />         what_next 2<br />   )<br />   (while (>= what_next 2)    <br />     (XD::Dcl:ButtonAction<br />       '("k4" "k2" "k5" "k6" "k1" "k3")<br />       '("_k4_callback")<br />     )<br />     (xd::dcl:accept);_加载后先设置默认、定义动作<br />     (setq what_next (xd::dcl:show));_设置完成后显示对话框，控制权交DCL<br />   )<br />   (xd::dcl:unload id fn)<br />   (princ)<br /> )

Free-Lancer

2014.10.10 更新

炫翔

发现个笔误;，修正如下:
最后面: (_sButtonAction _$klst_$callback)  应为:what

1. (defun XD::Dcl:ButtonAction (_$klst what / _sButtonAction)
   
2.   (defun _sButtonAction        (_$key _$callback)
   
3.     (cond
   
4.       ((= (type _$callback) 'INT)
   
5.        (action_tile
   
6.          _$key
   
7.          (strcat "(done_dialog " (itoa _$callback) ")")
   
8.        )
   
9.       )
   
10.       ((= (type _$callback) 'STR)
    
11.        (action_tile _$key (strcat "(" _$callback ")"))
    
12.       )
    
13.       (t)
    
14.     )
    
15.   )
    
16.   (if (listp _$klst)
    
17.     (while _$klst
    
18.       (_sButtonAction (car _$klst) (car what))
    
19.       (setq _$klst (cdr _$klst)
    
20.             what   (cdr what)
    
21.       )
    
22.     )
    
23.     (_sButtonAction _$klst what)
    
24.   )
    
25. )
    

(defun XD::Dcl:ButtonAction (_$klst what / _sButtonAction)<br />   (defun _sButtonAction        (_$key _$callback)<br />     (cond<br />       ((= (type _$callback) 'INT)<br />        (action_tile<br />          _$key<br />          (strcat "(done_dialog " (itoa _$callback) ")")<br />        )<br />       )<br />       ((= (type _$callback) 'STR)<br />        (action_tile _$key (strcat "(" _$callback ")"))<br />       )<br />       (t)<br />     )<br />   )<br />   (if (listp _$klst)<br />     (while _$klst<br />       (_sButtonAction (car _$klst) (car what))<br />       (setq _$klst (cdr _$klst)<br />             what   (cdr what)<br />       )<br />     )<br />     (_sButtonAction _$klst what)<br />   )<br /> )<br />

wrsxed

1 与图形交互时, what 为表 '(int callback) int 为dcl返回状态码 大于2
而函数_sButtonAction        (_$key _$callback)中执行（T）
好像没有反应