CD Shareware Magazine 1996 December/CD_shareware_12-96.iso/WIN/Programa/RP_SHELL.ZIP/DEMOFORM.PAS

Pascal/Delphi Source File | 1996-06-10 | 13.6 KB | 435 lines

unit Demoform;

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  StdCtrls, ExtCtrls, SysUtils, Messages,
  RPFiler, RPBase, RPForm, Preview, Rp_Shel1;
type
  TBtnBottomDlg1 = class(TForm)
    OKBtn: TBitBtn;
    Bevel1: TBevel;
    btDetail: TButton;
    btMDetail: TButton;
    btMMDetail: TButton;
    RPMaster11: TRPMaster1;
    RPMaster12: TRPMaster1;
    RPDetail11: TRPDetail1;
    RPDetail12: TRPDetail1;
    RPDetail13: TRPDetail1;
    cbDetRGH: TCheckBox;
    cbDetNPOG: TCheckBox;
    cbDetNPOI: TCheckBox;
    cbMas01RH: TCheckBox;
    cbMas01NPOI: TCheckBox;
    cbMas02RH: TCheckBox;
    cbMas02NPOI: TCheckBox;
    cbMas01RGH: TCheckBox;
    cbMas01NPOG: TCheckBox;
    cbMas02RGH: TCheckBox;
    cbMas02NPOG: TCheckBox;
    BaseReport: TReportFiler;
    procedure RPMaster11ValidateItem(Sender: TRPShellBase1; First: Boolean;
      var Valid: Boolean);
    procedure RPMaster11FooterPrint(Sender: TRPShellBase1; BaseReport: TBaseReport);
    procedure RPMaster12FooterPrint(Sender: TRPShellBase1; BaseReport: TBaseReport);
    procedure RPMaster12ValidateItem(Sender: TRPShellBase1; First: Boolean;
      var Valid: Boolean);
    procedure RPDetailPrint(Sender: TRPShellBase1; BaseReport: TBaseReport);
    procedure ButtonClick(Sender: TObject);
    procedure BaseReportPrint(Sender: TObject);
    procedure RPMaster12ValidateChild(Sender: TRPShellBase1; First: Boolean;
      var Valid: Boolean);
    procedure RPDetailValidateItem(Sender: TRPShellBase1; First: Boolean;
      var Valid: Boolean);
    procedure RPDetailGroupFooterPrint(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPDetailGroupHeader(Sender: TRPShellBase1; First: Boolean;
      var Group: Boolean);
    procedure cbDetNPOIClick(Sender: TObject);
    procedure RPDetailSet(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPMaster11FooterSet(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPMaster12FooterSet(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPGroupFooterSet(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure BaseReportPrintHeader(Sender: TObject);
    procedure RPDetail11GroupHeaderPrint(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPDetail11GroupHeaderSet(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPMaster11HeaderSet(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPMaster11HeaderPrint(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPMaster12HeaderSet(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPMaster12HeaderPrint(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPMaster11BeforeFirstItem(Sender: TRPShellBase1;
      BaseReport: TBaseReport);
    procedure RPMaster11AfterPageBreak(Sender: TRPShellBase1;
      BaseReport: TBaseReport; Aborted: Boolean);
  private
  { Private declarations }
    RptType: integer;
    CurrentDetail,
    CurrentMaster,
    CurrentMaster2: integer;
    MaxDetail,
    MaxMaster,
    MaxMaster2: integer;
  public
    { Public declarations }
  end;

var
  BtnBottomDlg1: TBtnBottomDlg1;

implementation

{$R *.DFM}

procedure TBtnBottomDlg1.cbDetNPOIClick(Sender: TObject);
begin
  btMMDetail.Enabled := not ((cbDetNPOG.Checked) or (cbDetNPOI.Checked));
end;

procedure TBtnBottomDlg1.ButtonClick(Sender: TObject);
var
  ReportStream: TMemoryStream;
begin

{ Connect the Shell Components for the selected report }
  if Sender = btDetail then begin
    RptType := 1;
  end else if Sender = btMDetail then begin
    RptType := 2;
    RPMaster11.RPDetailChild  := RPDetail11;
  end else begin
    RptType := 3;
    RPMaster12.RPMasterParent := RPMaster11;
    RPMaster12.RPDetailChild  := RPDetail11;
  end; { if }

{ Initialize the random number generator }
  Randomize;

{ Set object properties according to user's selections }
  RPDetail11.ReprintGroupHeader := cbDetRGH.Checked;
  RPDetail12.ReprintGroupHeader := cbDetRGH.Checked;
  RPDetail13.ReprintGroupHeader := cbDetRGH.Checked;
  RPDetail11.NewPageOnItem := cbDetNPOI.Checked;
  RPDetail12.NewPageOnItem := cbDetNPOI.Checked;
  RPDetail13.NewPageOnItem := cbDetNPOI.Checked;
  RPDetail11.NewPageOnGroup := cbDetNPOG.Checked;
  RPDetail12.NewPageOnGroup := cbDetNPOG.Checked;
  RPDetail13.NewPageOnGroup := cbDetNPOG.Checked;
  RPMaster11.ReprintGroupHeader := cbMas01RGH.Checked;
  RPMaster11.NewPageOnGroup     := cbMas01NPOG.Checked;
  RPMaster12.ReprintGroupHeader := cbMas02RGH.Checked;
  RPMaster12.NewPageOnGroup     := cbMas02NPOG.Checked;
  RPMaster11.ReprintHeader := cbMas01RH.Checked;
  RPMaster11.NewPageOnItem := cbMas01NPOI.Checked;
  RPMaster12.ReprintHeader := cbMas02RH.Checked;
  RPMaster12.NewPageOnItem := cbMas02NPOI.Checked;

  { Create the report instance }
  ReportStream := TMemoryStream.Create;
  Application.CreateForm(TReportForm, ReportForm);
  try
    with ReportForm do begin
      BaseReport.FileName := 'RPT.TMP';
      RptBase := BaseReport;
      Caption := RptBase.Title;
      Show;
      end; { with }

    with BaseReport do begin
      Stream := ReportStream;
      Execute;
      if not Aborted then begin
        Application.CreateForm(TPreviewForm, PreviewForm);
        try
          with PreviewForm do begin
            FilePrInter1.FileName   := FileName;
            FilePrInter1.StreamMode := StreamMode;
            FilePrInter1.Title      := Title;
            FilePrInter1.Stream     := ReportStream;
            FilePrEview1.FileName   := FileName;
            FilePrEview1.StreamMode := StreamMode;
            FilePrEview1.Title      := Title;
            FilePrEview1.Stream     := ReportStream;
            WindowState             := wsMaximized;
            ShowModal;
            end; { with }
        finally
          PreviewForm.Free;
          end; { try }
        end; { if }
      end; { with }
  finally
    ReportStream.Free;
    ReportForm.Free;
    end;
end;

procedure TBtnBottomDlg1.BaseReportPrint(Sender: TObject);
begin
{ Execute the correct Shell component for the report's body }
  case RptType of
    1:   RPDetail11.Execute(Sender as TBaseReport);
    2,3: RPMaster11.Execute(Sender as TBaseReport);
  end; { case }
end;

procedure TBtnBottomDlg1.BaseReportPrintHeader(Sender: TObject);
begin
  with Sender as TBaseReport do begin
  { Enclose report body section with a border }
    MarginTop    := 1.00;
    MarginBottom := 1.00;
    MarginLeft   := 1.00;
    MarginRight  := 1.00;
  { Draw border for report body section }
    MoveTo( SectionLeft,   SectionTop    );
    LineTo( SectionRight,  SectionTop    );
    LineTo( SectionRight,  SectionBottom );
    LineTo( SectionLeft,   SectionBottom );
    LineTo( SectionLeft,   SectionTop    );
  end; { with }
end;

{-----------------------------  Master01  -------------------------------------}

procedure TBtnBottomDlg1.RPMaster11ValidateItem(Sender: TRPShellBase1; First: Boolean;
  var Valid: Boolean);
begin
  if First then begin
    CurrentMaster := 1;
    MaxMaster     := 5 + Integer(Random( 5));
  end else begin
    CurrentMaster := CurrentMaster + 1;
  end; { if }
  Valid := CurrentMaster <= MaxMaster;
end;

procedure TBtnBottomDlg1.RPMaster11BeforeFirstItem(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  (Sender as TRPMaster1).PrintHeader;
end;

procedure TBtnBottomDlg1.RPMaster11AfterPageBreak(Sender: TRPShellBase1;
  BaseReport: TBaseReport; Aborted: Boolean);
begin
  (Sender as TRPMaster1).PrintHeader;
end;

procedure TBtnBottomDlg1.RPMaster11HeaderSet(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  with BaseReport do begin
    ClearTabs;
    if Sender.UserReprint then begin
      SetFont( 'Times New Roman', 20 );
      SetTab( SectionLeft, pjLeft, SectionRight -
                                   SectionLeft, 5, BOXLINEALL, 60);
      (Sender as TRPMaster1).HeaderLines := 1;
    end else begin
      SetFont( 'Times New Roman', 16 );
      SetTab( 1.0, pjLeft, 4.0, 5, BOXLINENONE, 40);
      (Sender as TRPMaster1).HeaderLines := 3;
    end; { if }
  end; { with }
end;

procedure TBtnBottomDlg1.RPMaster11HeaderPrint(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  with BaseReport do begin
    if Sender.UserReprint then begin
      Print( #9'Page ' + IntToStr(CurrentPage) + ' Header ' + '  ( User )');
    end else begin
      Print( #9);
      CRLF;
      if Sender.SysReprint then begin
        Print( #9'RPMaster01 Header ' + IntToStr(CurrentMaster) + '  ( Reprint )');
      end else begin
        Print( #9'RPMaster01 Header ' + IntToStr(CurrentMaster) + '  ( Normal )');
      end; { if }
      CRLF;
      Print( #9);
    end; { if UserReprint }
  end; { with BaseReport }
end;

procedure TBtnBottomDlg1.RPMaster11FooterSet(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  with BaseReport do begin
    SetFont( 'Times New Roman', 16 );
    ClearTabs;
    SetTab( 1.0, pjLeft, 4.0, 5, BOXLINENONE, 40);
  end; { with }
end;

procedure TBtnBottomDlg1.RPMaster11FooterPrint(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  BaseReport.PrintLn( #9);
  BaseReport.PrintLn( #9'RPMaster01 Footer ' + IntToStr(CurrentMaster));
  BaseReport.Print( #9);
end;

{-----------------------------  Master02  -------------------------------------}

procedure TBtnBottomDlg1.RPMaster12ValidateItem(Sender: TRPShellBase1; First: Boolean;
  var Valid: Boolean);
begin
  if First then begin
    CurrentMaster2 := 1;
    MaxMaster2     := 6 + Integer(Random(10));
  end else begin
    CurrentMaster2 := CurrentMaster2 + 1;
  end; { if }
  Valid := CurrentMaster2 <= MaxMaster2;
end;

procedure TBtnBottomDlg1.RPMaster12ValidateChild(Sender: TRPShellBase1;
  First: Boolean; var Valid: Boolean);
begin
  Valid := true;
  with Sender as TRPMaster1 do begin
    if First then begin
      RPDetailChild := RPDetail11;
    end else if RPDetailChild = RPDetail11 then begin
      RPDetailChild := RPDetail12;
    end else if RPDetailChild = RPDetail12 then begin
      RPDetailChild := RPDetail13;
    end else begin
      Valid := false;
    end; { if }
  end; { with }
end;

procedure TBtnBottomDlg1.RPMaster12HeaderSet(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  with BaseReport do begin
    SetFont( 'Times New Roman', 14 );
    ClearTabs;
    SetTab( 2.0, pjLeft, 4.0, 5, BOXLINENONE, 30);
  end; { with }
end;

procedure TBtnBottomDlg1.RPMaster12HeaderPrint(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  with BaseReport do begin
    if Sender.SysReprint then begin
      Print( #9'RPMaster02 Header ' + IntToStr(CurrentMaster2) + '  ( Reprint )');
    end else begin
      Print( #9'RPMaster02 Header ' + IntToStr(CurrentMaster2) + '  ( Normal )');
    end; { if }
  end; { with }
end;

procedure TBtnBottomDlg1.RPMaster12FooterSet(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  with BaseReport do begin
    SetFont( 'Times New Roman', 14 );
    ClearTabs;
    SetTab( 2.0, pjLeft, 4.0, 5, BOXLINENONE, 30);
  end; { with }
end;

procedure TBtnBottomDlg1.RPMaster12FooterPrint(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  BaseReport.Print( #9'RPMaster02 Footer ' + IntToStr(CurrentMaster2));
end;

{-----------------------------  Detail01  -------------------------------------}

procedure TBtnBottomDlg1.RPDetailValidateItem(Sender: TRPShellBase1;
  First: Boolean; var Valid: Boolean);
begin
  if First then begin
    CurrentDetail := 1;
    MaxDetail     := 5 + Integer(Random(15));
  end else begin
    CurrentDetail := CurrentDetail + 1;
  end; { if }
  Valid := CurrentDetail <= MaxDetail;
end;

procedure TBtnBottomDlg1.RPDetailSet(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  with BaseReport do begin
    SetFont( 'Times New Roman', 10 );
    ClearTabs;
    SetTab( 3.0, pjLeft, 4.0, 5, BOXLINEALL, Sender.Tag * 5);
  end; { with }
end;

procedure TBtnBottomDlg1.RPDetailPrint(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  BaseReport.Print( #9'Detail' + IntToStr(Sender.Tag) + '  ' + IntToStr(CurrentDetail));
end;

{ Group Stuff }

procedure TBtnBottomDlg1.RPDetail11GroupHeaderSet(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  with BaseReport do begin
    SetFont( 'Times New Roman', 12 );
    ClearTabs;
    SetTab( 2.5, pjLeft, 4.0, 5, BOXLINENONE, 20);
  end; { with }
end;

procedure TBtnBottomDlg1.RPDetail11GroupHeaderPrint(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  with BaseReport do begin
    if Sender.SysReprint then begin
      Print( #9'RPDetail' + IntToStr(Sender.Tag) + ' Group Header ( Reprint )');
    end else begin
      Print( #9'RPDetail' + IntToStr(Sender.Tag) + ' Group Header ');
    end; { if }
  end; { with }
end;

procedure TBtnBottomDlg1.RPDetailGroupHeader(Sender: TRPShellBase1;
  First: Boolean; var Group: Boolean);
begin
  Group := (First) or (((CurrentDetail - 1) mod 3) = 0);
end;

procedure TBtnBottomDlg1.RPGroupFooterSet(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  with BaseReport do begin
    SetFont( 'Times New Roman', 12 );
    ClearTabs;
    SetTab( 2.5, pjLeft, 4.0, 5, BOXLINENONE, 20);
  end; { with }
end;

procedure TBtnBottomDlg1.RPDetailGroupFooterPrint(Sender: TRPShellBase1;
  BaseReport: TBaseReport);
begin
  BaseReport.Print( #9'RPDetail' + IntToStr(Sender.Tag) + ' Group Footer ');
end;

{------------------------------------------------------------------------------}

end.