[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    {
    Here is an example that prints columns that are right, left, and center
    justified.  There are headers, footers, and, generally, a bunch o' things
    here.  This app encapsulates functionality to print text, lines, boxes
    and shaded boxes. Text can be left or right justified and centered.
    Columns can be  created and text can be left or right justified within the
    columns or  text can be centered.  Lines of any thickness can be drawn.
    Boxes can be drawn with any thickness.  The boxes can be shaded if desired.
    Headers and footers can be created and the header/footer areas can be shaded
    if desired.  Page numbering can contain custom text and can be placed
    anywhere desired.
    }

    {******* prnMain.pas *******}

    unit Prnmain;

    interface

    uses
      SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
      Forms, Dialogs, StdCtrls, ExtCtrls, Printers;

    const
      HeaderLines = 5;                        { Number of allowable header lines }
      FooterLines = 5;                        { Number of allowable footer lines }
      Columns = 20;                           { Number of allowable columns }

    type
      THeaderRecord = Record
         Text: String[240];                   { Header text }
         YPosition: Single;                   { Inches from the top }
         Alignment: Integer;                  { 0:Left 1:Center 2:Right }

         FontName: String[80];                { Font name }
         FontSize: Integer;                   { Font size }
         FontStyle: TFontStyles;              { Font style }
         End;

      TFooterRecord = Record
         Text: String[240];                   { Footer text }
         YPosition: Single;                   { Inches from the top }
         Alignment: Integer;                  { 0:Left 1:Center 2:Right }
         FontName: String[80];                { Font name }
         FontSize: Integer;                   { Font size }
         FontStyle: TFontStyles;              { Font style }

         End;

      THeaderCoordinates = Record
         XTop: Single;
         YTop: Single;
         XBottom: Single;
         YBottom: Single;
         Boxed: Boolean;
         Shading: Word;
         LineWidth: Word;
         End;

      TFooterCoordinates = Record
         XTop: Single;
         YTop: Single;
         XBottom: Single;
         YBottom: Single;
         Boxed: Boolean;
         Shading: Word;
         LineWidth: Word;
         End;

      TPageNumberRecord = Record
         YPosition: Single;
         Text: String[240];
         Alignment: Word;
         FontName: String[80];
         FontSize: Word;
         FontStyle: TFontStyles;

         End;

      TColumnInformationRecord = Record
         XPosition: Single;
         Length: Single;
         End;

      TPrintObject = class
         private
            TopMargin: Integer;               { Top margin in pixels }
            BottomMargin: Integer;            { Bottom margin in pixels }
            LeftMargin: Integer;              { Left margin in pixels }
            RightMargin: Integer;             { Right margin in pixels }
            PixelsPerInchVertical: Integer;   { Number of pixels per inch along Y axis }
            PixelsPerInchHorizontal: Integer; { Number of pixels per inch along X axis }
            TotalPageWidthPixels: Integer;    { Full width of page in pixels - includes gutters }

            TotalPageHeightPixels: Integer;   { Full height of page in pixels - includes gutters }
            TotalPageHeightInches: Single;    { Height of page in inches }
            TotalPageWidthInches: Single;     { Width of page in inches }
            GutterLeft: Integer;              { Unprintable area on left }
            GutterRight: Integer;             { Unprintable area on right }
            GutterTop: Integer;               { Unprintable area on top }
            GutterBottom: Integer;            { Unprintable area on bottom }
            DetailTop: Single;                { Inches from the top where the detail section starts }
            DetailBottom: Single;             { Inches from the top where the detail section ends }

            LastYPosition: Single;            { The Y position where the last write occurred }
            AutoPaging: Boolean;              { Are new pages automatically generated? }
            CurrentTab: Single;               { The value of the current tab }
            CurrentFontName: String[30];
            CurrentFontSize: Integer;
            CurrentFontStyle: TFontStyles;
            TextMetrics: TTextMetric;
            Header: Array[1..HeaderLines] of THeaderRecord;
            Footer: Array[1..FooterLines] of TFooterRecord;
            ColumnInformation: Array[1..Columns] of TColumnInformationRecord;
            PageNumber: TPageNumberRecord;

            HeaderCoordinates: THeaderCoordinates;
            FooterCoordinates: TFooterCoordinates;
            function CalculateLineHeight: Integer;
            function InchesToPixelsHorizontal( Inches: Single ): Integer;
            function InchesToPixelsVertical( Inches: Single ): Integer;
            function PixelsToInchesHorizontal( Pixels: Integer ): Single;
            function PixelsToInchesVertical( Pixels: Integer ): Single;
            function LinesToPixels( Line:Integer ): Integer;
            procedure CalculateMeasurements;
            procedure _DrawBox( XTop:Word; YTop:Word; XBottom:Word; YBottom:Word; LineWidth:Word; Shading:Word );
         public
            procedure Start;

            procedure Quit;
            procedure Abort;
            procedure SetMargins( Top:Single; Bottom:Single; Left:Single; Right:Single );
            procedure SetFontInformation( Name:String; Size:Word; Style: TFontStyles );
            procedure WriteLine( X:Single; Y:Single; Text:String );
            procedure WriteLineRight( Y:Single; Text:String );
            procedure WriteLineCenter( Y:Single; Text:String );
            procedure WriteLineColumnRight( ColumnNumber:Word; Y:Single; Text:String );
            procedure WriteLineColumnCenter( ColumnNumber:Word; Y:Single; Text:String );
            procedure DrawLine( TopX:Single; TopY:Single; BottomX:Single; BottomY:Single; LineWidth:Word );
            procedure SetLineWidth( Width:Word );

            function  GetLineWidth: Word;
            procedure SetTab( Inches:Single );
            procedure NewPage;
            function  GetLinesPerPage: Integer;
            procedure GetPixelsPerInch( var X:Word; var Y:Word );
            procedure GetPixelsPerPage( var X:Word; var Y:Word );
            procedure GetGutter( var Top:Word; var Bottom:Word; var Left:Word; var Right:Word );
            function  GetTextWidth( Text:String ): Integer;
            function  GetLineHeightPixels: Word;
            function  GetLineHeightInches: Single;
            function  GetPageNumber:Integer;
            function  GetColumnsPerLine: Integer;
            procedure SetOrientation( Orient: TPrinterOrientation );

            procedure SetHeaderInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word;
                         FontName:String; FontSize: Word; FontStyle: TFontStyles );
            procedure SetFooterInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word;
                         FontName:String; FontSize: Word; FontStyle: TFontStyles );
            procedure WriteHeader;
            procedure WriteFooter;
            procedure SaveCurrentFont;
            procedure RestoreCurrentFont;
            procedure SetDetailTopBottom( Top: Single; Bottom: Single );
            procedure SetAutoPaging( Value: Boolean );
            procedure SetPageNumberInformation( YPosition:Single; Text:String; Alignment:Word; FontName:String;
                         FontSize:Word; FontStyle:TFontStyles );

            procedure WritePageNumber;
            procedure WriteLineColumn( ColumnNumber:Word; Y:Single; Text:String );
            procedure DrawBox( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word );
            procedure DrawBoxShaded( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word; Shading:Word );
            procedure SetHeaderDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
                      Boxed: Boolean; LineWidth:Word; Shading:Word );
            procedure SetFooterDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
                      Boxed: Boolean; LineWidth:Word; Shading:Word );
            procedure CreateColumn( Number:Word; XPosition:Single; Length:Single );
            procedure SetYPosition( YPosition:Single );
            function  GetYPosition: Single;
            procedure NextLine;
            function  GetLinesLeft: Word;
            function  GetLinesInDetailArea: Word;

            procedure SetTopOfPage;
            procedure NewLines( Number:Word );
            function GetFontName: String;
            function GetFontSize: Word;
       End;

    implementation

    procedure TPrintObject.Start;

       { This function MUST be called first before any other printing function }

       var
          Top,Bottom,Left,Right: Single;
          I: Integer;

       Begin
       Printer.BeginDoc;

       AutoPaging := True;

       CalculateMeasurements;

       PageNumber.Text := '';

       Top := PixelsToInchesVertical( GutterTop );
       Bottom := PixelsToInchesVertical( GutterBottom );
       Left := PixelsToInchesHorizontal( GutterLeft );
       Right := PixelsToInchesHorizontal( GutterRight );
       SetMargins( Top,Bottom,Left,Right );

       For I := 1 To HeaderLines Do

          Header[I].Text := '';
       HeaderCoordinates.Boxed := False;
       HeaderCoordinates.Shading := 0;
       For I := 1 To FooterLines Do
          Footer[I].Text := '';
       FooterCoordinates.Boxed := False;
       FooterCoordinates.Shading := 0;

       CurrentTab := 0.0;

       LastYPosition := 0.0;
       End;

    procedure TPrintObject.Quit;

       { 'Quit' must always be called when printing is completed }

       Begin
       WriteHeader;
       WriteFooter;
       WritePageNumber;

       Printer.EndDoc
       End;

    procedure TPrintObject.SetMargins( Top:Single; Bottom:Single; Left:Single; Right:Single );

       { Set the top, bottom, left and right margins in inches }

       var
          Value: Single;
          Buffer: String;

       Begin
       { If the sum of the left and right margins exceeds the width of the page,
         set the left margin to the value of 'GutterLeft' and set the right
         margin to the value of 'GutterRight' }
       If ( Left + Right >= TotalPageWidthInches ) Then
          Begin
          Left := GutterLeft;
          Right := GutterRight;
          End;
       If ( Left <= 0 ) Then
          Left := GutterLeft;
       If ( Right <= 0 ) Then
          Right := GutterRight;

       { If the sum of the top and bottom margins exceeds the height of the
         page, set the top margin to the value of 'GutterTop' and set the
         bottom margin to the value of 'GutterBottom' }

       If ( Top + Bottom >= TotalPageHeightInches ) Then
          Begin
          Top := GutterTop;
          Bottom := GutterBottom;
          End;
       If ( Top <= 0 ) Then
          Top := GutterTop;
       If ( Bottom <= 0 ) Then
          Bottom := GutterBottom;

       { Convert everything to pixels }
       TopMargin := InchesToPixelsVertical( Top );
       If ( TopMargin < GutterTop ) Then
          TopMargin := GutterTop;

       BottomMargin := InchesToPixelsVertical( Bottom );
       If ( BottomMargin < GutterBottom ) Then
          BottomMargin := GutterBottom;

       LeftMargin := InchesToPixelsHorizontal( Left );
       If ( LeftMargin < GutterLeft ) Then
          LeftMargin := GutterLeft;

       RightMargin := InchesToPixelsHorizontal( Right );

       If ( RightMargin < GutterRight ) Then
          RightMargin := GutterRight;
       End;

    procedure TPrintObject.WriteLine( X:Single; Y:Single; Text:String );

       { Write some text.  The parameters represent inches from the left ('X')
         and top ('Y') margins. }

       var
          XPixels: Integer;
          YPixels: Integer;

       Begin
       { How many pixels are there in the inches represented by 'X'? }
       If ( X >= 0.0 ) Then
          XPixels := InchesToPixelsHorizontal( X )
       Else
          XPixels := LeftMargin;
       If ( XPixels < GutterLeft ) Then
          XPixels := GutterLeft;

       { If there is a tab set, increase 'XPixels' by the amount of the tab }
       If ( CurrentTab > 0.0 ) Then

          Inc( XPixels,InchesToPixelsHorizontal(CurrentTab) );

       { How many pixels are there in the inches represented by 'Y'? }
       If ( Y > -0.01 ) Then
          { Printing will occur at an absolute location from the top of the
            page. }
          Begin
          YPixels := InchesToPixelsVertical( Y );
          If ( YPixels < GutterTop ) Then
             YPixels := GutterTop;
          If ( YPixels > TotalPageHeightPixels ) Then
             YPixels := TotalPageHeightPixels - GutterBottom;

          LastYPosition := Y;
          End;
       If ( Y = -1.0 ) Then
          { Write the text at the next line }
          Begin
          If ( AutoPaging = True ) Then
             Begin
             { If the next line we're going to write to exceeds beyond the

               bottom of the detail section, issue a new page }
             If ( LastYPosition + GetLineHeightInches > DetailBottom ) Then
                NewPage;
             End;
          YPixels := InchesToPixelsVertical( LastYPosition + GetLineHeightInches );
          LastYPosition := LastYPosition + GetLineHeightInches;
          End;
       If ( Y = -2.0 ) Then
          { Write the text on the current line }
          YPixels := InchesToPixelsVertical( LastYPosition );

       Printer.Canvas.TextOut( XPixels-GutterLeft,YPixels-GutterTop,Text );
       End;

    procedure TPrintObject.WriteLineColumn( ColumnNumber:Word; Y:Single; Text:String );

       { Write text, left aligned against the column represented by
         'ColumnInformation[ColumnNumber]' }

       Begin
       WriteLine( ColumnInformation[ColumnNumber].XPosition,Y,Text );

       End;

    procedure TPrintObject.WriteLineColumnRight( ColumnNumber:Word; Y:Single; Text:String );

       { Write text, right aligned against the column represented by
         'ColumnInformation[ColumnNumber]' }

       var
          PixelLength: Word;
          StartPixel: Word;

       Begin
       { How many pixels does the text in 'Text' require? }
       PixelLength := Printer.Canvas.TextWidth( Text );

       { Calculate where printing should start }
       StartPixel := InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].XPosition +
          ColumnInformation[ColumnNumber].Length ) - PixelLength;

       SetTab( 0.0 );
       WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
       SetTab( CurrentTab );
       End;

    procedure TPrintObject.WriteLineRight( Y:Single; Text:String );

       { Print a line of text right justified 'Y' inches from the top }

       var
          PixelLength: Word;
          StartPixel: Word;

       Begin
       { How many pixels does the text in 'Text' require? }
       PixelLength := Printer.Canvas.TextWidth( Text );

       { Calculate where printing should start }
       StartPixel := (TotalPageWidthPixels-GutterLeft-GutterRight) - PixelLength;

       SetTab( 0.0 );
       WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
       SetTab( CurrentTab );
       End;

    procedure TPrintObject.WriteLineCenter( Y:Single; Text:String );

       { Print a line of text centered at Y inches from the top }

       var
          PixelLength: Integer;
          StartPixel: Integer;

       Begin
       { How many pixels does the text in 'Text' require? }
       PixelLength := Printer.Canvas.TextWidth( Text );

       { Calculate where printing should start }
       StartPixel := ((GutterLeft+(TotalPageWidthPixels-GutterRight)) Div 2) - (PixelLength Div 2);

       SetTab( 0.0 );
       WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );

       SetTab( CurrentTab );
       End;

    procedure TPrintObject.WriteLineColumnCenter( ColumnNumber:Word; Y:Single; Text:String );

       { Print a line of text centered within the column number represented by
         'ColumnNumber', at Y inches from the top }

       var
          PixelLength: Integer;
          StartPixel: Integer;
          Pixels: Integer;

       Begin
       { How many pixels does the text in 'Text' require? }
       PixelLength := Printer.Canvas.TextWidth( Text );

       { Calculate where printing should start }
       Pixels := InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].Length );
       StartPixel := (InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].Length ) Div 2) +
          InchesToPixelsHorizontal(ColumnInformation[ColumnNumber].XPosition) - (PixelLength Div 2);

       SetTab( 0.0 );
       WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
       SetTab( CurrentTab );
       End;

    procedure TPrintObject.DrawLine( TopX:Single; TopY:Single; BottomX:Single; BottomY:Single; LineWidth:Word );

       { Draw a line beginning at a particular X,Y coordinate and ending at a
         particular X,Y coordinate. }

       var
          TopXPixels, BottomXPixels, TopYPixels, BottomYPixels: Integer;

       Begin
       TopXPixels := InchesToPixelsHorizontal( TopX );
       BottomXPixels := InchesToPixelsHorizontal( BottomX );
       TopYPixels := InchesToPixelsVertical( TopY );
       BottomYPixels := InchesToPixelsVertical( BottomY );

       Dec( TopXPixels,GutterLeft );
       Dec( BottomXPixels,GutterLeft );
       Dec( TopYPixels,GutterTop );
       Dec( BottomYPixels,GutterTop );

       Printer.Canvas.Pen.Width := LineWidth;

       Printer.Canvas.MoveTo( TopXPixels,TopYPixels );
       Printer.Canvas.LineTo( BottomXPixels,BottomYPixels );
       End;

    procedure TPrintObject.SetFontInformation( Name:String; Size:Word; Style: TFontStyles );

       { Change the current font information }

       Begin
       Printer.Canvas.Font.Name := Name;
       Printer.Canvas.Font.Size := Size;
       Printer.Canvas.Font.Style := Style;

       CalculateMeasurements;
       End;

    function TPrintObject.GetFontName: String;

       { Return the current font name }

       Begin
       Result := Printer.Canvas.Font.Name;
       End;

    function TPrintObject.GetFontSize: Word;

       { Return the current font size }

       Begin
       Result := Printer.Canvas.Font.Size;
       End;

    procedure TPrintObject.SetOrientation( Orient: TPrinterOrientation );

       Begin
       Printer.Orientation := Orient;

       CalculateMeasurements;
       End;

    function TPrintObject.CalculateLineHeight: Integer;

       { Calculate the height of a line plus the normal amount of space between
         each line }

       Begin
       Result := TextMetrics.tmHeight + TextMetrics.tmExternalLeading;
       End;

    procedure TPrintObject.NewPage;

       { Issue a new page }

       Begin
       WriteHeader;
       WriteFooter;
       WritePageNumber;
       LastYPosition := DetailTop - GetLineHeightInches;

       Printer.NewPage;

       End;

    function TPrintObject.GetPageNumber;

       { Return the current page number }

       Begin
       Result := Printer.PageNumber;
       End;

    function TPrintObject.GetTextWidth( Text:String ): Integer;

       { Return the width of the text contained in 'Text' in pixels }

       Begin
       Result := Printer.Canvas.TextWidth( Text );
       End;

    function TPrintObject.GetLineHeightPixels: Word;

       Begin
       Result := CalculateLineHeight;
       End;

    function TPrintObject.GetLineHeightInches: Single;

       Begin
       Result := PixelsToInchesVertical( GetLineHeightPixels );
       End;

    procedure TPrintObject._DrawBox( XTop:Word; YTop:Word; XBottom:Word; YBottom:Word; LineWidth:Word; Shading:Word );

       { The low level routine which actually draws the box and shades it as

         desired. The paramaters are in pixels and not inches. }

       Begin
       Printer.Canvas.Pen.Width := LineWidth;
       Printer.Canvas.Brush.Color := RGB( Shading,Shading,Shading );

       Printer.Canvas.Rectangle( XTop,YTop,XBottom,YBottom );
       End;

    procedure TPrintObject.DrawBox( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word );

       { Draw a box at the X,Y coordinates passed in the parameters }

       var
          BLinePixels,BColPixels,ELinePixels,EColPixels: Integer;

       Begin
       BLinePixels := InchesToPixelsVertical( YTop ) - GutterTop;
       ELinePixels := InchesToPixelsVertical( YBottom ) - GutterTop;

       BColPixels := InchesToPixelsHorizontal( XTop ) - GutterLeft;
       EColPixels := InchesToPixelsHorizontal( XBottom ) - GutterLeft;

       _DrawBox( BColPixels,BLinePixels,EColPixels,ELinePixels,LineWidth,255 );
       End;

    procedure TPrintObject.DrawBoxShaded( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word; Shading:Word );

       { Draw a box at the X,Y coordinates passed in the parameters }

       var
          BLinePixels,BColPixels,ELinePixels,EColPixels: Integer;

       Begin
       BLinePixels := InchesToPixelsVertical( YTop ) - GutterTop;
       ELinePixels := InchesToPixelsVertical( YBottom ) - GutterTop;

       BColPixels := InchesToPixelsHorizontal( XTop ) - GutterLeft;
       EColPixels := InchesToPixelsHorizontal( XBottom ) - GutterLeft;

       _DrawBox( BColPixels,BLinePixels,EColPixels,ELinePixels,LineWidth,Shading );
       End;

    function TPrintObject.GetLinesPerPage: Integer;

       { Return the number of lines on the entire page }

       Begin
       Result := (TotalPageHeightPixels - GutterTop - GutterBottom) Div CalculateLineHeight;
       End;

    function TPrintObject.GetLinesInDetailArea: Word;

       { Return the number of lines in the detail area }

       Begin
       Result := InchesToPixelsVertical( DetailBottom - DetailTop ) Div CalculateLineHeight;
       End;

    procedure TPrintObject.GetPixelsPerInch( var X:Word; var Y:Word );

       Begin
       X := PixelsPerInchHorizontal;
       Y := PixelsPerInchVertical;
       End;

    procedure TPrintObject.GetPixelsPerPage( var X:Word; var Y:Word );

       Begin
       X := TotalPageWidthPixels - GutterLeft - GutterRight;
       Y := TotalPageHeightPixels - GutterTop - GutterBottom;
       End;

    procedure TPrintObject.GetGutter( var Top:Word; var Bottom:Word; var Left:Word; var Right:Word );

       Begin
       Top := GutterTop;
       Bottom := GutterBottom;
       Left := GutterLeft;
       Right := GutterRight;
       End;

    procedure TPrintObject.Abort;

       Begin
       Printer.Abort;
       End;

    function TPrintObject.GetColumnsPerLine: Integer;

       { How many columns are there in a Line? }

       var
          Pixels: Integer;

       Begin
       Pixels := TotalPageWidthPixels - GutterLeft - GutterRight;

       Result := Pixels Div Printer.Canvas.TextWidth( 'B' );
       End;

    function TPrintObject.InchesToPixelsHorizontal( Inches: Single ): Integer;

       { Convert the horizontal inches represented in 'Inches' to pixels }

       var
          Value: Single;
          Buffer: String;
          I: Integer;

       Begin
       Value := Inches * PixelsPerInchHorizontal;
       Buffer := FloatToStr( Value );

       { If there is a decimal point in 'Buffer', remove it. }
       I := 1;
       While( (Buffer[I] <> '.') And (I <= Length(Buffer)) ) Do
          Inc( I );
       Buffer[0] := Chr( I-1 );

       Result := StrToInt( Buffer );
       End;

    function TPrintObject.InchesToPixelsVertical( Inches: Single ): Integer;

       { Convert the vertical inches represented in 'Inches' to pixels }

       var
          Value: Single;
          Buffer: String;
          I: Integer;

       Begin
       Value := Inches * PixelsPerInchVertical;
       Buffer := FloatToStr( Value );

          { If there is a decimal point in 'Buffer', remove it. }
       I := 1;
       While( (Buffer[I] <> '.') And (I <= Length(Buffer)) ) Do
          Inc( I );
       Buffer[0] := Chr( I-1 );

       Result := StrToInt( Buffer );
       End;

    function TPrintObject.PixelsToInchesHorizontal( Pixels: Integer ): Single;

       Begin
       Result := Pixels / PixelsPerInchHorizontal;
       End;

    function TPrintObject.PixelsToInchesVertical( Pixels: Integer ): Single;

       Begin
       Result := Pixels / PixelsPerInchVertical;
       End;

    function TPrintObject.LinesToPixels( Line:Integer ): Integer;

       { Calculate the number of vertical pixels in 'Line' }

       Begin
       If ( Line <= 0 ) Then
          Line := 1;

       Result := (Line-1) * CalculateLineHeight;
       End;

    procedure TPrintObject.SetLineWidth( Width:Word );

       Begin
       Printer.Canvas.Pen.Width := Width;
       End;

    function TPrintObject.GetLineWidth: Word;

       Begin
       Result := Printer.Canvas.Pen.Width;
       End;

    procedure TPrintObject.CalculateMeasurements;

       { Calculate some necessary measurements.  Thanks to Robert Fabiszak
         CompuServe: 70304,2047 for the Escape() Windows API calls. }

       var
          pt: TPoint;

       Begin
       { Call the Windows API function GetTextMetrics() to get the specifics
         of the particular font. }
       GetTextMetrics( Printer.Canvas.Handle,TextMetrics );

       { Calculate the number of pixels per inch vertical and horizontal.
         'GetDeviceCaps' is a Windows API call. }
       PixelsPerInchVertical := GetDeviceCaps( Printer.Handle,LOGPIXELSY );
       PixelsPerInchHorizontal := GetDeviceCaps( Printer.Handle,LOGPIXELSX );

       { Get the gutter on the left and top.  'Escape' is a Windows API

         call. }
       Escape( Printer.Canvas.Handle,GETPRINTINGOFFSET,0,Nil,@pt );
       GutterLeft := pt.X;
       GutterTop := pt.Y;

       Escape( Printer.Canvas.Handle,GETPHYSPAGESIZE,0,Nil,@pt );
       TotalPageWidthPixels := pt.X;
       TotalPageHeightPixels := pt.Y;
       TotalPageWidthInches := pt.X / PixelsPerInchHorizontal;
       TotalPageHeightInches := pt.Y / PixelsPerInchVertical;

       GutterRight := TotalPageWidthPixels - GutterLeft - Printer.PageWidth;
       GutterBottom := TotalPageHeightPixels - GutterTop - Printer.PageHeight;

       If ( TopMargin < GutterTop ) Then
          TopMargin := GutterTop;
       If ( BottomMargin < GutterBottom ) Then
          BottomMargin := GutterBottom;
       If ( LeftMargin < GutterLeft ) Then
          LeftMargin := GutterLeft;

       If ( RightMargin < GutterRight ) Then
          RightMargin := GutterRight;
       End;

    procedure TPrintObject.SetHeaderInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word;
       FontName:String; FontSize: Word; FontStyle: TFontStyles );

       Begin
       If ( Line > HeaderLines ) Then
          Exit;

       Header[Line].Text := Text;
       Header[Line].YPosition := YPosition;
       Header[Line].Alignment := Alignment;
       Header[Line].FontName := FontName;
       Header[Line].FontSize := FontSize;
       Header[Line].FontStyle := FontStyle;
       End;

    procedure TPrintObject.SetFooterInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word;

       FontName:String; FontSize: Word; FontStyle: TFontStyles );

       Begin
       If ( Line > FooterLines ) Then
          Exit;

       Footer[Line].Text := Text;
       Footer[Line].YPosition := YPosition;
       Footer[Line].Alignment := Alignment;
       Footer[Line].FontName := FontName;
       Footer[Line].FontSize := FontSize;
       Footer[Line].FontStyle := FontStyle;
       End;

    procedure TPrintObject.WriteHeader;

       { If any headers are defined, write them }

       var
          I: Integer;

       Begin
       SaveCurrentFont;
       For I := 1 To HeaderLines Do
          Begin
          If ( Length(Header[I].Text) > 0 ) Then

             Begin
             With Header[I] Do
                Begin
                SetFontInformation( FontName,FontSize,FontStyle );
                If ( Alignment = 0 ) Then
                   WriteLine( LeftMargin, YPosition, Text );
                If ( Alignment = 1 ) Then
                   WriteLineCenter( YPosition, Text );
                If ( Alignment = 2 ) Then
                   WriteLineRight( YPosition, Text );
                End;
             End;

          RestoreCurrentFont;
          End;

       { Does the user desire a box around the header? }
       If ( HeaderCoordinates.Boxed = True ) Then
          Begin
          If ( HeaderCoordinates.Shading > 0 ) Then

             DrawBoxShaded( HeaderCoordinates.XTop,HeaderCoordinates.YTop,HeaderCoordinates.XBottom,
                HeaderCoordinates.YBottom,HeaderCoordinates.LineWidth,HeaderCoordinates.Shading)
          Else
             DrawBox( HeaderCoordinates.XTop,HeaderCoordinates.YTop,HeaderCoordinates.XBottom,
                HeaderCoordinates.YBottom,HeaderCoordinates.LineWidth );
          End;
       End;

    procedure TPrintObject.WriteFooter;

       { If any footers are defined, write them }

       var
          I: Integer;
          Temp: Boolean;

       Begin
       SaveCurrentFont;

       { Set 'AutoPaging' off.  Otherwise the footer will not get written
         correctly. }
       Temp := AutoPaging;
       AutoPaging := False;

       For I := 1 To FooterLines Do

          Begin
          If ( Length(Footer[I].Text) > 0 ) Then
             Begin
             With Footer[I] Do
                Begin
                SetFontInformation( FontName,FontSize,FontStyle );
                If ( Alignment = 0 ) Then
                   WriteLine( LeftMargin, YPosition, Text );
                If ( Alignment = 1 ) Then
                   WriteLineCenter( YPosition, Text );
                If ( Alignment = 2 ) Then
                   WriteLineRight( YPosition, Text );
                End;
             End;

          RestoreCurrentFont;
          End;

       { Does the user desire a box around the footer? }

       If ( FooterCoordinates.Boxed = True ) Then
          Begin
          If ( FooterCoordinates.Shading > 0 ) Then
             DrawBoxShaded( FooterCoordinates.XTop,FooterCoordinates.YTop,FooterCoordinates.XBottom,
                FooterCoordinates.YBottom,FooterCoordinates.LineWidth,FooterCoordinates.Shading )
          Else
             DrawBox( FooterCoordinates.XTop,FooterCoordinates.YTop,FooterCoordinates.XBottom,
                FooterCoordinates.YBottom,FooterCoordinates.LineWidth );
          End;

       AutoPaging := Temp;
       End;

    procedure TPrintObject.SaveCurrentFont;

       Begin
       CurrentFontName := Printer.Canvas.Font.Name;
       CurrentFontSize := Printer.Canvas.Font.Size;
       CurrentFontStyle := Printer.Canvas.Font.Style;
       End;

    procedure TPrintObject.RestoreCurrentFont;

       Begin
       SetFontInformation( CurrentFontName,CurrentFontSize,CurrentFontStyle );
       End;

    procedure TPrintObject.SetDetailTopBottom( Top: Single; Bottom: Single );

       Begin
       DetailTop := Top;
       DetailBottom := Bottom;

       LastYPosition := Top - GetLineHeightInches;
       End;

    procedure TPrintObject.SetAutoPaging( Value: Boolean );

       Begin
       AutoPaging := Value;
       End;

    procedure TPrintObject.SetPageNumberInformation( YPosition:Single; Text:String; Alignment:Word; FontName:String;
       FontSize:Word; FontStyle:TFontStyles );

       Begin
       PageNumber.Text := Text;

       PageNumber.YPosition := YPosition;
       PageNumber.Alignment := Alignment;
       PageNumber.FontName := FontName;
       PageNumber.FontSize := FontSize;
       PageNumber.FontStyle := FontStyle;
       End;

    procedure TPrintObject.WritePageNumber;

       var
          Buffer: String;
          Temp: Boolean;

       Begin
       Buffer := Format( PageNumber.Text,[Printer.PageNumber] );

       SaveCurrentFont;
       SetFontInformation( PageNumber.FontName,PageNumber.FontSize,PageNumber.FontStyle );

       Temp := AutoPaging;
       AutoPaging := False;

       If ( PageNumber.Alignment = 0 ) Then
          WriteLine( LeftMargin, PageNumber.YPosition, Buffer );
       If ( PageNumber.Alignment = 1 ) Then
          WriteLineCenter( PageNumber.YPosition, Buffer );
       If ( PageNumber.Alignment = 2 ) Then
          WriteLineRight( PageNumber.YPosition, Buffer );

       AutoPaging := Temp;

       RestoreCurrentFont;
       End;

    procedure TPrintObject.SetTab( Inches:Single );

       Begin
       CurrentTab := Inches;
       End;

    procedure TPrintObject.SetHeaderDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
       Boxed: Boolean; LineWidth:Word; Shading:Word );

       Begin
       HeaderCoordinates.XTop := XTop;

       HeaderCoordinates.XBottom := XBottom;
       HeaderCoordinates.YTop := YTop;
       HeaderCoordinates.YBottom := YBottom;
       HeaderCoordinates.Boxed := Boxed;
       HeaderCoordinates.LineWidth := LineWidth;
       HeaderCoordinates.Shading := Shading;
       End;

    procedure TPrintObject.SetFooterDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
       Boxed: Boolean; LineWidth:Word; Shading:Word );

       Begin
       FooterCoordinates.XTop := XTop;
       FooterCoordinates.XBottom := XBottom;
       FooterCoordinates.YTop := YTop;
       FooterCoordinates.YBottom := YBottom;
       FooterCoordinates.Boxed := Boxed;
       FooterCoordinates.LineWidth := LineWidth;
       FooterCoordinates.Shading := Shading;
       End;

    procedure TPrintObject.CreateColumn( Number:Word; XPosition:Single; Length:Single );

       Begin
       ColumnInformation[Number].XPosition := XPosition;
       ColumnInformation[Number].Length := Length;
       End;

    procedure TPrintObject.SetYPosition( YPosition:Single );

       Begin
       LastYPosition := YPosition;
       End;

    function TPrintObject.GetYPosition: Single;

       Begin
       Result := LastYPosition;
       End;

    procedure TPrintObject.NextLine;

       Begin
       LastYPosition := LastYPosition + GetLineHeightInches;
       End;

    function TPrintObject.GetLinesLeft: Word;

       { Return the number of lines left in the detail area }

       var
          Lines: Single;
          Buffer: String[20];
          I: Word;

       Begin
       Lines := (DetailBottom - LastYPosition) / GetLineHeightInches;

       Buffer := FloatToStr( Lines );

       { Buffer contains the number of lines left as a floating point number.
         Find the decimal and truncate the string at that point.  So, if there
         are 2.99 lines left, 2 will be returned.  Better to be conservative. }
       For I := 1 To Length(Buffer) Do
          Begin
          If ( Buffer[I] = '.' ) Then
             Begin
             Buffer[0] := Chr(I-1);
             Break;
             End;
          End;

       Result := StrToInt( Buffer );
       End;

    procedure TPrintObject.SetTopOfPage;

       Begin
       LastYPosition := DetailTop;
       End;

    procedure TPrintObject.NewLines( Number:Word );

       { Generate the number of line feeds represented in 'Number' }

       var
          I: Word;

       Begin
       For I := 1 To Number Do
          NextLine;
       End;

    end.

    {******* demo.pas *******}

    unit Demo;

    interface

    uses
      SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
      Forms, Dialogs, ExtCtrls, StdCtrls, Mask, DBCtrls, Menus, PrnMain;

    const
      LeftMargin = 0.5;
      RightMargin = 0.5;
      TopMargin = 0.5;
      BottomMargin = 0.5;

    type
      TPrintForm = class(TForm)
       Button1: TButton;
       Button2: TButton;
       PixelsPerInch: TPanel;
       PixelsPerPage: TPanel;
       Gutters: TPanel;
       LineHeight: TPanel;
       FontInformation: TPanel;

       LinesInDetailArea: TPanel;
       procedure Button1Click(Sender: TObject);
       procedure FormCreate(Sender: TObject);
       procedure Button2Click(Sender: TObject);
      private
       { Private declarations }
      public
       { Public declarations }
      end;

    var
      PrintForm: TPrintForm;
      Prn: TPrintObject;

    implementation

    {$R *.DFM}

    procedure TPrintForm.Button1Click(Sender: TObject);

      var
         Buffer: String;
         Code: String[10];
         ECHOCode: String[10];
         HeaderLine: Boolean;
         I: Word;

      Begin
      { Define the dimensions of the header area.  I want the header area
        lightly shaded.  If I wanted no shading, the last parameter would be
        255. }
      with prn do
      begin
        SetHeaderDimensions( 0.25,0.25,8.25,1.25,True,0,225 );

        { Define two header lines }
        SetHeaderInformation( 1,0.5,'This is header line number 1',1,'Arial',14,[fsBold] );

        SetHeaderInformation( 2,1.0,DateToStr(Date),1,'Arial',11,[] );

        { Define the dimensions of the footer area.  I want the footer area
          lightly shaded.  If I wanted no shading, the last parameter would be
          255. }
        SetFooterDimensions( 0.25,9.40,8.25,10.20,True,0,225 );

        { Define two footer lines }
        SetFooterInformation( 1,9.5,'This is footer line number 1',1,'Arial',14,[fsBold] );
        SetFooterInformation( 2,9.85,'This is footer line number 2',1,'Arial',12,[fsBold] );

        { I would like page numbering, right justified on the very bottom of the
          page. }
        SetPageNumberInformation( 10.25,'Page: %d',2,'Arial',9,[fsBold] );

        { Set the current position to the top of the detail area }
        SetTopOfPage;

        { Write three lines, the first left justified, the second centered and
          the third right justified.  The first line gets printed two inches
          from the top.  The next two lines get printed at the next line from
          the previous line. The '-1' for the first parameter indicates that
          printing should be on the next line.  If '-2' is passed as a
          parameter, printing would occur on the current line. }
        WriteLine( -1.0,2.0,'This is a line left justified' );
        WriteLineCenter( -1.0,'This is a line centered' );
        WriteLineRight( -1.0,'This is a line right justified' );

        { Create five columns.  The first parameter is the column number, the
          second parameter is the location in inches from the left and the third
          parameter is the length in inches. }
        CreateColumn( 1,0.25,1.5 );
        CreateColumn( 2,1.80,1.5 );
        CreateColumn( 3,3.35,1.5 );
        CreateColumn( 4,4.90,1.5 );
        CreateColumn( 5,6.50,1.5 );

        { Start writing column text (left justified) at three inches from the
          top }
        SetYPosition( 3.0 );
        For I := 1 To 10 Do
           Begin
           { The first parameter of 'WriteLineColumn' is the column number and
             the second parameter indicates that printing should occur on the
             current line (in this case, three inches from the top).  If the

             second parameter was -1, printing would occur on the next line. }
           WriteLineColumn( 1,-2,Format('Column 1, Line %d',[I]) );
           WriteLineColumn( 2,-2,Format('Column 2, Line %d',[I]) );
           WriteLineColumn( 3,-2,Format('Column 3, Line %d',[I]) );
           WriteLineColumn( 4,-2,Format('Column 4, Line %d',[I]) );
           WriteLineColumn( 5,-2,Format('Column 5, Line %d',[I]) );
           { Generate a line feed }
           NextLine;
           End;

        { Start writing column text (right justified) at six inches from the
          top }
        SetYPosition( 5.0 );

        For I := 1 To 10 Do
           Begin
           WriteLineColumnRight( 1,-2,Format('Column 1, Line %d',[I]) );
           WriteLineColumnRight( 2,-2,Format('Column 2, Line %d',[I]) );
           WriteLineColumnRight( 3,-2,Format('Column 3, Line %d',[I]) );
           WriteLineColumnRight( 4,-2,Format('Column 4, Line %d',[I]) );
           WriteLineColumnRight( 5,-2,Format('Column 5, Line %d',[I]) );
           NextLine;
           End;

        { Start writing column text (centered) at seven inches from the
          top }
        SetYPosition( 7.0 );
        For I := 1 To 10 Do
           Begin
           WriteLineColumnCenter( 1,-2,Format('Column 1, Line %d',[I]) );

           WriteLineColumnCenter( 2,-2,Format('Column 2, Line %d',[I]) );
           WriteLineColumnCenter( 3,-2,Format('Column 3, Line %d',[I]) );
           WriteLineColumnCenter( 4,-2,Format('Column 4, Line %d',[I]) );
           WriteLineColumnCenter( 5,-2,Format('Column 5, Line %d',[I]) );
           NextLine;
           End;

        { Start a new page }
        NewPage;

        { Change the font information }
        SetFontInformation( 'Courier',20,[fsBold,fsUnderline] );

        For I := 1 To 10 Do
           WriteLine( LeftMargin,-1,Format('This is line %d',[I]) );

        { Set a tab of .5 inches }
        SetTab( 0.5 );

        { Change the font information }
        SetFontInformation( 'Arial',10,[fsItalic] );

        NextLine;
        For I := 1 To 10 Do
           { Since a tab of .5 is set, this text will actually get printed at
             1.0 inches from the left }
           WriteLine( LeftMargin,-1,Format('This is line %d',[I]) );

        { Draw some lines of varying thickness }
        DrawLine( 2.5,5.0,6.0,8.5,5 );
        DrawLine( 6.2,5.2,3.0,8.7,20 );

        { We're all done.  Always call 'Quit' }
        Quit;
        Free;
        Exit;
      end;
    End;

    procedure TPrintForm.FormCreate(Sender: TObject);
    var
      X,Y: Word;

      Top,Bottom,Left,Right: Word;

    Begin
        { Create a TPrintObject }
        Prn := TPrintObject.Create;
    	with prn do
        begin

        { Must always call 'Start' first thing }
        Start;

        { Set left, right, top and bottom margins - in inches }
        SetMargins( LeftMargin,RightMargin,TopMargin,BottomMargin );

        { Define what the 'detail' section dimensions will be.  The detail section
          is the space between the header and the footer areas. }
        SetDetailTopBottom( 1.4,9.4 );

        { Set default information }
        SetFontInformation( 'Arial',11,[] );

        GetPixelsPerInch( X,Y );
        PixelsPerInch.Caption := Format( 'Pixels Per Inch      X: %d  Y: %d',[X,Y] );

        GetPixelsPerPage( X,Y );
        PixelsPerPage.Caption := Format( 'Pixels Per Page      X: %d  Y: %d',[X,Y] );

        GetGutter( Top,Bottom,Left,Right );
        Gutters.Caption := Format( 'Gutters     Top: %d   Bottom: %d   Left: %d   Right: %d',[Top,Bottom,Left,Right] );

        LineHeight.Caption := Format( 'Height of Each Line:   %d',[GetLineHeightPixels] );

        FontInformation.Caption := Format( 'Font Name: %s     Font Size: %d',[GetFontName,GetFontSize] );

        LinesInDetailArea.Caption := Format( 'Lines in Detail Area: %d',[GetLinesInDetailArea] );

    	end; {with}
    End;

    procedure TPrintForm.Button2Click(Sender: TObject);

      Begin
      Close;
      Halt;
      End;

    end.

    {******* project.dpr *******}

    program Project;

    uses
      Forms,
      Prnmain in 'PRNMAIN.PAS',
      Demo in 'DEMO.PAS' {PrintForm};

    {$R *.RES}

    begin
      Application.CreateForm(TPrintForm, PrintForm);
      Application.Run;
    end.

    {******* demo.dfm *******}

    object PrintForm: TPrintForm
      Left = 104
      Top = 90
      BorderIcons = [biSystemMenu]
      BorderStyle = bsDialog
      Caption = 'Print Demonstration'
      ClientHeight = 317

      ClientWidth = 427
      Color = clSilver
      Font.Color = clWindowText
      Font.Height = -13
      Font.Name = 'System'
      Font.Style = []
      PixelsPerInch = 96
      Position = poScreenCenter
      OnCreate = FormCreate
      TextHeight = 16
      object Button1: TButton
        Left = 276
        Top = 270
        Width = 61
        Height = 33
        Caption = '&Print'
        TabOrder = 0
        OnClick = Button1Click
      end
      object Button2: TButton
        Left = 342
        Top = 270
        Width = 61
        Height = 33
        Cancel = True
        Caption = '&Cancel'
        ModalResult = 2
        TabOrder = 1
        OnClick = Button2Click
      end
      object PixelsPerInch: TPanel
        Left = 6
        Top = 12
        Width = 415
        Height = 25
        TabOrder = 2
      end
      object PixelsPerPage: TPanel
        Left = 6
        Top = 42
        Width = 415

        Height = 25
        TabOrder = 3
      end
      object Gutters: TPanel
        Left = 6
        Top = 72
        Width = 415
        Height = 25
        TabOrder = 4
      end
      object LineHeight: TPanel
        Left = 6
        Top = 102
        Width = 415
        Height = 25
        TabOrder = 5
      end
      object FontInformation: TPanel
        Left = 6
        Top = 132
        Width = 415
        Height = 25
        TabOrder = 6
      end
      object LinesInDetailArea: TPanel
        Left = 6
        Top = 162
        Width = 415
        Height = 25
        TabOrder = 7
      end
    end

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]