Module cBasicReport.pkg
1//************************************************************************
2//
3// $File name : cBasicReport.pkg
4// $File title : cBasicReport support for VDF
5// Notice :
6// $Author(s) : John Tuohy
7//
8// Confidential Trade Secret.
9// Copyright 1987-1999 Data Access Corporation, Miami FL, USA
10// All Rights reserved
11// DataFlex is a registered trademark of Data Access Corporation.
12//
13// $Rev History
14//
15// MG 10/2/98 Changed error_report with additional parameter
16// JT 9/22/97 Added status_params property and support.
17// printer modes moved to their own file
18// JT 7/22/97 Added Status log support (similar to BatchDD). Modified
19// error handling(added display_error_state and onError)
20// JT 6/09/97 Added Allow_Cancel_State for status panel
21// JT ??/??/?? File created for VDF 4.0
22//************************************************************************
23//
24// Creates Character Mode RO class for windows: BasicReport
25//
26Use Windows.pkg
27Use cReportDS.pkg
28
29#IFNDEF IS$WebApp
30Use StatPnl.pkg // creates object Status_Panel... only if non webapp
31#ENDIF
32
33Use MsgBox.pkg
34Use PtrModes.pkg // Define Print_to_xxxx modes
35
36Integer System_default_pageend
37Integer System_default_pagefeed
38
39Move PageEnd to System_Default_PageEnd
40Move PageFeed to System_Default_PageFeed
41
42register_procedure Update_StatusPanel
43register_procedure Initialize_StatusPanel
44register_procedure Start_StatusPanel
45register_procedure Stop_StatusPanel
46register_function Check_StatusPanel returns integer
47
48{ ClassLibrary=WebApp ClassType=Abstract }
49{ HelpTopic=cBasicReport }
50Class cBasicReport is a cReportDS
51
52 Procedure Construct_Object
53 Forward Send Construct_Object
54 { Visibility=Private }
55 Property String Private.Output_Device ""
56
57 // set this false if you do not want a status panel popping up
58 { Category=Behavior }
59 { PropertyType=Boolean }
60 Property Integer Status_Panel_State True
61 { Category=Behavior }
62 { PropertyType=Boolean }
63 Property Integer Allow_Cancel_State True
64
65 { Visibility=Private }
66 Property String Status_params ""
67
68 { Category=Report }
69 Property String Report_Caption C_$PrintingReport
70 { Category=Report }
71 Property String Report_Title ""
72 { Category=Report }
73 Property String Report_Message ""
74 { Category=Report }
75 Property Integer Report_Status_Panel 0
76
77 #IFDEF IS$WebApp
78 // if web app, we really don't want a status panel
79 // even if you turn status_panel_state on, the status_panel_id object will be set
80 // to 0, so it will not talk to it.
81 Set Status_Panel_State to False
82 #ELSE
83 // if not web app, we want a normal status_panel object
84 Set Status_Panel_Id to (Status_Panel(Self))
85 #ENDIF
86 { Visibility=Private }
87 Property Integer Report_View_Id 0
88
89 // Error related properties
90
91 // if set true, errors will be forwarded to the normal
92 // VDF error handler causing an error message to popup. We will
93 // leave this true for backwards compatibility.
94 { PropertyType=Boolean }
95 Property Integer Display_Error_State True
96
97 { Visibility=Private }
98 Property Integer Old_Error_Object_Id 0
99
100 { Visibility=Private }
101 Property integer Error_Processing_State False // internal use
102
103 { Visibility=Private }
104 Property Integer Error_Check_State False // internal
105
106 // Logging
107 { PropertyType=Boolean }
108 Property Integer Status_Log_State False
109 // If you are going to log information you must create a
110 // status log object and set this property to its ID. See
111 // Statlog.pkg for more information.
112 Property Integer Status_Log_Id 0
113
114 End_Procedure
115
116 { Visibility=Private MethodType=Property }
117 Function Output_Device_Name Returns String
118 Integer Id
119 String DevName
120 Get Report_View_Id to Id
121 If ID ;
122 Get OutPut_Device_Name of ID to DevName
123 Function_Return DevName
124 End_Function
125
126 { MethodType=Property }
127 Function Output_Device Returns String
128 String DevName
129 Get Private.OutPut_Device to DevName
130 If DevName eq '' Begin
131 Get OutPut_Device_Name to DevName
132 If DevName eq '' ;
133 Move "WINLST:" to DevName
134 End
135 Function_Return DevName
136 End_Function // Output_Device
137
138 { MethodType=Property }
139 { Category=Report }
140 Procedure Set Output_Device string Devname
141 Set Private.Output_Device to Devname
142 End_Procedure // Set Output_Device
143
144 Procedure Update_Status string Val
145 Integer StatPnl
146 Get Report_Status_Panel to StatPnl
147 If StatPnl ;
148 Send Update_StatusPanel to StatPnl Val
149 End_Procedure
150
151 { Visibility=Private }
152 Procedure Start_Status
153 Integer StatPnl
154 If (Status_Panel_State(self)) Begin
155 Get Report_Status_Panel to StatPnl
156 If StatPnl Begin
157 Send Initialize_StatusPanel to StatPnl ;
158 (Report_Caption(self)) ;
159 (Report_Title(self)) ;
160 (Report_Message(self)) ;
161 (Status_Params(self))
162 Set Allow_Cancel_State of StatPnl to (Allow_Cancel_State(self))
163 Send Start_StatusPanel to StatPnl
164 End
165 End
166 End_Procedure
167
168 { Visibility=Private }
169 Procedure Resume_Status
170 Integer StatPnl
171 Get Report_Status_Panel to StatPnl
172 If StatPnl ;
173 Send Start_StatusPanel to StatPnl
174 End_Procedure
175
176 { Visibility=Private }
177 Procedure End_Status
178 Integer StatPnl
179 Get Report_Status_Panel to StatPnl
180 If StatPnl ;
181 Send Stop_StatusPanel to StatPnl
182 End_Procedure
183
184 //------------------------------------------------------------------------
185 // Status Logging related Messages
186 // Send Start_log
187 // Send End_Log
188 // Send Error_Log_Status Error_Info Error_Mess
189 // Send Log_Status StatusString
190 //------------------------------------------------------------------------
191
192 Procedure Start_Log
193 Send Log_Status (C_$BeginReport + ":" * Report_Title(self))
194 End_Procedure
195
196 Procedure End_Log
197 Send Log_Status (C_$EndReport + ":" * Report_Title(self))
198 End_Procedure
199
200 Procedure Error_Log_Status integer ErrNum integer Err_Line string ErrMsg
201 Send Log_Status (SFormat(C_$ErrorNum, ErrNum, ErrMsg))
202 End_Procedure
203
204 Procedure Log_Status String Mess
205 integer StatId
206 Get Status_Log_Id to StatId
207 If StatId ;
208 Send Log_Status to StatId Mess
209 End_Procedure
210
211
212 { Visibility=Private }
213 Procedure Initialize_Output_Device
214 Set Page_End to System_default_pageend
215 Set Page_Feed to System_default_pageFeed
216 Direct_Output (Output_Device(self))
217 End_procedure
218
219 { Visibility=Private }
220 Procedure Close_Output_Device
221 Close_Output
222 End_Procedure
223
224 { MethodType=Event }
225 Function OnStartingMainReport Returns Integer
226 Integer RetVal
227 //Forward Get OnStartingMainReport to RetVal
228 //If RetVal ne 0 Function_Return RetVal
229 Send Initialize_Output_Device
230 Send Start_Status
231 Set Old_Error_Object_Id to Error_Object_id
232 Move self to Error_Object_id
233 If (Status_Log_State(self)) ;
234 Send Start_Log
235 End_Function
236
237 { Visibility=Private }
238 Procedure Update_Status_Page
239 If (Page_End(self)) EQ 0 ;
240 Send Update_Status (C_$Record + ":" * String(Page_Count(self)))
241 Else Send Update_Status (C_$Page + ":" * String(Page_Count(self)))
242 End_Procedure
243
244 { MethodType=Event }
245 Procedure OnEndingMainReport // close down the report
246 If (Status_Log_State(self)) ;
247 Send End_Log
248 Send End_Status
249 Send Close_Output_Device
250 Get Old_Error_Object_Id to Error_Object_id // restore previous error object
251 Set Old_Error_Object_Id to 0
252 End_Procedure
253
254 { MethodType=Event }
255 Function Report_Interrupt Returns Integer
256 integer rVal
257 String Mess
258 If (Error_Check_State(self)) ;
259 Move C_$AnErrorWishToCancel to Mess
260 Else ;
261 Move C_$CancelThisReport to Mess
262 Get YesNo_Box Mess C_$ReportInterrupt to rVal
263 Function_Return (Rval=MBR_YES)
264 End_Function
265
266 // check for report interrupt handler
267 // Return True to stop report, false to continue
268 //
269 { Visibility=Private }
270 Function Test_KeyPressed Returns Integer
271 Integer StatPnl StopIt
272 Get Report_Status_Panel to StatPnl
273 If ( Error_Check_State(self) OR ;
274 ( Status_Panel_State(self) AND ;
275 StatPnl AND Check_StatusPanel(StatPnl))) Begin
276 Send End_Status
277 Get Report_Interrupt to StopIt
278 If Not StopIt ;
279 Send Resume_Status
280 Set Error_Check_State to False
281 End
282 Function_Return StopIt
283 End_Function
284
285 { Visibility=Private }
286 Procedure Calling_All_Reports Integer Obj Integer Msg
287 Integer Cur_Obj
288 Move self to Cur_Obj
289 Send Msg to Obj Cur_Obj
290 End_Procedure
291
292 { Visibility=Private }
293 Procedure Initialize_All_Reports Integer Obj Integer Msg
294 Set Report_View_Id to Obj
295 Send Calling_all_reports Obj Msg
296 End_Procedure
297
298 // All errors are directed to the main report. By Default we
299 // shut off the status panel, report the error and notify the interrupt
300 // mechanism to ask if the report should be canceled. VERY IMPORTANT!
301 // If you augment this and you plan on doing ANY windows IO you should
302 // first shut of the status panel.
303 //
304 { MethodType=Event }
305 Procedure Error_Report integer ErrNum integer Err_Line string ErrMsg
306 integer id
307 If (Error_Processing_State(self)=False) Begin
308 Set Error_Processing_State to True // prevents recursion
309 Set Error_Check_State to TRUE
310 If (Status_Log_State(self)) ;
311 Send Error_Log_Status ErrNum Err_Line ErrMsg
312 If (Display_Error_State(self)) Begin
313 Get Old_Error_Object_Id to ID
314 Send End_Status // YOU MUST DO THIS!!!!
315 If ID ;
316 Send Error_Report to Id ErrNum Err_Line ErrMsg
317 Else ;
318 send Error_Report of desktop ErrNum Err_Line ErrMsg
319 //Forward send Error_Report ErrNum Err_Line ErrMsg
320 End
321 Send onError ErrNum Err_Line ErrMsg
322 Set Error_Processing_State to False
323 End
324 End_procedure
325
326 // Event called by Error_Report. For augmentation.
327 // If you are planning on doing any interactive IO and you are
328 // using the status panel you must first remove the panel
329 // (send End_Status).
330 //
331 { MethodType=Event }
332 Procedure OnError integer ErrNum integer Err_Line string ErrMsg
333 End_procedure
334
335End_Class
336