Delphi 2.0 - Programmer's Utilities Power Pack/Delphi 2.0 Programmer's Utilities Power Pack.iso/m_to_r/reporter/fishrpt1.pas

Pascal/Delphi Source File | 1996-09-15 | 6.6 KB | 243 lines

 unit Fishrpt1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Reports, StdCtrls, DB, DBTables;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Table1: TTable;
    Table1SpeciesNo: TFloatField;
    Table1Category: TStringField;
    Table1Common_Name: TStringField;
    Table1SpeciesName: TStringField;
    Table1Lengthcm: TFloatField;
    Table1Length_In: TFloatField;
    Table1Notes: TMemoField;
    Table1Graphic: TGraphicField;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Procedure ReportInit;
    Procedure ReportDone;

    Procedure PrintHeader     ( HeaderBand  : tFixedReportBand;
                                var Status  : tBandStatus );

    Procedure InitItem        ( DetailBand  : tRecurringReportBand );
    Procedure PrintItem       ( DetailBand  : tFixedReportBand;
                                var Status  : tBandStatus );

  end;

var
  Form1: TForm1;

implementation
Uses pStatus;

{$R *.DFM}

procedure tForm1.ReportInit;
Begin
     { prevent user from pressing key while printing }
     Enabled := False;

     With PrintStatusForm Do
     Begin
          ProgressGauge.MaxValue := 100;
          ProgressGauge.Progress := 0;
          CurrentPage := 1;
          PrintStatus := 'Loading Data...';
          PrinterName := Reporter.Printers[Reporter.PrinterIndex];
          Show;
          UpdateStatus;
     End;

     { Open needed table(s) }
     Table1.Open;


     With PrintStatusForm Do
     Begin
          ProgressGauge.MaxValue := Table1.RecordCount;
          PrintStatus := 'Printing...';
          UpdateStatus;
     End;

     { set up the margins and define the font styles }
     With Reporter Do
     Begin
          TopMargin.AsInches := 1.5;
          LeftMargin.AsInches := 0.5;
          RightMargin.AsInches := 0.5;
          BottomMargin.AsInches := 1.0;

          PreferredUnit := puInches;
          StretchBand := True;

          Canvas.Font.Size := 10;
          Canvas.Font.Style := [fsBold];
          CreateFontStyle ( 'Heading1' );
          CreateFontStyle ( 'Detail1' );

          Canvas.Font.Size := 18;
          CreateFontStyle ( 'Heading2' );

          Canvas.Font.Size := 10;
          Canvas.Font.Style := [];
          CreateFontStyle ( 'Detail2' );

          Canvas.Font.Style := [fsItalic];
          CreateFontStyle ( 'Detail3' );
     End;
End;

procedure tForm1.ReportDone;
Begin
     { Close opened table(s) }
     Table1.Close;

     { get rid of the print status dialog and enable the form again }
     Enabled := True;

     PrintStatusForm.Close;
End;

procedure tForm1.PrintHeader (     HeaderBand : tFixedReportBand;
                               var Status     : tBandStatus );
Begin
     With HeaderBand, Reporter Do
     Begin
          { do all the text output now }

          { save the current font }
          SaveFont;

          SetFontStyle ( 'Heading1' );
          TextOut ( 'Page ' + IntToStr ( PageNumber ),
                    ttaRightMargin + ttaTopOfBand );


          SetFontStyle ( 'Heading2' );
          BoxTextOut ( 'Lots O'' Fishies', ttaBandHCenter + ttaBandVCenter,
                       btBox, 20, 10,
                       stBottomRight, 20 );

          { restore previous font }
          RestoreFont;

     End;
End;

procedure tForm1.InitItem ( DetailBand : tRecurringReportBand );
Begin
     { Here we inform the Reporter of the height of the Detail band.
       This allows it to avoid breaking a record across pages.  I'm
       giving each band the height of a graphic plus an 1/8th inch,
       plus the height of the memo }

     With DetailBand, Reporter Do
     Begin
          SetBandBegin;

          PlaceDBGraphic ( Table1.FieldByName('Graphic'), ttaLeft,
                           0, 0, 200, 200 );
          AdjustY ( 0.125 );
          DBMemoOut ( Table1.FieldByName('Notes'), 0, 7.5,
                      ttaLeftMargin );

          SetBandEnd;
     End;
End;

procedure tForm1.PrintItem   (     DetailBand : tFixedReportBand;
                               var Status     : tBandStatus );
Var
   SaveX : Word;
Begin
     With DetailBand, Reporter Do
     Begin
          PlaceDBGraphic ( Table1.FieldByName('Graphic'), ttaLeft, 0, 0, 200, 200 );

          { print out special notes on the fish }
          AdjustY ( 0.125 );

          SetFontStyle ( 'Detail2' );
          DBMemoOut ( Table1.FieldByName('Notes'), 0, 7.5,
                      ttaLeftMargin );


          { print out single line description data }
          TopOfBand;

          SetFontStyle ( 'Detail1' );
          TabTo ( 1.75 );
          TextOut ( 'Category: ', ttaLeft );
          SetFontStyle ( 'Detail2' );
          TabTo ( 2.5 );
          TextOut ( Table1.FieldByName('Category').AsString, ttaLeft );
          NextLine;

          SetFontStyle ( 'Detail1' );
          TabTo ( 1.75 );
          TextOut ( 'Name: ', ttaLeft );
          SetFontStyle ( 'Detail2' );
          TabTo ( 2.5 );
          TextOut ( Table1.FieldByName('Common_Name').AsString, ttaLeft );
          NextLine;
          SetFontStyle ( 'Detail3' );
          TabTo ( 2.5 );
          TextOut ( '    (' + Table1.FieldByName('Species Name').AsString + ')', ttaLeft );
          NextLine;

          SetFontStyle ( 'Detail1' );
          TabTo ( 1.75 );
          TextOut ( 'Length: ', ttaLeft );
          SetFontStyle ( 'Detail2' );
          TabTo ( 2.5 );
          TextOut ( FloatToStrF ( Table1.FieldByName('Length_IN').AsFloat, ffNumber, 5, 2 ) + ' in.', ttaLeft );
          SetFontStyle ( 'Detail3' );
          TextOut ( '    (' + FloatToStrF ( Table1.FieldByName('Length (cm)').AsFloat, ffNumber, 6, 2 ) + ' cm)', ttaleft );

     End;

     With PrintStatusForm Do
     Begin
          ProgressGauge.Progress := ProgressGauge.Progress + 1;
          CurrentPage := Reporter.PageNumber;
          UpdateStatus;
     End;

     Table1.Next;
     If PrintStatusForm.Canceled Then
        Status := bsAbort
     Else If Table1.EOF Then
        Status := bsDone;
End;


procedure TForm1.Button1Click(Sender: TObject);
begin
     Reporter.OnReportInit := ReportInit;
     Reporter.OnReportDone := ReportDone;

     Reporter.AddHeader ( PrintHeader );
     Reporter.AddDetail ( InitItem, PrintItem );

     Reporter.Run;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
     Reporter.Abort;
end;

end.