            Formatting and Printing Output for the Printer

  *** This code was downloaded from the Borland/Inprise site.
  *** I used this as the starting point for this component.
  *** Many thanks to the original programmer(s) who wrote this.
  ***
  *** Woody
             

Formatting and Printing can sometimes be a challenging process. 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 application 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.

Use this example as a building block in your applications.

Let's get going and print !!!

{******* 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

*******************************************
            

            
            DISCLAIMER: You have the right to use this technical information 
            subject to the terms of the No-Nonsense License Statement that you 
            received with the Borland product to which this information 
            pertains. 
            Trademarks & Copyright  1998 INPRISE Corporation. Last modified on 
            8-June-1998.

