[教学]：如何在DCL对话框中显示幻灯片

XDSoft

下面的代码演示了在DCL对话框中显示4种点模式，并且按照选择的幻灯片来设置当前的PDMODE系统变量。

在运行这个程序之前，要在当前图形中画些点作为测试。

2. 
   
3. (defun C:SetPDMode (/ dcl_handle pickedtile)
   
4. 
   
5.   (setq img_dcl (findfile "SetPDMode.dcl"))
   
6.   (if (null img_dcl )
   
7.      (progn
   
8.         (princ "\nExiting, DCL File: SetPDMode.DCL was NOT found !")
   
9.         (exit)
   
10.      )
    
11.   )
    
12. 
    
13.   (setq rga (getvar "REGENMODE"))
    
14.   (setvar "REGENMODE" 0)
    
15. 
    
16.   (if img_dcl
    
17.     (progn
    
18.       (setq ai_pts_lst '("2" "3" "4" "32") )
    
19. 
    
20.       (setq dcl_handle (load_dialog img_dcl))
    
21. 
    
22.       (if lastpt
    
23.           (if (not (new_dialog "imagebut" dcl_handle "3" lastpt)) (exit) )
    
24.           (if (not (new_dialog "imagebut" dcl_handle "3" '(-1 -1))) (exit) )
    
25.       )
    
26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
27. 
    
28.       (setq pt0 "3")
    
29.       (foreach pt0 ai_pts_lst
    
30.           (setq pt1 (strcat "pdmode" pt0))
    
31.           (setq pt2 (getvar "PDMODE"))
    
32. 
    
33.           (setq sx (dimx_tile pt1))
    
34.           (setq sy (dimy_tile pt1))
    
35. 
    
36.           (start_image pt1)
    
37.           (slide_image
    
38.                0 0
    
39.                (- sx 1) (- sy 1)
    
40.                 pt1
    
41.           )
    
42.           (end_image)
    
43.       );; foreach
    
44. 
    
45. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
46.       (action_tile "pdmode2" "(progn (setq pickedtile $key) (alert (strcat
    
47. "\nSelected Slide is: " pickedtile)))")
    
48.       (action_tile "pdmode3" "(progn (setq pickedtile $key) (alert (strcat
    
49. "\nSelected Slide is: " pickedtile)))")
    
50.       (action_tile "pdmode4" "(progn (setq pickedtile $key) (alert (strcat
    
51. "\nSelected Slide is: " pickedtile)))")
    
52.       (action_tile "pdmode32" "(progn (setq pickedtile $key) (alert (strcat
    
53. "\nSelected Slide is: " pickedtile)))")
    
54.       
    
55.       (action_tile "cancel" "(done_dialog) (setq gperr "")(exit)")
    
56. 
    
57.       (action_tile "accept" "(setq lastpt (done_dialog)))")
    
58.       (action_tile "help" "(progn (setq pickedtile -1) (done_dialog 3))" )
    
59.       
    
60.       (setq SelectedSlide 0 pickedtile nil)
    
61.       (start_dialog)
    
62.       (unload_dialog dcl_handle)
    
63. 
    
64.       (if pickedtile
    
65.           (progn
    
66.             (princ "\nThe Selected Tile was ")
    
67.             (princ pickedtile)
    
68.             (princ "\n")
    
69.             (cond
    
70.               ((equal pickedtile "pdmode2")
    
71.                (setvar "PDMODE" 2)
    
72.               )
    
73.               ((equal pickedtile "pdmode3")
    
74.                (setvar "PDMODE" 3)
    
75.               )
    
76.               ((equal pickedtile "pdmode4")
    
77.                (setvar "PDMODE" 4)
    
78.               )
    
79.               ((equal pickedtile "pdmode32")
    
80.                (setvar "PDMODE" 32)
    
81.               )
    
82.             )
    
83.           )
    
84.       )
    
85. 
    
86.       (if (= pickedtile -1)
    
87.             (alert "Help Selected.")
    
88.       )
    
89.       
    
90.       (if lastpt
    
91.          (progn (princ "\nDialogue Box Location: is ") (princ (car lastpt))
    
92. (princ ", ") (princ (cadr lastpt)) )
    
93.       )
    
94. 
    
95. ));;; IF DCL File
    
96. (setvar "REGENMODE" rga)
    
97. 
    
98. (princ)
    
99. )
    
100. (princ "\nSetPDMode Loaded, type (C:SetPDMode) or SetPDMode to run.")
     
101. (princ)
     
102. 
     
103. 
     
104. //
     
105. // 显示幻灯片的DCL文件.
     
106. //
     
107. imagebut: dialog {
     
108. label        = "Set PDMode";
     
109. : column {
     
110.    : row {
     
111.           spacer_1;
     
112.           }
     
113.    : row {
     
114.      : image_button {
     
115.         key             = "pdmode2";
     
116.         width             = 7;
     
117.         height             = 3;
     
118.         aspect_ratio = 1.0;
     
119.         color             = 0;
     
120.         allow_accept = true;
     
121.         value             = 2;
     
122.      }
     
123.      : image_button {
     
124.         key             = "pdmode3";
     
125.         width             = 7;
     
126.         height             = 3;
     
127.         aspect_ratio = 1.0;
     
128.         color             = 0;
     
129.         allow_accept = true;
     
130.         value             = 3;
     
131.      }
     
132.      : image_button {
     
133.         key             = "pdmode4";
     
134.         width             = 7;
     
135.         height             = 3;
     
136.         aspect_ratio = 1.0;
     
137.         color             = 0;
     
138.         allow_accept = true;
     
139.         value             = 4;
     
140.      }
     
141.      : image_button {
     
142.         key             = "pdmode32";
     
143.         width             = 7;
     
144.         height             = 3;
     
145.         aspect_ratio = 1.0;
     
146.         color             = 0;
     
147.         allow_accept = true;
     
148.         value             = 32;
     
149.     }
     
150.      }
     
151.    : row {
     
152.           spacer_1;
     
153.           }
     
154.    : row {
     
155. ok_cancel;
     
156.           }
     
157.    
     
158.    }
     
159. }
     
