Contributor: SWAG SUPPORT TEAM
{
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