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