1//****************************************************************************//
2// //
3// $File name : cWebReport.PKG //
4// $File title : cWebreport class //
5// $Author : John Tuohy //
6// //
7// Confidential Trade Secret. //
8// Copyright 1998-1999 Data Access Corporation, Miami FL, USA //
9// All Rights reserved //
10// DataFlex is a registered trademark of Data Access Corporation. //
11// //
12// //
13// $Rev History //
14// 8/12/98 jjt - created //
15// //
16//****************************************************************************//
17
18
19//
20// Report_DS
21// BasicReport
22// cHTMLReport - generic html output report
23// cWebReport - special for vdf Web Server
24//
25
26Use cHtmlReport.pkg // HTML report
27
28{ ClassLibrary=WebApp }
29{ HelpTopic=cWebReport }
30Class cWebReport is a cHtmlReport
31
32 Procedure construct_object
33 forward send construct_object
34
35 { Category=Report }
36 Property String psHRefName ""
37 { Category=Report }
38 Property Integer piMaxCount 0
39 { DesignTime=False }
40 property RowId priStartRowId
41 { DesignTime=False }
42 property RowId priLastRowId
43 { Obsolete=True }
44 { DesignTime=False }
45 Property Integer piStartRecord
46 { Obsolete=True }
47 { DesignTime=False }
48 Property Integer piLastRecord
49 { Visibility=Private }
50 property integer piFoundCount
51 { Visibility=Private }
52 property integer pbPartialReport
53 { Category=Report }
54 property integer piMaxCountBreakLevel
55
56 Set Status_Panel_State to False // never want status panel
57 Set Server to (Main_dd(self))
58 End_Procedure
59
60 { Visibility=Private }
61 Procedure Close_Output_Device
62 integer hObj
63 Get phOutputDevice to hObj
64 If not hObj ;
65 Forward Send Close_Output_Device
66 End_Procedure
67
68 { Visibility=Private }
69 Procedure Initialize_Output_Device
70 integer hObj
71 Set phOutputDevice to ghInetSession // output to here
72 Get phOutputDevice to hObj
73 If not hObj ;
74 Forward Send Initialize_Output_Device
75 End_procedure
76
77 { Visibility=Private }
78 Procedure Output String WrStr
79 integer hObj
80 Get phOutputDevice to hObj
81 If hObj ;
82 Send OutputHtml to hObj WrStr
83 else ;
84 Forward Send Output WrStr
85 End_Procedure
86
87 { Obsolete=True }
88 Function AddRecordLink string sValue Returns String
89 string sRefName sUrl sRec sSep
90 Get psHRefName to sRefName
91 If (sRefName<>"") Begin
92 Move (If(pos("?",sRefName),"&","?")) to sSep
93 Get Current_record of (server(self)) to sRec
94 Move (sRefName-sSep-"RecId="-sRec ) to sUrl
95 Get HtmlLink sUrl sValue to sValue
96 end
97 //
98 Function_Return sValue
99 End_Function
100
101 Function AddRowIdLink string sValue Returns String
102 string sRefName sUrl sRowId sSep
103 RowId riRowId
104 Get psHRefName to sRefName
105 If (sRefName<>"") Begin
106 Move (If(pos("?",sRefName),"&","?")) to sSep
107 Get CurrentRowId of (server(self)) to riRowId
108 Move (SerializeRowId(riRowId)) to sRowId
109 Move (sRefName-sSep-"RowId=" - sRowId ) to sUrl
110 Get HtmlLink sUrl sValue to sValue
111 end
112 //
113 Function_Return sValue
114 End_Function
115
116
117 { Visibility=Private }
118 Procedure Find_Init
119 integer iRec iFile
120 RowId riRowId
121 forward send Find_Init
122 set piFoundCount to 0
123 set priLastRowId to (NullRowId())
124 set piLastRecord to 0
125 set pbPartialReport to 0
126 get priStartRowId to riRowId
127 if not (IsNullRowId(riRowId)) begin
128 Send ReadByRowId riRowId
129 end
130 else Begin
131 get piStartRecord to iRec // compatibility only
132 If iRec Begin
133 Get main_file to iFile
134 If (iFile<>0) begin
135 Set_Field_value iFile 0 to iRec
136 VFind iFile 0 eq
137 If (Found) Begin
138 // this does a double find but it insures that the rowId/recnum finding behaviors are
139 // the same
140 Send ReadByRowId (GetRowId(iFile))
141 End
142 End
143 end
144 end
145 End_Procedure
146
147 // Should report be halted because we've encountered enough "records".
148 { Visibility=Private }
149 Function HaltReport integer iBreakLevel Returns integer
150 Integer bHalt iMax iCnt iLevel
151 If not (pbChildReport(self)) Begin
152 Get piMaxCount to iMax
153 If iMax Begin // if iMax is 0, we don't check for halting
154 Get piMaxCountBreakLevel to iLevel // break level to count for at. 0=count at body level
155 Get piFoundCount to iCnt
156 If ( (iLevel=0) OR (iBreakLevel>0 AND iBreakLevel<=iLevel) ) Begin
157 Move (iCnt=>iMax) to bHalt
158 If not bHalt ;
159 set piFoundCount to (iCnt+1)
160 end
161 end
162 end
163 Function_Return bHalt
164 End_Function
165
166 // this replaces superclass method. It is identical except where noted
167 // with **newcode**. This was altered to support the stopping of a report
168 // after a max number of breaks or records is encountered.
169 { Visibility=Private }
170 Function Handle_Report_Line Returns Integer
171 Integer RCount Rpt_Status CBreak
172 Get piRecordCount to RCount // how many records found so far
173 Send Assign_Report_Channel // set channel and Linecount
174 //
175 If (No_Finding_state(self)) Move RPT_OK to Rpt_Status
176 Else Get Find_Rec to Rpt_Status
177 //
178 If Rpt_Status eq RPT_OK Begin
179 Get OnSelection to Rpt_Status
180 If Rpt_Status eq RPT_OK begin
181 Set priCurrentRec to (priFoundRec(self))
182 Set piCurrentRecord to (Found_Rec(self)) // compatibility...obsolete
183 Get Test_BreakPoints to CBreak
184 If (HaltReport(self, CBreak)) begin // **new code**
185 Set priLastRowId to (priCurrentRec(self)) // **new code**
186 Set piLastRecord to (piCurrentRecord(self)) // **new code**
187 Set pbPartialReport to True // **new code**
188 Move RPT_END to Rpt_Status // **new code**
189 end // **new code**
190 If (Rpt_Status=RPT_OK) Begin // **new code**
191 If (RCount>0 and CBreak>0) Send Handle_SubTotals CBreak // print needed subtotals
192 If CBreak Gt 0 Send Handle_SubHeaders CBreak // Print needed sub headers as needed
193 Set priLastRec to (priCurrentRec(self))
194 Set Last_Rec to (piCurrentRecord(self)) // compatibility...obsolete
195 Increment RCount
196 Set piRecordCount to RCount
197 Send OnBody
198 If (pbCanceled(self)) Move RPT_CANCEL to Rpt_Status
199 End // **new code**
200 End
201 If (Rpt_Status=RPT_OK or Rpt_Status=RPT_NOT_SELECT) ;
202 Get Handle_KeyPressed to Rpt_Status
203 End
204 Function_Return Rpt_Status
205 End_Function
206
207
208 { MethodType=Event NoDoc=True }
209 Procedure Error_Report integer iErrNum integer iErrLine string sErrMsg
210 integer hOldError
211 If not (Error_Processing_State(self)) Begin
212 Set Error_Processing_State to True // prevents recursion
213 // this will end the report. Can be overridden in OnError
214 Set pbCanceled to TRUE
215
216 // There should be an error handler or not much happens
217 Get old_error_object_id to hOldError
218 If hOldError ;
219 Send Error_Report to hOldError iErrNum iErrLine sErrMsg
220
221 Send onError iErrNum iErrLine sErrMsg // good for augmentation
222
223 Set Error_Processing_State to False
224 End
225 End_procedure
226
227
228 // Function: TestBreakPoint
229 //
230 // Overlap fields might contain an imbedded zero value. These get passed
231 // properly in BStr but can not be stored and retreived in an array object.
232 // We will convert all 0s to 255s. This is imperfect but better than nothing.
233
234 { Visibility=Private }
235 Function TestBreakPoint Integer iBreakLevel Integer iCurrentBreak Returns Integer
236 Integer bChanged iItem hBreaksArray hmBreakMsg
237 String sNewValue sOldValue
238
239 Move oBreakArray to hBreaksArray
240 Move (iBreakLevel-1*2) to iItem
241 Get Value of hBreaksArray (iItem+1) to hmBreakMsg
242
243 If hmBreakMsg Begin
244 //
245 Get Value of hBreaksArray iItem to sOldValue
246 Get hmBreakMsg to sNewValue
247 Move (Replaces(character(0),sNewValue,character(255))) to sNewValue
248 Move (sOldValue<>sNewValue) to bChanged
249 If bChanged ;
250 Set Value of hBreaksArray iItem to sNewValue
251 End
252
253 If (iCurrentBreak=0) Begin // if not..then check for a break change
254 If (piRecordCount(self)=0) ;
255 Move 1 to iCurrentBreak // first time..break from top\
256 Else If bChanged ;
257 Move iBreakLevel to iCurrentBreak
258 end
259
260 Function_Return iCurrentBreak
261
262 End_Function
263
264 { Visibility=Private }
265 Function Test_BreakPoints Returns Integer
266 Integer iCurrentBreak i iMax
267 Move 0 to iCurrentBreak
268 Get piNumberBreaks to iMax
269 For i from 1 to iMax
270 Get TestBreakPoint i iCurrentBreak to iCurrentBreak
271 Loop
272 Function_Return iCurrentBreak
273 End_Function
274
275 Procedure RegisterBreakpoint integer hmMsg
276 integer iNum
277 Get piNumberBreaks to iNum
278 set Value of oBreakArray (iNum*2+1) to hmMsg
279 Set piNumberBreaks to (iNum+1)
280 End_Procedure
281
282 { MethodType=Event }
283 Procedure OnInitBreakPoints
284 End_Procedure
285
286 { Visibility=Private }
287 Procedure Clear_Breakpoints
288 Set piNumberBreaks to 0
289 Send Delete_data of oBreakArray
290 Send OnInitBreakPoints
291 End_Procedure
292
293End_Class