Module cReport.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//************************************************************************
11// Report.Pkg
12// Version: 1.1
13// Sun 08-25-1991
14// Wed 06-17-1992 Changed print wrap. It was printing a blank line. Altered
15// procedure Output_wrap_pagecheck and command
16// output_wrap_pagecheck.
17// Sat 11-21-1992 Moved Rpt_End into End_Construct_Object
18// Sat 11-21-1992 Set delegation_mode to default (it was no_delegation)
19// Sat 11-21-1992 Set Focus_mode to non-focusable
20// Sat 11-21-1992 Added phMainReport which is the obj# of the main outer
21// report. All child reports have this id.
22// Sun 11-22-1992 Added end report checking to make FF conditional (if
23// new_page_state is true no FF).
24// Wed 11-25-1992 Changed begin_constraint/end_contraint to move forward
25// send to the end. I did this because DAC did this.
26// Wed 12-23-1992 Changed DoRunReport to turn delegation back on after
27// a broadcast would have shut it off.
28// Wed 12-30-1992 Altered Test_One_BreakPoint to replace a 0 byte values
29// in passed string to 255. This was needed because strings
30// with 0 value in them can not get stored (or at least get
31// retrieved) in an array.
32//
33// Thu 04-15-1995 LS Using Seq_Chnl package now. Added Assigned_Channel
34// to help with this.
35//
36// 05/18/95 JJT Created a Clear_Breakpoints which is called in
37// setup_report. This solves a problem where skipped
38// bpoints (like a blank for first item) causes 0s to
39// get placed in the array. Also, it is possible that
40// nested reports may not break because of old data in
41// the breakpoints.
42// 05/18/95 JJT Output_Wrap_Pagecheck relies on global indicator |122
43// which is used by other commands. Push/Pop this value
44// in this procedure.
45// 09/07/95 JJT Replaced define_symbol w/ define
46// 08/30/96 JJT Changed vConsole to Cm_vConsole
47// 10/16/97 JJT If windows make superclass dfObject else if CM make it VConsole. For
48// some reason vconsole would crash windows upon exit. Also, set
49// focus_mode to no_activate instead of non_focusable. Non_Focusable takes
50// focus when activated as part of a group.
51// 2/26/2002 JJT - 8.2 clean up (indirect_file, local, self, etc.)
52//
53// Author: John J. Tuohy
54//
55//************************************************************************
56
57use VDFBase.pkg
58use Seq_Chnl.pkg
59
60#COMMAND OUTPUT_IMAGENUM R // Output by ImageNumber
61 #IFSAME !1 CHANNEL
62 Direct_OutPut Channel !2 // set channel--optional syntax
63 #IF !0>2
64 OutPut_ImageNum !3
65 #ENDIF
66 #ELSE
67 !A [] $202 !1
68 #ENDIF
69#ENDCOMMAND
70
71// ---values for Rpt_Status
72
73
74enum_list
75 define RPT_OK for 0 // All is well, record found
76 define RPT_END for 1 // Normal end of report
77 define RPT_NOT_SELECT for 2 // Special..used with OnSelection procedure
78 define RPT_CANCEL for 3 // Report was cancelled
79end_enum_list
80
81
82Define MAX_BREAKS_ALLOWED FOR 9 // this allows one to override maximum breaks.
83 // if you want more increase this.
84
85//
86//Class: Report
87//
88// SuperClass: VConsole
89//
90//
91//Usage: Declaration syntax is:
92// Object <name> is a Report {MAIN_FILE <Main_File>} {BY|DOWN <Index>} ;
93// {BREAK ...... ** }
94// :
95// End_Object
96//
97// Preferred Usage is:
98//
99// Object <name> is a Report
100// Report_Main_File <Main_File>
101// Report_Index BY <Index>
102// Report_Breaks Brk_1 {..Brk_n}
103// :
104// End_Object
105//
106//
107{ ClassLibrary=WebApp ClassType=Abstract }
108{ HelpTopic=cReport }
109Class cReport is an cObject
110 Procedure Construct_Object // Integer Img
111 Forward send Construct_Object // Img
112 //
113 // Properties that can be set. All can be set with the SET command.
114 // Some are set during the object (or sub-class) declaration.
115 //
116 { Category=Data }
117 { PropertyType=Boolean }
118 Property Integer No_Finding_State False
119 { Category=Data }
120 { PropertyType=Boolean }
121 Property Integer No_Constrained_Find_State False
122 { Category=Data }
123 { PropertyType=Boolean }
124 Property Integer No_Relate_State False // only if No_Cfind_State
125 { Category=Data }
126 Property Integer Main_File 0
127 { Category=Data }
128 Property Integer piOrdering -1 // let flex guess
129 { Category=Data }
130 { PropertyType=Boolean }
131 Property Integer pbFindDown False
132 { Category=Report }
133 { PropertyType=Boolean }
134 Property Integer pbRefindForSubTotal True // Advanced use only
135 //
136 // Internal Properties..maintained by object
137 //
138 { DesignTime=False }
139 Property Integer pbChildReport False
140 { DesignTime=False }
141 Property Integer pbHasChildReports False
142 //*** new property keeps track of who the main report is. Speeds things up
143 { DesignTime=False }
144 Property Integer phMainReport self
145 { DesignTime=False }
146 Property Integer piNumberBreaks 0
147 { DesignTime=False }
148 Property Integer Find_Mode 0 // only if No_Cfind_State
149
150 { DesignTime=False }
151 Property RowId priFoundRec
152 { DesignTime=False }
153 Property RowId priCurrentRec
154 { DesignTime=False }
155 Property RowId priLastRec
156 // old versions of the above, for compatibility sake it will be maintained
157 { Obsolete=True }
158 { DesignTime=False }
159 Property Integer Found_Rec 0
160 { Obsolete=True }
161 { DesignTime=False }
162 Property Integer piCurrentRecord 0
163 { Obsolete=True }
164 { DesignTime=False }
165 Property Integer Last_Rec 0
166
167 { DesignTime=False }
168 Property Integer piRecordCount 0
169 { DesignTime=False }
170 Property Integer Footer_Lines 0
171 { DesignTime=False }
172 Property Integer Report_Footer_Lines 0
173 { DesignTime=False }
174 Property Integer Page_Footer_Lines 0
175 { DesignTime=False }
176 { PropertyType=Boolean }
177 Property Integer Sub_Totaling_State False
178 { DesignTime=False }
179 { PropertyType=Boolean }
180 Property Integer No_PageCheck_State False
181 { DesignTime=False }
182 Property Integer Rpt_Ttl_Level 0
183 //
184 // -- these properties only need to be maintained by the
185 // outermost report object..All children will operate on the parent
186 //
187 { Visibility=Private }
188 Property Integer private.Page_End 59 // s/b set
189 { Visibility=Private }
190 Property Integer private.Page_Feed 0 // s/b set *
191 { Visibility=Private }
192 Property Integer private.Page_Count 0
193 { Visibility=Private }
194 Property Integer private.Report_Channel -1 // s/b set **
195 { Visibility=Private }
196 Property Integer private.Assigned_Channel 0
197 { Visibility=Private }
198 Property Integer private.pbCanceled False
199 { Visibility=Private }
200 Property Integer private.Page_End_State False // needs end of page
201 { Visibility=Private }
202 Property Integer private.New_Page_State False // needs new header
203 //
204 // * Note on Page_Feed Values. These are the same as the PAGEFEED
205 // integer variable with one new value (-2).
206 // Page_Feed > 0 on formfeed print the # of lines
207 // = 0 on formfeed print a FF character
208 // = -1 to screen. on Formfeed print TYPE ANY KEY
209 // = -2 to screen. On formfeed expect a custom routine to
210 // handle the press any key message.
211 //
212 // ** Note on Report_Channel: If channel is -1 then the report uses
213 // whatever channel happens to be open (default). Any positive value,
214 // then that channel is used. If channel is -2, then a free channel
215 // from the Seq_Chnl pkg is used and stored in Assigned_Channel.
216
217 Object oBreakArray is an Array // these keep track of breakpoint values
218 End_Object
219
220 //
221 #IFDEF THIS$IS$ONLY$FOR$DOCS
222
223 // section of code for Doc only. Compiler always skips this. These properties are defined in
224 // the class via a clever fmac command which the parser will not understand. Although the compiler
225 // will skip this code, the parser will not and it will add these messages to the docs
226
227 { Category=Report }
228 Property Integer Page_End 59
229 { Category=Report }
230 Property Integer Page_Feed 0
231 { Category=Report }
232 Property Integer Page_Count 0
233 { Category=Report }
234 Property Integer Report_Channel -1
235 { DesignTime=False }
236 Property Integer Assigned_Channel 0
237 { DesignTime=False }
238 Property Integer pbCanceled False
239 { DesignTime=False }
240 { PropertyType=Boolean }
241 Property Integer Page_End_State False
242 { DesignTime=False }
243 { PropertyType=Boolean }
244 Property Integer New_Page_State False
245
246 #ENDIF
247
248 End_Procedure
249
250 //
251 // These routines let you set and Get the private properties.
252 // In all cases the Get or Set is delegated to the ultimate parent
253 //
254 #COMMAND Make$Private$Set_Get R
255 Procedure SET !1 integer Val
256 //**if (pbChildReport(self)) Delegate Set !1 Val
257 //**else Set Report.!1 to Val
258 Integer Obj#
259 Get phMainReport to Obj#
260 Set private.!1 of Obj# to Val
261 End_Procedure
262
263 Function !1 returns integer
264 integer retval
265 //If (pbChildReport(self)) Delegate Get !1 to RetVal
266 //Else Get Report.!1 to retval
267 Integer Obj#
268 Get phMainReport to Obj#
269 Get private.!1 of Obj# to retval
270 Function_Return RetVal
271 End_Function
272 #ENDCOMMAND
273
274 Multi$ Make$Private$Set_Get Page_End New_Page_State Page_End_State
275 Multi$ Make$Private$Set_Get Page_Feed pbCanceled
276 Multi$ Make$Private$Set_Get Page_Count Report_Channel Assigned_Channel
277
278 //---Create all the default Message handlers for all Sections. These all do
279 // nothing and are intended for override
280 //
281
282 //
283 // This will make routines for all OnSubHeaderInit, OnSubHeader, and
284 // OnSubTotal Procedures. They all do nothing and are intended for
285 // override.
286 //
287 // Procedure: OnSubHeaderInit1..n
288 // This is called when a new subheader is started. It is
289 // called only once for each new subheader. It is not called when
290 // subheaders are printed during a page break.
291 //
292 // Procedure: OnSubHeader1..n
293 // This is called each time a subheader needs to be printed -
294 // both the first time a subheader is printed and during the
295 // reprinting of subheaders during page breaks.
296 //
297 // Procedure: OnSubTotal1..n
298 // This is called when a subtotal needs to be processed
299 //
300 #COMMAND Make$Procs R R R // Procedure_Name Crnt_Num End_Num
301 #SET I$ !2
302 Procedure !1!i
303 End_Procedure
304 #IF (!i<!3)
305 Make$Procs !1 !I !3
306 #ENDIF
307 #ENDCOMMAND
308 #PUSH !i
309 Make$Procs OnSubHeader 1 MAX_BREAKS_ALLOWED // OnSubHeader1...OnSubHeadern
310 Make$Procs OnSubTotal 1 MAX_BREAKS_ALLOWED // OnSubTotal1....OnSubTotaln
311 Make$Procs OnSubHeaderInit 1 MAX_BREAKS_ALLOWED // OnSubHeaderInit1...OnSubHeaderInitn
312 #POP I$
313
314#IFDEF THIS$IS$ONLY$FOR$DOCS
315//
316// section of code for Doc only. Compiler always skips this. These Events are defined in
317// the class via a clever fmac command which the parser will not understand. Although the compiler
318// will skip this code, the parser will not and it will add these messages to the docs. There will be
319
320 { MethodType=Event }
321 Procedure OnSubHeaderInit1..n
322 End_Procedure
323 { MethodType=Event }
324 Procedure OnSubHeader1..n
325 End_Procedure
326 { MethodType=Event }
327 Procedure OnSubTotal1..n
328 End_Procedure
329
330#ENDIF
331
332 // Procedure: OnTotal
333 // Called at the end of the report. Intended for override.
334 //
335 { MethodType=Event }
336 Procedure OnTotal
337 End_Procedure
338
339 //
340 // Page break related procedures. Note that the procedure names are
341 // identical in name and function as their FlexQL counterparts.
342 //
343 // Procedures onPageTop thru OnPageBottom ONLY get used by the outermost report
344 // object... All other objects delegate messages to this ultimate parent.
345 // creating these procedures in child reports will have NO effect.
346 //
347 { MethodType=Event }
348 Procedure OnPageTop // Printed at the Top of EVERY page
349 End_Procedure
350
351 { MethodType=Event }
352 Procedure OnReportHeader // Printed after OnPageTop..First Page ONLY
353 End_Procedure
354
355 { MethodType=Event }
356 Procedure OnPageHeader // Printer after OnPageTop..Every page but 1st.
357 End_Procedure
358
359 { MethodType=Event }
360 Procedure OnPageTitle // Printed after OnPageHeader or OnReportHeader
361 End_Procedure // for all pages
362
363 { MethodType=Event }
364 Procedure OnPageTotal // Printed at end of each page
365 End_Procedure
366
367 { MethodType=Event }
368 Procedure OnPageFooter // Printed after OnPageTotal every page but last
369 End_Procedure
370
371 { MethodType=Event }
372 Procedure OnReportFooter // Printed after OnPageTotal last page only
373 End_Procedure
374
375 { MethodType=Event }
376 Procedure OnPageBottom // last thing printed on every page
377 End_Procedure
378
379 { Visibility=Private }
380 Function IsRecnumTable integer iFile Returns boolean
381 Boolean bRecnumTable
382 Get_Attribute DF_FILE_RECNUM_TABLE of iFIle to bRecnumTable
383 Function_Return bRecnumTable
384 End_Function
385
386
387 // Function: Handle_KeyPressed
388 // This message is delegated to the outermost parent. It then
389 // calls the function Test_Keypressed. If Test_KeyPressed returns
390 // a non-zero value it will set pbCanceled to TRUE and
391 // return RPT_CANCEL
392 //
393 { Visibility=Private }
394 Function Handle_KeyPressed Returns Integer
395 integer Rpt_Status
396 If (pbChildReport(self)) ;
397 //**Delegate Get Handle_KeyPressed to Rpt_Status
398 Get Handle_KeyPressed of (phMainReport(self)) to Rpt_Status
399 Else Begin // once here we are always at the outermost
400 Get Test_KeyPressed to Rpt_Status // report..the ultimate parent
401 If Rpt_Status ne 0 Begin
402 Set pbCanceled to True
403 Function_Return RPT_CANCEL
404 End
405 End
406 Function_Return Rpt_Status
407 End_Function
408
409 // Function: Test_KeyPressed
410 // This returns a 1 if any key is pressed which will cause a
411 // report to be cancelled. This is not a very simple handler and
412 // is inteded for override.
413 //
414 { Visibility=Private }
415 Function Test_KeyPressed Returns Integer // 0 - ok 1 - abort
416 KeyCheck Function_Return 1
417 End_Function // this'll return a default 0
418
419 // Function: Test_BreakPoints
420 // A fairly complex override procedure gets automatically
421 // created by the BREAK command line option or the REPORT_BREAKS
422 // command.
423 //
424 { Visibility=Private }
425 Function Test_BreakPoints Returns Integer
426 End_Function
427
428 //
429 // Function: Test_One_BreakPoint
430 // Pass: BNum - current breakpoint number to test
431 // BStr - New breakpoint value to test
432 // Arr# - Object ID# of breakpoint array
433 // CBreak - Current highest breakpoint which has been
434 // already triggered (0-none, 1-highest, n-lowest).
435 // RCount - Current Record Count (piRecordCount).
436 // Return: Highest breakpoint set.
437 //
438 // This function is called by Test_BreakPoints for each
439 // breakpoint item that needs testing. It must set the highest
440 // break level and place the current break value in the break
441 // array.
442 //
443 { Visibility=Private }
444 Function Test_One_BreakPoint Integer BNum String BStr Integer Arr# ;
445 Integer CBreak Integer RCount ;
446 Returns Integer
447 integer retval Is_Break
448 // Overlap fields might contain an imbedded zero value. These get passed
449 // properly in BStr but can not be stored and retreived in an array object.
450 // We will convert all 0s to 255s. This is imperfect but better than nothing.
451 String Ch_0 Ch_255
452 Character 0 to CH_0
453 Character 255 to CH_255
454 Move (Replaces(Ch_0,BStr,Ch_255)) to BStr
455 Move CBreak to RetVal // is there a current break level?
456 Move (String_Value(Arr#,BNum)<>BStr) to Is_Break // change in break?
457 If Is_Break ne 0 Set Array_Value of Arr# Item BNum to BStr // store latest break value
458 If RetVal eq 0 Begin // if not..then check for a break change
459 If RCount eq 0 Move 1 to RetVal // first time..break from top
460 Else If Is_Break ne 0 Move BNum to RetVal // break if change
461 End
462 Function_Return RetVal // return new Cu rrent break level
463 End_Function
464
465 // record finding support
466 //
467 //
468 //
469 // Procedure: Find_Init
470 // set up this file for finding... This clears the needed buffers
471 //
472 { Visibility=Private }
473 Procedure Find_Init
474 Integer File# Ndx# Mode
475
476 If (pbFindDown(self)) Move 1 to Mode // LE
477 else Move 3 to Mode // GE
478
479 If (No_Constrained_Find_State(self)) Set Find_Mode to Mode
480 Else Begin
481 Send Rebuild_Constraints
482 Get main_file to File#
483 Get piOrdering to Ndx#
484 Constraint_Set self
485 Constrained_Clear Mode File# BY Ndx#
486 End
487 End_Procedure
488
489 // Function: Find_Rec
490 //
491 // This is the reports main record finding procedure
492 // Ret : Integer RPT_OK or RPT_END (plus record in buffer)
493 //
494 // This is the routine to augment or override to handle Custon Finding.
495 // If a record is returned we must set the property Found_Rec to the
496 // record number. Remember this if you override this routine!
497 //
498 { Visibility=Private }
499 Function Find_Rec Returns Integer
500 Integer Mode
501 integer iFile iRec
502 If (No_Constrained_Find_State(self)) Begin
503 Get main_file to iFile
504 Get Find_Mode to Mode
505 vFind iFile (piOrdering(self)) Mode
506 If Mode eq 1 Set Find_Mode to 0 // LE --> LT
507 Else if Mode eq 3 Set Find_Mode to 4 // GE --> GT
508 [Found] If Not (No_Relate_State(self)) Begin
509// Move 0 to fieldindex
510// Relate Indirect_File
511 Relate iFile
512 Indicate Found True
513 End
514 End
515 Else Constrained_Find NEXT self
516 If (Found) Begin // set priFoundRec
517 Get Main_File to iFile // to new record #
518 Set priFoundRec to (GetRowId(iFile))
519 // for compatibility sake.
520 If (IsRecnumTable(self,iFile)) begin
521 Get_field_value iFile 0 to iRec // compatibility w/ recnum
522 Set Found_Rec to iRec
523 End
524 Send Relate_Main_File
525 Indicate Found True
526 Function_Return RPT_OK
527 End
528 Function_return RPT_END
529 End_Function
530
531 //
532 // Procedure : ReadByRowId
533 // Find a record by its rowId number. Used by the report object
534 // to refind records
535 //
536 { Visibility=Private }
537 Procedure ReadByRowId RowId riID
538 integer iFile
539 boolean bFound
540 Get main_file to iFile
541 If (iFile AND not(IsNullRowId(riID)) ) begin
542 Move (findByrowId(iFile,riId)) to bFound
543 If (bFound) Begin
544 If Not (No_Constrained_Find_State(self) and No_Relate_State(self)) begin
545 Relate iFile
546 End
547 Send Relate_Main_File // custom relate records
548 Indicate Found True
549 End
550 End
551 Else Indicate Found False
552 End_procedure
553
554// //
555// // Procedure : Read_By_RecNum
556// // Find a record by its record number. Used by the report object
557// // to refind records
558// //
559// //Doc/ Visibility=Private
560// Procedure Read_By_Recnum Integer Rec#
561// integer iFile
562//// Get main_file to Filenumber
563//// If (Filenumber<>0 AND Rec#<>0) begin
564//// Move 0 to fieldindex
565//// Move Rec# to Indirect_File.RECNUM
566//// Find eq Indirect_File.RECNUM
567// Get main_file to iFile
568// If (iFile<>0 AND Rec#<>0) begin
569// Set_Field_value iFile 0 to Rec#
570// VFind iFile 0 eq
571// [Found] Begin
572//// If Not (No_Constrained_Find_State(self) and ;
573//// No_Relate_State(self)) Relate Indirect_File
574// If Not (No_Constrained_Find_State(self) and ;
575// No_Relate_State(self)) Relate iFile
576// Send Relate_Main_File // custom relate records
577// Indicate Found True
578// End
579// End
580// Else Indicate Found False
581// End_procedure
582
583 //
584 // Procedure Relate_Main_File
585 // Called when custom relates are needed in a report. Intended
586 // for Override
587 //
588 { MethodType=Event }
589 Procedure Relate_Main_File // for override
590 End_Procedure
591
592 //
593 // Function: DoRunReport
594 // Main entry point for report. It has two operation modes:
595 //
596 // 1. If NO_FINDING_STATE is False (the default when MAIN_FILE is
597 // set) then this runs the entire report.
598 // 2. If NO_FIND_STATE is True because it was set that way or
599 // MAIN_FILE was never set then this initializes the report and
600 // returns. You then run the report by sending it
601 // Handle_Report_Line messages and then ending it with a
602 // End_Report message
603 //
604 // Main Logic:
605 //
606 // Get Setup_Report <--- initializes report
607 // If a full report begin
608 // Repeat
609 // Get Handle_Report_Line <-- finds and prints a line
610 // until the report is ended or cancelled
611 // get End_Report <--- ends the report
612 // end
613 // Function_Return Report_status
614 //
615 //
616 Function DoRunReport Returns Integer
617 Integer Rpt_Status ChildState
618 Get pbChildReport to ChildState
619 // When DoRunReport is started from within another report via a broadcast
620 // command the broadcast command will change the Delegation_mode to
621 // no_delegate_or_error. We will reset the delegation_mode back to what
622 // we want it to be thus allowing child reports to take full advantage
623 // of delegation.
624 if ChildState Set Delegation_Mode to DELEGATE_TO_PARENT
625 If (ChildState and pbCanceled(self)) ; // for broadcast
626 Function_Return RPT_CANCEL // child reports
627 Get Setup_Report to Rpt_Status // ret: 0-OK 1-Abort
628 If Rpt_Status ne RPT_OK Function_Return Rpt_Status
629 If Not (No_Finding_State(self)) Begin
630 Repeat
631 Get Handle_Report_Line to Rpt_Status
632 Until ((Rpt_Status ne RPT_OK) and (Rpt_Status ne RPT_NOT_SELECT))
633 Get End_Report Rpt_Status to Rpt_Status
634 If ChildState Send Restore_Parent_Rec // if child..restore orig parent rec.
635 End
636 Function_Return Rpt_Status
637 End_Function
638
639 // Procedure: Run_Report
640 // This runs an entire report. It is just like DoRunReport except that it
641 // does not return a value. If you use this then you will not know how the
642 // report was ended. On the up side the syntax is clearer. DO NOT use this
643 // with external (no_find_State) reports.
644 //
645 { Visibility=Private Obsolete=true }
646 Procedure Run_Report
647 Integer Dump
648 Get DoRunReport to Dump
649 End_Procedure
650
651 // 05/18/95 - When a report is started all breakpoints should be
652 // cleared.
653 { Visibility=Private }
654 Procedure Clear_Breakpoints
655 integer cnt i Arr#
656 Move oBreakArray to Arr#
657 Get piNumberBreaks to cnt
658 for i from 0 to cnt
659 Set Array_Value of Arr# Item i to ''
660 Loop
661 End_Procedure // clear_breakpoints
662
663 //
664 // Function_Setup Report
665 // If a non-zero value is returned the report will not be run
666 //
667 { Visibility=Private }
668 Function Setup_Report Returns Integer
669 Integer retval
670 Send Clear_BreakPoints // 05/18/95 - Start w/ all bpoints blank
671 If not (pbChildReport(self)) Begin
672 Get OnStartingMainReport to RetVal
673 If RetVal ne RPT_OK Function_Return RetVal
674 End
675 Get OnStartingReport to RetVal
676 If RetVal ne RPT_OK Function_Return RetVal
677 Set piRecordCount to 0 // number items found
678 If not (No_Finding_state(self)) Send Find_Init
679 If not (pbChildReport(self)) Begin
680 // set the start-up info
681 Set pbCanceled to False
682 Send Assign_Report_Channel
683 Move 0 to LineCount // start with an empty page
684 Set Page_Count to 1 // Start w/ page 1
685 Set New_Page_State to True // we start needing a new page
686 Set Page_End_State to False
687 End
688 End_Function
689
690 //
691 // Function: OnStartingReport
692 // User Handler Intended for override. This is called by setup
693 // for all reports. If the report is nested this IS called every
694 // time the nested report is entered.
695 //
696 // If a non-zero value is returned the report will be cancelled
697 //
698 { MethodType=Event }
699 Function OnStartingReport Returns Integer // Pre report prep. For Override by user
700 Function_Return RPT_OK
701 End_Function
702
703 // Function: OnStartingMainReport
704 // User Handler Intended for override. This is the same as
705 // OnStartingReport except this message is only sent to the main
706 // (parent) outer report. Nested reports do not send this message.
707 // This is very useful for setting indexes, output channels, etc.
708 //
709 // If a non-zero value is returned the report will be cancelled
710 //
711 { MethodType=Event }
712 Function OnStartingMainReport Returns Integer // Pre report prep. For Override by user
713 Integer RptChannel
714 If (Report_Channel(self)) EQ -2 begin
715 Get Seq_New_Channel to RptChannel
716 Set Assigned_Channel to RptChannel
717 End
718 Function_Return RPT_OK
719 End_Function
720
721 // Function: End_Report
722 // Called to shut down the report.
723 // Pass: Rpt_Status - If Rpt_Status=RPT_CANCEL then the report was
724 // cancelled.
725 //
726 // Main_Logic
727 // If Rpt_Status ne RPT_CANCEL <---normal end of report
728 // send Handle_End_Report <---final subtotals, totals, etc
729 // Move RPT_OK to Rpt_Status <---we want a normal report to end
730 // with a RPT_OK
731 // Else
732 // Send Handle_Cancelled_Report
733 // send OnEndingReport
734 // If main outer report send OnEndingMainReport
735 // return Rpt_Status
736 //
737 { Visibility=Private }
738 Function End_Report Integer Rpt_Status Returns Integer
739 If Rpt_Status ne RPT_CANCEL Begin
740 Send Handle_End_Report
741 Move RPT_OK to Rpt_Status
742 End
743 Else Send Handle_Cancelled_Report
744 Send OnEndingReport
745 If not (pbChildReport(self)) Begin
746 Send OnEndingMainReport
747 End
748 Function_Return Rpt_Status
749 End_Function
750
751 //
752 // Procedure: OnEndingReport
753 // User Handler Intended for override. This is called by end_report
754 // for all reports. If the report is nested this IS called every
755 // time the nested report is entered.
756 //
757 { MethodType=Event }
758 Procedure OnEndingReport
759 End_Procedure
760
761 // Procedure: OnEndingMainReport
762 // User Handler Intended for override. This is the same as
763 // OnEndingReport except this message is only sent to the main
764 // (parent) outer report. Nested reports do not send this message.
765 // This is very useful for closing files, io channels, etc.
766 //
767 { MethodType=Event }
768 Procedure OnEndingMainReport
769 If (Report_Channel(self)) EQ -2 ;
770 Send Seq_Release_Channel (Assigned_Channel(self))
771 End_Procedure
772
773
774 // Function: Handle_Report_Line
775 // Handle 1 line of a report doing headers,totals as needed.
776 // Returns Integer Rpt_Status as what happened (RPT_OK-Record found and
777 // printed, RPT_END-Record not found/end report, RPT_CANCEL-report
778 // has been cancelled, RPT_NOT_SELECT - (special) means current
779 // record was not valid - but keep looking
780 //
781 // If NO_FINDING_STATE is TRUE then you should call this function
782 // with a record already in place. Otherwise this will find the
783 // record for you.
784 //
785 { Visibility=Private }
786 Function Handle_Report_Line Returns Integer
787 Integer RCount Rpt_Status CBreak
788 Get piRecordCount to RCount // how many records found so far
789 Send Assign_Report_Channel // set channel and Linecount
790 //
791 If (No_Finding_state(self)) Move RPT_OK to Rpt_Status
792 Else Get Find_Rec to Rpt_Status
793 //
794 If Rpt_Status eq RPT_OK Begin
795 Get OnSelection to Rpt_Status
796 If Rpt_Status eq RPT_OK begin
797 Set priCurrentRec to (priFoundRec(self))
798 Set piCurrentRecord to (Found_Rec(self)) // compatibility...obsolete
799 Get Test_BreakPoints to CBreak
800 If (RCount>0 and CBreak>0) Send Handle_SubTotals CBreak // print needed subtotals
801 If CBreak Gt 0 Send Handle_SubHeaders CBreak // Print needed sub headers as needed
802 Set priLastRec to (priCurrentRec(self))
803 Set Last_Rec to (piCurrentRecord(self)) // compatibility...obsolete
804 Increment RCount
805 Set piRecordCount to RCount
806 Send OnBody
807 If (pbCanceled(self)) Move RPT_CANCEL to Rpt_Status
808 End
809 If (Rpt_Status=RPT_OK or Rpt_Status=RPT_NOT_SELECT) ;
810 Get Handle_KeyPressed to Rpt_Status
811 End
812 Function_Return Rpt_Status
813 End_Function
814
815 // Procedure: Handle_End_Report
816 // Shut down report in normal manner. Print final subtotals, totals
817 // and footers
818 //
819 { Visibility=Private }
820 Procedure Handle_End_Report
821 If (piRecordCount(self)) Begin
822 Send Assign_Report_Channel
823 If (piNumberBreaks(self)>0) Send Handle_SubTotals 1 // 1 will do all
824 If Not (pbChildReport(self)) Begin
825 Set Sub_Totaling_State to True // Break down for TOTAL
826 Set Rpt_Ttl_Level to 0
827 Send OnTotal // Print TOTAL
828 Set Sub_Totaling_State to False
829 Send Handle_Footer 1 // Print any footer 1 means last time
830 //*** 11-22-1992 added newpage check
831 If (New_page_State(self)=0) Send Final_Formfeed
832 End
833 End
834 End_Procedure
835
836 // Procedure: Handle_Cancelled_Report
837 // Shut down a cancelled report. This prints the final formfeed if
838 // anything was printed and the report was not a screen report and
839 // it is the main outer report.
840 //
841 { Visibility=Private }
842 Procedure Handle_Cancelled_Report
843 If (piRecordCount(self) and Not (pbChildReport(self)) ;
844 and (Page_Feed(self) > -1) ;
845 and (New_page_State(self)=0) ) Send Final_Formfeed
846 //*** 11-22-1992 added newpage check
847 End_Procedure
848
849 //
850 // Procedure: OnBody
851 // Normally this is overridden. In nested reports this can be sued
852 // by the parent to start all of the inner reports.
853 //
854 { MethodType=Event }
855 Procedure OnBody
856 Integer Rpt_Status
857 if (pbHasChildReports(self)) ;
858 Broadcast Get DoRunReport to Rpt_Status // send to all child reports
859 End_Procedure
860
861 // Function: OnSelection
862 // returns: Rpt_Status
863 // Called after a record has been found. Intended for override. If
864 // you are using constraints you probably won't need this.
865 //
866 { MethodType=Event }
867 Function OnSelection Returns Integer
868 Function_Return RPT_OK
869 End_Function
870
871 { Visibility=Private }
872 Procedure Filler // print 1 filler line as needed
873 Send WriteLn ''
874 End_Procedure
875
876 // Procedure: Restore_Parent_Rec
877 //
878 //
879 { Visibility=Private }
880 Procedure Restore_Parent_Rec
881 RowId riRec
882 If (pbChildReport(self)) Begin // if child report then
883 Delegate Get priCurrentRec to riRec // make sure original parent
884 Delegate Send ReadByRowId riRec // related
885 End
886 End_Procedure
887
888 // Procedure: Assign_Report_Channel
889 // This makes sure the the correct channel is set. This called by
890 // the report's critical entry points (DoRunReport,
891 // Handle_report_Line, End_report).
892 //
893 { MethodType=Event }
894 Procedure Assign_Report_Channel
895 Integer RptChannel
896 Get Report_Channel to RptChannel // this will set LineCount Global Integer
897 // -2 means use channel assigned from seq_chnl pkg
898 If RptChannel EQ -2 Get Assigned_Channel to RptChannel
899 // -1 means don't mess with the output channel
900 If RptChannel NE -1 Direct_Output Channel RptChannel
901 End_Procedure
902
903 // Procedure: Handle_SubTotals (Internal)
904 //
905 { Visibility=Private }
906 Procedure Handle_SubTotals Integer CBrk
907 Integer Flag i R_S MSG
908 Get piNumberBreaks to i
909 Get pbRefindForSubTotal to R_S
910 Move 0 to Flag
911 Set Sub_totaling_State to TRUE
912 While i ge CBrk
913 If (R_S and (Flag=0)) Begin
914 Send ReadByRowId (priLastRec(self))
915 Move 1 to Flag
916 End
917 Set Rpt_Ttl_Level to i
918 Move (MSG_OnSubTotal1+i-1) to Msg
919 Send Msg to self
920 Decrement i
921 Loop
922 Set Rpt_Ttl_Level to 0
923 If Flag ne 0 ; // restore current record if needed
924 Send ReadByRowId (priCurrentRec(self))
925 Set Sub_totaling_State to FALSE
926 End_Procedure
927
928 // Procedure: Handle_SubHeaders (Internal)
929 //
930 { Visibility=Private }
931 Procedure Handle_SubHeaders Integer CBrk
932 integer NBrks i Msg
933 If CBrk eq 0 Procedure_Return
934 Get piNumberBreaks to NBrks
935 For i from CBrk to NBrks
936 Set Rpt_Ttl_Level to i // keep track of current break level
937 Move (MSG_OnSubHeaderInit1+i-1) to Msg
938 Send Msg to self
939 Move (MSG_OnSubHeader1+i-1) to Msg
940 Send Msg to self
941 Loop
942 Set Rpt_Ttl_Level to 0
943 End_Procedure
944
945 // Procedure: RePrint_SubHeaders (Internal)
946 //
947 // RePrint SubHeaders as part of a page break
948 //
949 { Visibility=Private }
950 Procedure RePrint_SubHeaders
951 integer i Lvl Msg
952 Set No_PageCheck_State to True // repaging..don't check line length
953 Get Rpt_Ttl_Level to Lvl
954 If Not (Sub_totaling_State(self)) Begin
955 If Lvl eq 0 Get piNumberBreaks to Lvl
956 Else Decrement Lvl
957 End
958 For i from 1 to Lvl
959 Move (MSG_OnSubHeader1+i-1) to Msg
960 Send Msg to self
961 Loop
962 Set No_PageCheck_State to False // No longer Paging
963 End_Procedure
964
965 // Procedure: New_Page (internal)
966 //
967 { Visibility=Private }
968 Procedure New_Page
969 If (pbChildReport(self)) ; //*** delegate Send New_Page
970 Send New_Page to (phMainReport(self))
971 Else Begin
972 Set No_PageCheck_State to True // reprinting..don't check line length
973 Send OnPageTop
974 If (Page_Count(self)) eq 1 Send OnReportHeader
975 Else Send OnPageHeader
976 Send OnPageTitle
977 Set New_Page_State to False
978 Set No_PageCheck_State to False // No longer Paging
979 End
980 Send RePrint_SubHeaders // reprint sub headers
981 End_Procedure
982
983 // Procedure: Hanle_Footer (Internal)
984 //
985 { Visibility=Private }
986 Procedure Handle_Footer Integer LastTime // Do Filler and footer
987 Integer i PE
988 If (pbChildReport(self)) ; //***Delegate Send Handle_Footer LastTime
989 Send Handle_Footer to (phMainReport(self)) LastTime
990 Else Begin
991 Get Footer_Lines to i
992 if LastTime ne 0 ;
993 Move (i + (Report_Footer_Lines(self)) - (Page_Footer_Lines(self)) ) to i
994 If i gt 0 begin
995 Set No_PageCheck_State to True
996 Get Page_end to PE
997 While LineCount lt (PE - i)
998 Send Filler
999 End
1000 Send OnPageTotal
1001 If LastTime eq 0 Send OnPageFooter
1002 else Send OnReportFooter
1003 Send OnPageBottom
1004 Set No_PageCheck_State to False
1005 End
1006 End
1007 End_Procedure
1008
1009 // Procedure Final_Formfeed
1010 //
1011 // intended for augmentation/override
1012 // Called to eject the last page after the main report has
1013 // processed all records.
1014 { MethodType=Event }
1015 Procedure Final_FormFeed
1016 Send Formfeed
1017 End_procedure
1018
1019 // Procedure FormFeed
1020 //
1021 // intended for augmentation/override
1022 // Formfeed is responsible for handling an end of page break
1023 // AND incrementing the property Page_Count AND zeroing the
1024 // integer LINECOUNT
1025 Procedure FormFeed
1026 Integer Lnes Cnt
1027 Get Page_Feed to PageFeed // do it the old fashioned df
1028 Get Page_End to PageEnd // way with PageFeed, PageEnd and
1029 Get Page_Count to PageCount // PageCount
1030 Set Page_Count to (PageCount+1)
1031 If PageFeed ge -1 Formfeed // this'll zero Linecount
1032 Else Move 0 to LineCount
1033 End_procedure
1034
1035 // Function: Page_End_Check (internal)
1036 //
1037 { Visibility=Private }
1038 Function Page_End_Check Integer Lines Returns Integer
1039 Integer i Stat
1040 If ( pbChildReport(self) ) ; //*** Delegate Get Page_End_Check to Lines Stat
1041 Get Page_End_Check of (phMainReport(self)) Lines to Stat
1042 Else Begin
1043 Get Footer_Lines to i
1044 If (LineCount + Lines) gt (Page_End(self) - i) Move 1 to Stat
1045 Else Move 0 to Stat
1046 End
1047 Function_Return Stat
1048 End_Function
1049
1050 // Procedure: Page_Check (internal)
1051 //
1052 { Visibility=Private }
1053 Procedure Page_Check Integer Lines // check if room for new image..if not new page
1054 If ( (Page_End_State(self)) or ;
1055 (Page_End_Check(self,Lines)) ) ;
1056 Begin // if new page needed
1057 Send Handle_Footer 0 // do the footer
1058 Send FormFeed
1059 Set Page_End_State to False
1060 Set New_Page_State to True
1061 End
1062 If (New_Page_State(self)) Send New_Page
1063 End_Procedure
1064
1065 // Procedure: OutPut_ImageNum
1066 // Possibly useful for override and augmentation in that all
1067 // image output goes through this handler.
1068 //
1069 Procedure Output_ImageNum Integer ImageNum
1070 Output_ImageNum ImageNum
1071 End_Procedure
1072
1073 // Procedure: OutPut_PageCheck (internal)
1074 //
1075 { Visibility=Private }
1076 Procedure OutPut_PageCheck Integer ImageNum Integer Lines
1077 If Not (No_PageCheck_State(self)) Send Page_Check Lines
1078 Send Output_ImageNum ImageNum
1079 End_Procedure
1080
1081 // Output_Wrap_PageCheck (internal)
1082 // 06-17-1992 added PrintReq as parameter. If true print line always
1083 // 05/18/95 it is possible for |122 to get clobbered (with increment
1084 // ifchange or for commands). Push and pop it first.
1085 { Visibility=Private }
1086 Procedure OutPut_Wrap_PageCheck Integer ImageNum Integer Lines Integer PrintReq
1087 integer Save122#
1088 If Not (No_PageCheck_State(self)) Send Page_Check Lines
1089 !A [] $20A ImageNum // Fill wrap fields and set |122 if empty
1090 // if empty and print is not required we are done
1091 [|122] If PrintReq eq 0 Procedure_Return
1092 Move (|122) to Save122# // save this global value
1093 Send Output_ImageNum ImageNum
1094 Indicate |122 as (Save122#) // restore global indicator
1095 [~|122] If (pbCanceled(self) or ;
1096 Handle_Keypressed(self) ) Indicate |122 True
1097 End_Procedure
1098
1099 // Procedure: Writeln
1100 // Possibly useful for override and augmentation in that all
1101 // non image writeln goes through this handler.
1102 //
1103 Procedure WriteLn String WrStr
1104 WriteLn WrStr
1105 End_Procedure
1106
1107 // Procedure: Writeln_PageCheck (Advanced use)
1108 //
1109 Procedure Writeln_PageCheck String WrStr Integer Lines
1110 Integer L
1111 If Num_Arguments lt 2 Move 1 to L
1112 Else Move Lines to L
1113 If Not (No_PageCheck_State(self)) Send Page_Check L
1114 Send WriteLn WrStr
1115 End_Procedure
1116
1117 // these procedures get created during object or class creation.
1118 // They will create handlers that set the value of the
1119 // associated properties. This allow this package to be used
1120 // for class construction.
1121 //
1122 { Visibility=Private }
1123 Procedure Breaks_Set
1124 End_Procedure
1125
1126 { Visibility=Private }
1127 Procedure Page_Footer_set
1128 End_Procedure
1129
1130 { Visibility=Private }
1131 Procedure Page_bottom_Set
1132 End_Procedure
1133
1134 { Visibility=Private }
1135 Procedure Page_total_Set
1136 End_Procedure
1137
1138 { Visibility=Private }
1139 Procedure Report_Footer_Set
1140 End_Procedure
1141
1142 // Mark this child report object's Main report Id along with all of
1143 // its children
1144 { Visibility=Private }
1145 Procedure Mark_Main_Report_Id Integer Obj#
1146 Set phMainReport to Obj# // mark self
1147 Broadcast Send Mark_Main_Report_Id Obj# // mark all children
1148 End_Procedure
1149
1150 { Visibility=Private }
1151 Procedure Mark_Rpt_Children
1152 Set pbChildReport to false
1153 Broadcast send Mark_as_Rpt_Child
1154 Broadcast send Mark_Main_Report_Id self
1155 End_Procedure
1156
1157 { Visibility=Private }
1158 Procedure Mark_as_Rpt_Child
1159 set pbChildReport to true
1160 delegate set pbHasChildReports to True
1161 End_Procedure
1162
1163 { Visibility=Private }
1164 Procedure Constrain //intended for override/augmentation
1165 Send OnConstrain
1166 if (pbChildReport(self)) ;
1167 CONSTRAIN (Main_File(self)) RELATES TO ;
1168 (Main_File(Parent(self)))
1169 End_Procedure
1170
1171 // added optional support for OnConstrain
1172 { MethodType=Event }
1173 Procedure OnConstrain
1174 End_Procedure
1175
1176 { Visibility=Private }
1177 Procedure Rebuild_Constraints
1178 Constraint_Set self CLEAR
1179 Send constrain
1180 End_procedure
1181
1182 //
1183 // returns index# (incl. 0) or 0 if unindexed/error
1184 //
1185 { Visibility=Private Obsolete=True }
1186 Function which_index integer file# integer field# returns integer
1187 integer fldNdx
1188 if file# ne 0 Begin
1189// FIELD_DEF file# field# TO fldNdx fldNdx
1190 get_attribute DF_FIELD_INDEX of file# field# to fldNdx // main index field
1191 function_return fldNdx
1192 End
1193 End_function
1194
1195 Procedure End_Construct_Object
1196 send Mark_Rpt_Children //mark components
1197 // If no Main_File we assume we have a No_Finding_State condition
1198 If (Main_File(self)=0) Set No_Finding_State to TRUE
1199 Send Breaks_Set // sets piNumberBreaks property
1200 Send Page_Footer_Set
1201 Send Page_Bottom_Set
1202 Send Page_Total_Set
1203 Send Report_Footer_Set
1204 Forward Send End_Construct_Object
1205 End_Procedure
1206
1207End_Class // end of REPORT class
1208
1209
1210#COMMAND Setup$Breaks R .
1211 // we pass as much as possible to speed things up.
1212 Get Test_One_BreakPoint !I !1 Arr# CBreak RCount to CBreak
1213#ENDCOMMAND
1214
1215// These are identical to the commands found in Data_Set.pkg...
1216#COMMAND BEGIN_CONSTRAINTS
1217 procedure Constrain
1218#ENDCOMMAND
1219
1220#COMMAND END_CONSTRAINTS
1221 forward send constrain
1222 end_procedure
1223#ENDCOMMAND
1224
1225
1226// ------------special macro commands to be used by Report Objects
1227//
1228// Output_PageCheck command for Report Package.
1229// Formats are: OutPut_PageCheck Image Length
1230// OutPut_PageCheck Image - uses Image.LINES for length
1231// OutPut_PageCheck - Uses OutPut_Image & OutPut_Lines
1232// which Procedure_Section creates.
1233//
1234#COMMAND Output_PageCheck // does an output for reports w/ a page check
1235 #IFSAME !1 CHANNEL
1236 Direct_OutPut Channel !2 // set channel--optional syntax
1237 #IF !0>2
1238 OutPut_PageCheck !3 !4
1239 #ENDIF
1240 #ELSE
1241 #IF (!0>1) // and prints new page if needed
1242 Send OutPut_PageCheck !1.N !2
1243 #ELSE
1244 #IF (!0>0) // and prints new page if needed
1245 Output_PageCheck !1 !1.LINES
1246 #ELSE
1247 Output_PageCheck OutPut_Image OutPut_Lines
1248 #ENDIF
1249 #ENDIF
1250 #ENDIF
1251#ENDCOMMAND
1252
1253//
1254// Output_Wrap_PageCheck command for Report Package.
1255// Formats are: OutPut_PageCheck Image Length
1256// OutPut_PageCheck Image - uses Image.LINES for length
1257//
1258#COMMAND Output_Wrap_PageCheck R // does an output for reports w/ a page check
1259 #IFSAME !1 CHANNEL
1260 Direct_OutPut Channel !2 // set channel--optional syntax
1261 #IF !0>2
1262 OutPut_Wrap_PageCheck !3 !4
1263 #ENDIF
1264 #ELSE
1265 #IF (!0>1) // and prints new page if needed
1266 Send OutPut_Wrap_PageCheck !1.N !2 TRUE // unconditional print
1267 [~|122] Repeat
1268 BlankForm !1
1269 Send OutPut_Wrap_PageCheck !1.N !2 FALSE // print if not empty
1270 [~|122] Loop
1271 #ELSE
1272 Output_Wrap_PageCheck !1 !1.LINES
1273 #ENDIF
1274 #ENDIF
1275#ENDCOMMAND
1276
1277
1278// Procedure_Section
1279// Formats are:
1280// Procedure_Section Section_Name {AS Image_Name} {Lines}
1281//
1282// Note: these commands are identical:
1283//
1284// 1. Procedure_Section OnBody as VndrBody
1285// 2. Procedure_Section OnBody as VndrBody Body.LINES
1286// 3. Procedure onBody
1287// Autopage VndrBody
1288// Integer OutPut_Image
1289// Move VndrBody.N to OutPut_Image
1290//
1291//
1292#COMMAND Procedure_Section R
1293 #IF !0=1
1294 #IFDEF !1.LINES
1295 Procedure_Section !1 AS !1 !1.Lines
1296 #ELSE
1297 Procedure !1
1298 #ENDIF
1299 #ELSE
1300 #IF !0=2
1301 Procedure_Section !1 AS !1 !2
1302 #ELSE
1303 #IF !0=3
1304 #CHECK !3.N _R#LGVU
1305 Procedure_Section !1 !2 !3 !3.Lines
1306 #ELSE
1307 #CHECK !2 "AS"
1308 #IFSAME !1 ONPAGEFOOTER ONPAGEBOTTOM ONPAGETOTAL ONREPORTFOOTER // if a footer...handle w/ special macro
1309 FOOTER$SETS !1 !4
1310 #ENDIF
1311 //
1312 Procedure !1 // Set the procedure Name
1313 Integer OutPut_Lines
1314 Move !4 to OutPut_Lines
1315 //
1316 #IFDEF !3.N
1317 Autopage !3
1318 Integer OutPut_Image
1319 Move !3.N to OutPut_Image
1320 #ENDIF
1321 #ENDIF
1322 #ENDIF
1323 #ENDIF
1324#ENDCOMMAND
1325
1326#COMMAND FOOTER$SETS "ONPAGEFOOTER""ONPAGEBOTTOM""ONPAGETOTAL""ONREPORTFOOTER" R
1327 #IFSAME !1 ONPAGEFOOTER
1328 Procedure Page_Footer_Set
1329 Set Footer_Lines to (!2 + (Footer_Lines(self)) )
1330 Set Page_Footer_Lines to !2
1331 End_Procedure
1332 #ELSE
1333 #IFSAME !1 ONPAGEBOTTOM
1334 Procedure Page_bottom_Set
1335 Set Footer_Lines to (!2 + (Footer_Lines(self)) )
1336 End_Procedure
1337 #ELSE
1338 #IFSAME !1 ONPAGETOTAL
1339 Procedure Page_total_Set
1340 Set Footer_Lines to (!2 + (Footer_Lines(self)) )
1341 End_Procedure
1342 #ELSE // must be OnReportFooter
1343 Procedure Report_Footer_Set
1344 Set Report_Footer_Lines to !2
1345 End_Procedure
1346 #ENDIF
1347 #ENDIF
1348 #ENDIF
1349#ENDCOMMAND
1350
1351//
1352// Set a reports Main_File:
1353// Format is: REPORT_MAIN_FILE FileName
1354//
1355#COMMAND Report_Main_File R . // obsolete
1356 #IFDEF !1.File_Number
1357 Set Main_File to !1.File_Number
1358 #ELSE
1359 #ERROR DFERR_COMPILE If !1 is a file it is unopened
1360 #ENDIF
1361#ENDCOMMAND
1362
1363//
1364// Set a Reports Index and direction
1365// Format is: REPORT_INDEX BY|DOWN Index#|File.Field
1366//
1367#COMMAND Report_Index "BY""DOWN" R . // Set piOrdering property
1368 #IFSAME !1 DOWN
1369 Set pbFindDown to True
1370 #ELSE
1371 Set pbFindDown to False
1372 #ENDIF
1373 #IFCLASS !2 "F" // if File.Field then figure out which
1374 #PUSH !i // index number to use at run-time
1375 #PUSH !l
1376 #SET L$ !2 // get file#
1377 #SET I$ %!2 // get field# -- aha-new undocumented features
1378 Set piOrdering to (Which_Index(self,!l,!i))
1379 #POP L$
1380 #POP I$
1381 #ELSE
1382 Set piOrdering to !2 // if Index.# or # set piOrdering at compile-time
1383 #ENDIF
1384#ENDCOMMAND
1385
1386//
1387// Set the report Breaks
1388// Format: Report_Breaks Brk_1 Brk_2 ... Brk_n
1389//
1390//
1391#COMMAND Report_Breaks R
1392 #PUSH !i
1393 #SET I$ 0 // set I$ to the number of breakpoint arguments
1394 // This returns the outermost break level...if 0
1395 // then there was no break at all
1396 Function Test_BreakPoints Returns Integer
1397 Integer Arr# CBreak RCount
1398 Move oBreakArray to Arr# // do this to optimize
1399 Move 0 to CBreak // parsing speed
1400 Get piRecordCount to RCount
1401 // Create a "Get Test_One_BreakPoint" command for each breakpoint
1402 Multi$ Setup$Breaks !1 !2 !3 !4 !5 !6 !7 !8 !9
1403 Function_Return CBreak
1404 End_Function
1405
1406 Procedure Breaks_Set
1407 Set piNumberBreaks to !i
1408 End_Procedure
1409
1410 #POP I$
1411#ENDCOMMAND
1412
1413// Zero_Accumulator
1414#COMMAND Zero_SubTotals R // handy routine to zero any subtotals that
1415 Move 0 to !1% // might need zeroing before a report is run
1416 #IF !0>1 // i.e. Zero_SubTotal SubTotal.1 Subtotal.2 SubWindowName
1417 Zero_SubTotals !2 !3 !4 !5 !6 !7 !8 !9
1418 #ENDIF
1419#ENDCOMMAND
1420