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