Module Dfdafmac.pkg
1//************************************************************************
2//
3// Confidential Trade Secret.
4// Copyright (c) 1993 2E Software, La Mesa California,
5// as an unpublished work. All rights reserved.
6// Portions copyright (c) 1997 Data Access Corporation, Miami Florida
7// DataFlex is a registered trademark of Data Access Corporation.
8//
9//************************************************************************/
10
11//************************************************************************
12// DFDafMac.Pkg
13// Version: 1.0
14// Copyright (c) 1993 2E Software
15// 08/24/94 : Created
16//
17// Author: John J. Tuohy
18//
19//08/24/94 - Special commands for windows stuff
20//************************************************************************
21// 3.1 Chagnes
22// 03/28/95 JJT - Removed USE of 0 package.
23// 02/12/96 JJT - 1) Changes to support new modal_state.
24// 2) Objects are deferred (not destroyed unless the
25// destroy_object_state is set.)
26//************************************************************************
27// 04/28/96 JJT Modifed to send Activate_view (new mdi dialog message)
28// 04/29/96 JJT Removed DFScreen_Size. Now use GUIScreen_Size
29// 10/15/97 JJT removed "use pkg2e0" and added pieces from that package. Added
30// cd_end_object so cd_Suff is no longer needed
31//************************************************************************
32
33
34
35// This activate view command will get found before the command of the
36// same name from DAF character base. It works the way the windows daf
37// must work.
38Use Windows.pkg
39use dfcursor.pkg
40
41// These commands get found first and will override the commands
42// of the same name in cd-stuff. With WINDAF we expect views to be
43// placed inside of a main_panel object.
44//
45#COMMAND ACTIVATE_VIEW R "AS""FOR" R
46 Register_Object !3
47
48 // created so you can use Activate_view and Deferred_view with a
49 // single syntax.
50 Function !1_Handle Returns Handle
51 Function_Return (!3(Self))
52 End_Procedure
53
54 Procedure !1
55 Send Activate_View to (!3(Self))
56 End_Procedure
57
58#ENDCOMMAND
59
60//#COMMAND ACTIVATE_VIEW R "AS""FOR" R
61// Register_Object !3
62// Procedure !1
63// Send Activate_View to (!3(Self))
64// End_Procedure
65//#ENDCOMMAND
66
67// This expects to create a view INSIDE of another object
68// (Like a panel)
69//
70#COMMAND Deferred_View R "AS""FOR" "OBJECT""DFOBJECT"
71 Property Integer !1_obj 0 //track Id of view object
72
73 // used to return the handle to the actual view creating it as needed
74 Function !1_Handle Returns Handle
75 Handle hoView
76 Get !1_Obj to hoView // Id of the view
77 If (hoView=0) Begin // if not created, create it
78 Send Cursor_wait to (cursor_control(Self))
79 Gosub Create_!1
80 Get !1_Obj to hoView // this time it better be there!
81 Send Cursor_ready to (cursor_control(Self))
82 End
83 Function_Return hoView
84 End_Procedure
85
86 Procedure !1
87 Handle hoView
88 Get !1_Handle to hoView
89 Send Activate_View to hoView
90 End_Procedure
91
92 [Found ~Found] Begin
93 Create_!1:
94 Object !4 !5 !6 !7 !8 !9
95 Set !1_obj to Self
96#ENDCOMMAND
97
98
99//#COMMAND Deferred_View R "AS""FOR" "OBJECT""DFOBJECT"
100// Property Integer !1_obj 0 //track Id of view object
101//
102// Procedure !1
103// Integer obj#
104// Get !1_Obj to Obj# // Id of the view
105// If Obj# eq 0 Begin // if not created, create it
106// Send Cursor_wait to (cursor_control(Self))
107// Gosub Create_!1
108// Get !1_Obj to Obj# // this time it better be there!
109// Send Cursor_ready to (cursor_control(Self))
110// End
111// Send Activate_View to Obj#
112// End_Procedure
113//
114// [Found ~Found] Begin
115// Create_!1:
116// Object !4 !5 !6 !7 !8 !9
117// Set !1_obj to Self
118//#ENDCOMMAND
119
120define DEFERRED_OBJECT for DEFERRED_VIEW
121
122{ Visibility=Private }
123Class CD_Client is a Container
124
125 Procedure Construct_Object
126 Forward Send Construct_Object
127
128 { Visibility=Private }
129 Property Integer Created_object_id 0
130
131 Set focus_mode to nonfocusable
132 End_Procedure // Construct_Object
133
134 { Visibility=Private }
135 Procedure Popup
136 Send Popup_Modal
137 End_Procedure // Popup
138
139 Register_Function Destroy_Object_State Returns Integer
140
141// { Visibility=Private }
142// Procedure Popup_Modal returns integer
143// integer rval Id
144// Get Created_Object_Id to Id
145// If Id Begin
146// Get msg_Popup_Modal of Id to rval
147// If (Destroy_Object_State(Id)) Begin
148// Send Destroy of Id
149// Set Created_Object_Id to 0
150// End
151// Function_Return Rval
152// End
153// End_Procedure
154
155 // is augmented by object instance. Should never
156 // be called.
157 { Visibility=Private }
158 Function Popup_Handle Returns Handle
159 Error DFERR_PROGRAM "Improper use of CD_Popup_Object command"
160 End_Function
161
162 { Visibility=Private }
163 Procedure Popup_Modal Returns Integer
164 Integer iRet
165 Handle hoId
166 Boolean bDestroy
167 Get Popup_Handle to hoId
168 If hoId Begin
169 Get msg_Popup_Modal of hoId to iRet
170 Get Destroy_Object_State of hoId to bDestroy
171 If bDestroy Begin
172 Send Destroy of hoId
173 Set Created_Object_Id to 0
174 End
175 Procedure_Return iRet
176 End
177 End_Procedure
178
179End_Class
180
181#COMMAND Cd_Popup_Object R
182 #PUSH !g
183
184 Register_Object !1_cd
185
186 Object !1 is a CD_Client
187
188 Function Popup_Handle Returns Handle
189 Handle hoID
190 Get Created_Object_Id to hoId
191 If (hoId=0) Begin
192 #SET G$ !a
193 Gosub !1_Sub!g
194 Move (!1_cd(Self)) to hoId
195 Set Created_Object_id to hoID
196 End
197 Function_Return hoID
198 End_Function
199
200 End_Object
201
202
203 [Found ~Found] Begin
204 !1_Sub!g:
205 // we want to pop G$ but the Begin has pushed R$ on to the stack. Therefore we must pop
206 // R$, then G$ and put R$ back up there
207 #POP R$
208 #POP G$
209 #PUSH !r
210 Object !1_cd !2 !3 !4 !5 !6 !7 !8 !9
211
212#ENDCOMMAND
213
214//#COMMAND CD_POPUP_OBJECT R
215// Object !1 is a CD_Client
216//
217// Procedure Popup_Modal Returns integer
218// integer rval Id
219// Get Created_Object_Id to Id
220// If Id eq 0 Begin
221// Register_Object !1_Cd
222// Gosub !1_Sub
223// Set Created_Object_id to (!1_Cd(Self))
224// End
225// Forward Get msg_Popup_Modal rVal to rVal
226// Procedure_Return Rval
227// End_Procedure
228//
229// End_Object
230//
231// [Found ~Found] Begin
232// !1_Sub:
233// Object !1_cd !2 !3 !4 !5 !6 !7 !8 !9
234//#ENDCOMMAND
235
236#COMMAND CD_END_OBJECT .
237 End_Object
238#IFDEF Is$New$FMAC
239 Gosub_Return // new fmac prefers Gosub_return when return is within a method
240#ELSE
241 Return // old style return
242#ENDIF
243 End
244#ENDCOMMAND
245
246use dafmac.pkg
247
248define Define_Symbol for Define
249
250