160. 
     

<br /> (defun C:SetPDMode (/ dcl_handle pickedtile)<br /> <br />   (setq img_dcl (findfile "SetPDMode.dcl"))<br />   (if (null img_dcl )<br />      (progn <br />         (princ "\nExiting, DCL File: SetPDMode.DCL was NOT found !")<br />         (exit)<br />      )<br />   )<br /> <br />   (setq rga (getvar "REGENMODE"))<br />   (setvar "REGENMODE" 0)<br /> <br />   (if img_dcl<br />     (progn <br />       (setq ai_pts_lst '("2" "3" "4" "32") ) <br /> <br />       (setq dcl_handle (load_dialog img_dcl))<br /> <br />       (if lastpt<br />           (if (not (new_dialog "imagebut" dcl_handle "3" lastpt)) (exit) )<br />           (if (not (new_dialog "imagebut" dcl_handle "3" '(-1 -1))) (exit) )<br />       )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> <br />       (setq pt0 "3")<br />       (foreach pt0 ai_pts_lst<br />           (setq pt1 (strcat "pdmode" pt0))<br />           (setq pt2 (getvar "PDMODE"))<br /> <br />           (setq sx (dimx_tile pt1))<br />           (setq sy (dimy_tile pt1))<br /> <br />           (start_image pt1)<br />           (slide_image <br />                0 0<br />                (- sx 1) (- sy 1) <br />                 pt1<br />           )<br />           (end_image)<br />       );; foreach<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br />       (action_tile "pdmode2" "(progn (setq pickedtile $key) (alert (strcat<br /> "\nSelected Slide is: " pickedtile)))")<br />       (action_tile "pdmode3" "(progn (setq pickedtile $key) (alert (strcat<br /> "\nSelected Slide is: " pickedtile)))")<br />       (action_tile "pdmode4" "(progn (setq pickedtile $key) (alert (strcat<br /> "\nSelected Slide is: " pickedtile)))")<br />       (action_tile "pdmode32" "(progn (setq pickedtile $key) (alert (strcat<br /> "\nSelected Slide is: " pickedtile)))")<br />       <br />       (action_tile "cancel" "(done_dialog) (setq gperr "")(exit)")<br /> <br />       (action_tile "accept" "(setq lastpt (done_dialog)))")<br />       (action_tile "help" "(progn (setq pickedtile -1) (done_dialog 3))" )<br />       <br />       (setq SelectedSlide 0 pickedtile nil)<br />       (start_dialog)<br />       (unload_dialog dcl_handle)<br /> <br />       (if pickedtile<br />           (progn<br />             (princ "\nThe Selected Tile was ")<br />             (princ pickedtile)<br />             (princ "\n")<br />             (cond<br />               ((equal pickedtile "pdmode2")<br />                (setvar "PDMODE" 2)<br />               )<br />               ((equal pickedtile "pdmode3")<br />                (setvar "PDMODE" 3)<br />               )<br />               ((equal pickedtile "pdmode4")<br />                (setvar "PDMODE" 4)<br />               )<br />               ((equal pickedtile "pdmode32")<br />                (setvar "PDMODE" 32)<br />               )<br />             )<br />           )<br />       )<br /> <br />       (if (= pickedtile -1)<br />             (alert "Help Selected.")<br />       )<br />       <br />       (if lastpt<br />          (progn (princ "\nDialogue Box Location: is ") (princ (car lastpt))<br /> (princ ", ") (princ (cadr lastpt)) )<br />       )<br /> <br /> ));;; IF DCL File<br /> (setvar "REGENMODE" rga)<br /> <br /> (princ)<br /> )<br /> (princ "\nSetPDMode Loaded, type (C:SetPDMode) or SetPDMode to run.")<br /> (princ)<br /> <br /> <br /> //<br /> // 显示幻灯片的DCL文件.<br /> //<br /> imagebut: dialog {<br /> label        = "Set PDMode";<br /> : column {<br />    : row {<br />           spacer_1;<br />           }<br />    : row {<br />      : image_button {<br />         key             = "pdmode2";<br />         width             = 7;<br />         height             = 3;<br />         aspect_ratio = 1.0;<br />         color             = 0;<br />         allow_accept = true;<br />         value             = 2;<br />      }<br />      : image_button {<br />         key             = "pdmode3";<br />         width             = 7;<br />         height             = 3;<br />         aspect_ratio = 1.0;<br />         color             = 0;<br />         allow_accept = true;<br />         value             = 3;<br />      }<br />      : image_button {<br />         key             = "pdmode4";<br />         width             = 7;<br />         height             = 3;<br />         aspect_ratio = 1.0;<br />         color             = 0;<br />         allow_accept = true;<br />         value             = 4;<br />      }<br />      : image_button {<br />         key             = "pdmode32";<br />         width             = 7;<br />         height             = 3;<br />         aspect_ratio = 1.0;<br />         color             = 0;<br />         allow_accept = true;<br />         value             = 32;<br />     }<br />      }<br />    : row {<br />           spacer_1;<br />           }<br />    : row {<br /> ok_cancel;<br />           }<br />    <br />    }<br /> }<br /> <br />