(*******************************************************************************
TLinePrinter Version 1.0
8/8/96 - Bill Menees
Copyright (c) 1996
This is a non-visual VCL component that encapsulates the Printer object.
Notes:
1. Almost every property is measured in MeasureUnits (inches or
millimeters). TabSize is the only exception; it is measured in spaces.
2. If you have no default printer, you will get warnings at design time.
You may still be able to work with it, but I haven't really tested it.
I've tried to make sure things are handled gracefully at run time if
you have no printers installed, but I intentionally warn you at design
time if you try to modify any properties that directly modify the
underlying TPrinter object (e.g. Font, Orientation, Title). TPrinter
depends on there being at least one printer.
3. If you try to set the margins too small, they get set to the corres-
ponding gutter size. If you try to set the margins too large, they
get set to the physical page size (height or width) minus the corres-
ponding gutter size. Originally, I was going to raise a TLinePrinter
exception, but that proved bad because exceptions could be fired while
the component was being loaded (before you could trap them in code).
To get around this, I had to just quietly set them to appropriate
values.
4. If you increase the page size and set the margins then decrease the
page size, the margins may be out of bounds. This is the reason for
the Refresh method, it makes sure they are within bounds. Thus, you
should ALWAYS call the TLinePrinter.Refresh method after you display
a printer setup dialog, change any printer characteristics through
API calls, etc.
********************************************************************************
10/2/96 - Modifications suggested by:
G?ran Pettersson
E-Mail: [[Email Removed]]
A. Added new property 'MeasureUnit', for selection between Inches and
Millimeters.
B. Added english and metric constants for default AvailablePageHeight,
AvailablePageWidth, PhysicalPageHeight, PhysicalPageWidth, GutterLeft,
and GutterTop.
********************************************************************************
10/31/96 - Modifications I decided to make:
1. PrintableWidth and PrintableHeight properties were added. They give
the printable area bounded by the margins.
2. The former PageHeight and PageWidth properties were renamed to
AvailablePageHeight and AvailablePageWidth.
3. There is now a public Canvas property! So if you need to do a little
drawing of your own, you can.
4. OnNewPage used to fire before the new page was created. This wasn't
very useful. Now OnNewPage fires after the new page is created.
5. HeaderFormat and FooterFormat are now used to format the Header and
Footer instead of TableFormat.
6. The LinesAsTable property has been removed. Now PrintLines takes this
as a parameter. This makes more sense. (LinesAsTable was only needed
as a property in an early alpha version of TLinePrinter where the Lines
were printed automatically in BeginDoc.)
7. There is now a PrevLine function so you can print multiple times on the
same line if you need to. It returns a Boolean value to indicate its
success. It only fails at the top of a page.
*******************************************************************************)
{ $LONGSTRINGS ON }
unit LinePrnt;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, Printers, StdCtrls, ExtCtrls;
const
LinePrinterWhiteSpaceChars = [#0..#32];
TokenSeparator = '|';
{In Pixels}
DefaultDPI = 300;
DefaultBorderWidth = 2;
{In Inches}
DefaultPhysicalPageHeightIn = 11.0;
DefaultPhysicalPageWidthIn = 8.5;
DefaultAvailablePageHeightIn = 10.5;
DefaultAvailablePageWidthIn = 8.0;
DefaultGutterLeftIn = 0.25;
DefaultGutterTopIn = 0.25;
{In Millimeters}
DefaultPhysicalPageHeightMm = 297.0;
DefaultPhysicalPageWidthMm = 210.0;
DefaultAvailablePageHeightMm = 284.0;
DefaultAvailablePageWidthMm = 198.0;
DefaultGutterLeftMm = 6.0;
DefaultGutterTopMm = 6.0;
{These are expanded only in
Headers, Footers, and Tables.}
LineField = '{$LINE}';
PageField = '{$PAGE}';
DateField = '{$DATE}';
TimeField = '{$TIME}';
TitleField = '{$TITLE}';
type
ELinePrinter = class(EPrinter);
{These are declared so you can tell at a glance what
a property or function's return value is used for.}
TMeasurement = Single;
TPixels = Cardinal;
TPrntProgDlg = class(TForm)
Bevel: TBevel;
lblStatus: TLabel;
lblTitle: TLabel;
lblPageNumDesc: TLabel;
lblPageNumber: TLabel;
private
{ Private declarations }
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
public
{ Public declarations }
end;
TMeasureUnit = (muInches, muMillimeters);
TLineSpacing = (lsHalfSpace, lsSingleSpace, lsSingleAndAHalf, lsDoubleSpace);
TPageBorderStyle = (pbTop, pbBottom, pbLeft, pbRight);
TPageBorders = set of TPageBorderStyle;
TLinePrinter = class(TComponent)
private
{ Private declarations }
fPrinter: TPrinter;
fCanvas: TCanvas;
fPrntProgDlg: TPrntProgDlg;
fLineNumber: Cardinal;
fMarginTop, fMarginBottom, fMarginLeft, fMarginRight: TMeasurement;
fMeasureUnit: TMeasureUnit;
fLineSpacing: TLineSpacing;
fTabSize: Cardinal;
fWordWrap: Boolean;
fLines: TStrings;
fAlignment: TAlignment;
fHeader, fFooter: String;
fPageBorders: TPageBorders;
fTextMetrics: TTextMetric;
fShowProgress: Boolean;
fTableFormat: String;
fDefaultColWidth: TMeasurement;
fBorderOffset: TMeasurement;
fHeaderFormat, fFooterFormat: String;
{These X,Y are relative to the printable space.
They should normally be bounded by the Margins.
So 0,0 is the left,top corner of the printable space.
fCurrentY is negative only when printing the header.}
fCurrentX, fCurrentY: Integer;
fLineSpace: TPixels;
fOnBeginDoc: TNotifyEvent;
fOnEndDoc: TNotifyEvent;
fOnAbortDoc: TNotifyEvent;
fOnNewLine: TNotifyEvent;
fOnNewPage: TNotifyEvent;
function GetAborted: Boolean;
function GetFont: TFont;
function GetOrientation: TPrinterOrientation;
function GetAvailablePageHeight: TMeasurement;
function GetAvailablePageWidth: TMeasurement;
function GetPageNumber: Cardinal;
function GetPrinting: Boolean;
function GetTitle: String;
function GetGutterTop: TMeasurement;
function GetGutterBottom: TMeasurement;
function GetGutterLeft: TMeasurement;
function GetGutterRight: TMeasurement;
procedure SetMarginTop(Value: TMeasurement);
procedure SetMarginBottom(Value: TMeasurement);
procedure SetMarginLeft(Value: TMeasurement);
procedure SetMarginRight(Value: TMeasurement);
procedure SetMeasureUnit(Value: TMeasureUnit);
procedure SetLineSpacing(Value: TLineSpacing);
procedure SetTabSize(Value: Cardinal);
procedure SetWordWrap(Value: Boolean);
procedure SetLines(Value: TStrings);
procedure SetAlignment(Value: TAlignment);
procedure SetHeader(Value: String);
procedure SetFooter(Value: String);
procedure SetPageBorders(Value: TPageBorders);
procedure SetFont(Value: TFont);
procedure SetOrientation(Value: TPrinterOrientation);
procedure SetTitle(Value: String);
procedure SetShowProgress(Value: Boolean);
procedure SetTableFormat(Value: String);
procedure SetDefaultColWidth(Value: TMeasurement);
procedure SetBorderOffset(Value: TMeasurement);
procedure SetHeaderFormat(Value: String);
procedure SetFooterFormat(Value: String);
function GetPhysicalPageHeight: TMeasurement;
function GetPhysicalPageWidth: TMeasurement;
function GetPrintableHeight: TMeasurement;
function GetPrintableWidth: TMeasurement;
function PixelPrintWidth: TPixels;
function PixelPrintHeight: TPixels;
function StartingLeft: TPixels;
function StartingRight: TPixels;
function StartingTop: TPixels;
function StartingBottom: TPixels;
protected
{ Protected declarations }
procedure SetPixelsPerInch;
procedure SplitLineAndPrint(const Line: String);
procedure DoNewPageProcessing;
procedure UpdateProgressDlg(const Status: String);
function GetClippedLine(const Line: String; const Width: TPixels): String;
function MeasureUnitsToPixelsH(const M: TMeasurement): TPixels;
function MeasureUnitsToPixelsV(const M: TMeasurement): TPixels;
function PixelsToMeasureUnitsH(const P: TPixels): TMeasurement;
function PixelsToMeasureUnitsV(const P: TPixels): TMeasurement;
function ExpandLogicalFields(S: String): String;
public
{ Public declarations }
property Aborted: Boolean read GetAborted;
property Canvas: TCanvas read fCanvas write fCanvas;
property LineNumber: Cardinal read fLineNumber;
//This is the Printer.PageHeight/Width property converted to TMeasurement.
//It's the largest available printable space per page.
property AvailablePageHeight: TMeasurement read GetAvailablePageHeight;
property AvailablePageWidth: TMeasurement read GetAvailablePageWidth;
//This is how large the piece of paper physically is.
property PhysicalPageHeight: TMeasurement read GetPhysicalPageHeight;
property PhysicalPageWidth: TMeasurement read GetPhysicalPageWidth;
//This is the printable area determined by the margins.
property PrintableHeight: TMeasurement read GetPrintableHeight;
property PrintableWidth: TMeasurement read GetPrintableWidth;
property PageNumber: Cardinal read GetPageNumber;
property Printing: Boolean read GetPrinting;
property GutterTop: TMeasurement read GetGutterTop;
property GutterBottom: TMeasurement read GetGutterBottom;
property GutterLeft: TMeasurement read GetGutterLeft;
property GutterRight: TMeasurement read GetGutterRight;
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
procedure AbortDoc;
procedure BeginDoc;
procedure EndDoc;
function NewPage: Cardinal;
function NewLine: Cardinal;
function PrevLine: Boolean;
procedure WriteLine(const Line: String);
procedure WriteLineRight(const Line: String);
procedure WriteLineCenter(const Line: String);
procedure WriteTableLine(const Line: String);
procedure PrintLines(const LinesAsTable: Boolean);
procedure Refresh;
published
{ Published declarations }
property MarginTop: TMeasurement read fMarginTop write SetMarginTop;
property MarginBottom: TMeasurement read fMarginBottom write SetMarginBottom;
property MarginLeft: TMeasurement read fMarginLeft write SetMarginLeft;
property MarginRight: TMeasurement read fMarginRight write SetMarginRight;
property MeasureUnit: TMeasureUnit read fMeasureUnit write SetMeasureUnit default muInches;
property LineSpacing: TLineSpacing read fLineSpacing write SetLineSpacing default lsSingleSpace;
property TabSize: Cardinal read fTabSize write SetTabSize default 8;
property WordWrap: Boolean read fWordWrap write SetWordWrap default True;
property Lines: TStrings read fLines write SetLines;
property Alignment: TAlignment read fAlignment write SetAlignment default taLeftJustify;
property Header: String read fHeader write SetHeader nodefault;
property HeaderFormat: String read fHeaderFormat write SetHeaderFormat;
property Footer: String read fFooter write SetFooter nodefault;
property FooterFormat: String read fFooterFormat write SetFooterFormat;
property PageBorders: TPageBorders read fPageBorders write SetPageBorders default [];
property ShowProgress: Boolean read fShowProgress write SetShowProgress default False;
property Font: TFont read GetFont write SetFont;
property Orientation: TPrinterOrientation read GetOrientation write SetOrientation default poPortrait;
property Title: String read GetTitle write SetTitle nodefault;
property TableFormat: String read fTableFormat write SetTableFormat;
property DefaultColWidth: TMeasurement read fDefaultColWidth write SetDefaultColWidth;
property BorderOffset: TMeasurement read fBorderOffset write SetBorderOffset;
property OnBeginDoc: TNotifyEvent read fOnBeginDoc write fOnBeginDoc;
property OnEndDoc: TNotifyEvent read fOnEndDoc write fOnEndDoc;
property OnAbortDoc: TNotifyEvent read fOnAbortDoc write fOnAbortDoc;
property OnNewLine: TNotifyEvent read fOnNewLine write fOnNewLine;
property OnNewPage: TNotifyEvent read fOnNewPage write fOnNewPage;
end;
procedure Register;
function ReplaceSubString(OldSubStr, NewSubStr, S: String): String;
procedure ParseFormatToken(var CurToken: String; var CurAlignment: TAlignment; var CurWidth: TMeasurement; const DefaultColWidth: TMeasurement);
procedure TokenizeString(const S: String; Tokens: TStringList);
function StripBackToWhiteSpace(const S: String): String;
function ExpandTabsAsSpaces(const S: String; const TabSize: Integer): String;
{$R PrntProg.dfm}
{$R LinePrnt.Res}
implementation
{=============================================================================}
{ Non-methods that may prove useful elsewhere. }
{=============================================================================}
function ReplaceSubString(OldSubStr, NewSubStr, S: String): String;
var
P: Cardinal;
begin
{Currently, this routine is terribly inefficient since Pos
always starts back at the beginning of the string.
Eventually, I hope to replace this with a Knuth-Morris-Pratt
based search and replace that starts at a specified location.
This works for now though for what I need.}
{First, make sure old isn't contained in new.
This gets around the infinite loop situation.
If old is in new, we just return S unmodified.}
P:=Pos(OldSubStr, NewSubStr);
if P = 0 then
begin
P:=Pos(OldSubStr, S);
while P > 0 do
begin
S:=Copy(S, 1, P-1)+NewSubStr+Copy(S, P+Length(OldSubStr), Length(S));
P:=Pos(OldSubStr, S);
end;
end;
Result:=S;
end;
procedure ParseFormatToken(var CurToken: String; var CurAlignment: TAlignment; var CurWidth: TMeasurement; const DefaultColWidth: TMeasurement);
begin
if CurToken = '' then CurToken:='<'+FloatToStr(DefaultColWidth);
if Length(CurToken) = 1 then
if (CurToken[1] in ['<', '^', '>']) then CurToken:=CurToken+FloatToStr(DefaultColWidth);
{Alignment}
case CurToken[1] of
'<': begin
CurAlignment:=taLeftJustify;
Delete(CurToken, 1, 1);
end;
'^': begin
CurAlignment:=taCenter;
Delete(CurToken, 1, 1);
end;
'>': begin
CurAlignment:=taRightJustify;
Delete(CurToken, 1, 1);
end;
else
CurAlignment:=taLeftJustify;
end;
{Width}
try
CurWidth:=StrToFloat(CurToken);
except
on EConvertError do CurWidth:=DefaultColWidth;
end;
end;
procedure TokenizeString(const S: String; Tokens: TStringList);
var
i, Len: Cardinal;
CurToken: String;
begin
Tokens.Clear;
CurToken:='';
Len:=Length(S);
for i:=1 to Len do
begin
if S[i] = TokenSeparator then
begin
Tokens.Add(CurToken);
CurToken:='';
end
else
CurToken:=CurToken+S[i];
end;
Tokens.Add(CurToken);
end;
function StripBackToWhiteSpace(const S: String): String;
var
i, Len, Mark: Cardinal;
begin
Mark:=0;
Len:=Length(S);
for i:=Len downto 1 do
begin
if S[i] in LinePrinterWhiteSpaceChars then
begin
Mark:=i;
Break;
end;
end;
if Mark > 0 then Result:=Copy(S, 1, Mark)
{If there is nowhere to break, just return the whole line.}
else Result:=S;
end;
function ExpandTabsAsSpaces(const S: String; const TabSize: Integer): String;
function Space(const Size: Integer): String;
var
Str: String;
begin
Str:='';
while Length(Str) < Size do Str:=Str+' ';
Space:=Str;
end;
var
i, Len, Size: Cardinal;
Buffer: String;
begin
{TabStr:='';
for i:=1 to TabSize do TabStr:=TabStr+' ';}
Buffer:='';
Len:=Length(S);
for i:=1 to Len do
begin
if S[i]=#9 then
begin
Size:=TabSize-(Length(Buffer) mod TabSize);
Buffer:=Buffer+Space(Size);
end
else Buffer:=Buffer+S[i];
end;
Result:=Buffer;
end;
{=============================================================================}
{ Private stuff for TPrntProgDlg. }
{=============================================================================}
procedure TPrntProgDlg.WMNCHitTest(var Msg: TWMNCHitTest);
begin
{Don't let them resize the progress dialog.}
inherited;
with Msg Do
if (Result = HTTop) or
(Result = HTTopLeft) or
(Result = HTTopRight) or
(Result = HTLeft) or
(Result = HTRight) or
(Result = HTBottom) or
(Result = HTBottomLeft) or
(Result = HTBottomRight) then Result:=HTNowhere;
end;
{=============================================================================}
{ Public stuff for TLinePrinter. }
{=============================================================================}
constructor TLinePrinter.Create(Owner: TComponent);
begin
inherited Create(Owner);
{Make sure things don't blow up if there is no printer.}
fPrinter:=nil;
try
fPrinter:=Printer;
fCanvas:=fPrinter.Canvas;
except
on EPrinter do
begin
if csDesigning in ComponentState then
MessageDlg('You must have at least one printer installed to create and use all of the features of this component.',
mtWarning, [mbOk], 0);
end;
end;
{Note: This is created as a TStringList
but declared as a TStrings. This is to
maintain a consistent look with other
VCL components. TStrings is used as a
visible outer layer while TStringList
is used internally for storage.}
fLines := TStringList.Create;
{Make this explicitly nil so UpdateProgressDlg
can tell if it needs to Create or Free itself.}
fPrntProgDlg := nil;
fCurrentX:=0;
fCurrentY:=0;
fLineNumber:= 0;
Font.Name := 'Courier New';
Font.Size := 10;
Font.Style:= [];
LineSpacing:=lsSingleSpace;
TabSize:=8;
WordWrap:=True;
Alignment:=taLeftJustify;
PageBorders:=[];
Orientation:=poPortrait;
ShowProgress:=False;
Header:='';
HeaderFormat:='';
Footer:='';
FooterFormat:='';
TableFormat:='';
Title:='';
MarginTop:=GutterTop;
MarginBottom:=GutterBottom;
MarginLeft:=GutterLeft;
MarginRight:=GutterRight;
BorderOffset:=0;
DefaultColWidth:=0;
MeasureUnit:=muInches;
end;
destructor TLinePrinter.Destroy;
begin
fLines.Free;
inherited Destroy;
end;
procedure TLinePrinter.AbortDoc;
begin
try
UpdateProgressDlg('Aborting Printing');
try
fPrinter.Abort;
except
on EPrinter do raise ELinePrinter.Create('Unable to abort printing.');
end;
finally
UpdateProgressDlg('');
end;
{Fire the event handler if it exists.}
if Assigned(fOnAbortDoc) then fOnAbortDoc(Self);
end;
procedure TLinePrinter.BeginDoc;
begin
{Fire the event handler if it exists.}
if Assigned(fOnBeginDoc) then fOnBeginDoc(Self);
try
SetPixelsPerInch;
fPrinter.BeginDoc;
//Make sure the font gets sized correctly for the page.
GetTextMetrics(Canvas.Handle, fTextMetrics);
SetPixelsPerInch;
except
on EPrinter do raise ELinePrinter.Create('Unable to begin printing.');
end;
UpdateProgressDlg('Preparing to Print');
{Make sure the new page processing fires on BeginDoc.}
DoNewPageProcessing;
end;
procedure TLinePrinter.EndDoc;
begin
try
UpdateProgressDlg('Finished Printing');
try
fPrinter.EndDoc;
except
on EPrinter do raise ELinePrinter.Create('Unable to finish printing.');
end;
finally
UpdateProgressDlg('');
end;
{Fire the event handler if it exists.}
if Assigned(fOnEndDoc) then fOnEndDoc(Self);
end;
function TLinePrinter.NewPage: Cardinal;
begin
try
fPrinter.NewPage;
except
on EPrinter do raise ELinePrinter.Create('Unable to print a new page.');
end;
DoNewPageProcessing;
Result:=PageNumber;
end;
function TLinePrinter.NewLine: Cardinal;
begin
fCurrentX:=0;
fCurrentY:=fCurrentY+fLineSpace;
{See if the entire next line will fit.}
if (fCurrentY+fLineSpace) >= PixelPrintHeight then
NewPage
else
Inc(fLineNumber);
{Fire the event handler if it exists.}
if Assigned(fOnNewLine) then fOnNewLine(Self);
Result:=LineNumber;
end;
//This function returns whether it was successful.
function TLinePrinter.PrevLine: Boolean;
begin
Result:=False;
if fCurrentY >= fLineSpace then
begin
fCurrentX:=0;
fCurrentY:=fCurrentY-fLineSpace;
Dec(fLineNumber);
Result:=True;
end;
end;
procedure TLinePrinter.WriteLine(const Line: String);
var
LineWidth: TPixels;
Buffer: String;
begin
if Pos(#9, Line)>0 then Buffer:=ExpandTabsAsSpaces(Line, TabSize)
else Buffer:=Line;
try
LineWidth:=Canvas.TextWidth(Buffer);
except
on EPrinter do LineWidth:=0;
end;
if LineWidth > PixelPrintWidth then
begin
if WordWrap then SplitLineAndPrint(Buffer)
else WriteLine(GetClippedLine(Buffer, PixelPrintWidth));
end
else
begin
case Alignment of
taRightJustify: fCurrentX := PixelPrintWidth-LineWidth;
taCenter: fCurrentX := (PixelPrintWidth-LineWidth) shr 1;
else
fCurrentX:=0;
end;
{Make sure we don't write off the end of the page.}
if (fCurrentY+fLineSpace) >= PixelPrintHeight then NewPage;
{Now print the line.}
try
Canvas.TextOut(StartingLeft+fCurrentX, StartingTop+fCurrentY, Buffer);
except
on EPrinter do ;
end;
NewLine;
end;
end;
procedure TLinePrinter.WriteLineRight(const Line: String);
var
OldAlign: TAlignment;
begin
OldAlign:=Alignment;
try
Alignment:=taRightJustify;
WriteLine(Line);
finally
Alignment:=OldAlign;
end;
end;
procedure TLinePrinter.WriteLineCenter(const Line: String);
var
OldAlign: TAlignment;
begin
OldAlign:=Alignment;
try
Alignment:=taCenter;
WriteLine(Line);
finally
Alignment:=OldAlign;
end;
end;
procedure TLinePrinter.WriteTableLine(const Line: String);
var
FormatTokens, LineTokens: TStringList;
i, CurWidth, LeftPos: Integer;
FloatCurWidth: TMeasurement;
CurAlignment: TAlignment;
CurToken: String;
begin
FormatTokens:=TStringList.Create;
LineTokens:=TStringList.Create;
try
TokenizeString(TableFormat, FormatTokens);
TokenizeString(Line, LineTokens);
fCurrentX:=StartingLeft;
for i:=0 to FormatTokens.Count-1 do
begin
{Get the Width and Alignment from the current column format.}
CurToken:=FormatTokens[i];
ParseFormatToken(CurToken, CurAlignment, FloatCurWidth, DefaultColWidth);
CurWidth:=MeasureUnitsToPixelsH(FloatCurWidth);
{Now get a line token even if it's blank.}
if i < LineTokens.Count then CurToken:=LineTokens[i]
else CurToken:='';
//Expand logical field names (e.g. {$LINE}).
{The '{$' check is just to speed things up.}
if Pos('{$', CurToken) > 0 then
CurToken:=ExpandLogicalFields(CurToken);
{Get just what will fit in the current column.}
CurToken:=GetClippedLine(CurToken, CurWidth);
try
{Figure out where the X position will be in the current column.}
case CurAlignment of
taCenter: LeftPos:=(CurWidth-Canvas.TextWidth(CurToken)) shr 1;
taRightJustify: LeftPos:=CurWidth-Canvas.TextWidth(CurToken);
else
LeftPos:=0;
end;
{Print out the current token.}
Canvas.TextOut(fCurrentX+LeftPos, fCurrentY+StartingTop, CurToken);
except
on EPrinter do ;
end;
{Increase fCurrentX by the COLUMN width.}
fCurrentX:=fCurrentX+CurWidth;
end;
finally
FormatTokens.Free;
LineTokens.Free;
end;
{If we're not printing the Header or Footer, go to a new line.}
if (fCurrentY >= 0) and
(fCurrentY < PixelPrintHeight) then NewLine;
end;
procedure TLinePrinter.PrintLines(const LinesAsTable: Boolean);
var
i: Integer; {This must allow negatives for Lines.Count-1}
begin
for i:=0 to Lines.Count-1 do
begin
if LinesAsTable and (TableFormat<>'') then
WriteTableLine(Lines[i])
else
WriteLine(Lines[i]);
end;
//Lines.Clear;
end;
procedure TLinePrinter.Refresh;
begin
{This allows SetMarginXXX to make
sure the margins are in bounds.
It should be called after you display
a printer setup dialog. TLinePrinter
can't detect a page size change, so this
must be explicitly called to deal with
any Margin boundary problems.}
if not Printing then
begin
SetMarginTop(MarginTop);
SetMarginBottom(MarginBottom);
SetMarginLeft(MarginLeft);
SetMarginRight(MarginRight);
end;
end;
{=============================================================================}
{ Private and Protected stuff for TLinePrinter. }
{=============================================================================}
procedure TLinePrinter.DoNewPageProcessing;
var
PixelBorderOffset: TPixels;
OldTableFormat: String;
begin
UpdateProgressDlg('Currently Printing');
try
{Keep TableFormat because we temporarily
change it for the Header and Footer.}
OldTableFormat:=TableFormat;
{Print the header.}
if Header <> '' then
begin
{This value should be a negative offset.}
fCurrentY:=((StartingTop-fLineSpace) shr 1)-StartingTop;
TableFormat:=HeaderFormat;
WriteTableLine(Header);
end;
{Print the footer.}
if Footer <> '' then
begin
fCurrentY:=PixelPrintHeight+((StartingBottom-fLineSpace) shr 1);
TableFormat:=FooterFormat;
WriteTableLine(Footer);
end;
finally
{Restore the original TableFormat.}
TableFormat:=OldTableFormat;
end;
{Reset the fields and fire new page and line events.}
fCurrentX:=0;
fCurrentY:=0;
fLineNumber:=0;
if Assigned(fOnNewPage) then fOnNewPage(Self);
if Assigned(fOnNewLine) then fOnNewLine(Self);
{Print the PageBorders.}
try
with Canvas do
begin
Pen.Width:=DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSY) div DefaultDPI);
PixelBorderOffset:=MeasureUnitsToPixelsV(BorderOffset);
if pbTop in PageBorders then
begin
MoveTo(StartingLeft-PixelBorderOffset,StartingTop-PixelBorderOffset);
LineTo(StartingLeft+PixelPrintWidth+PixelBorderOffset, StartingTop-PixelBorderOffset);
end;
if pbBottom in PageBorders then
begin
MoveTo(StartingLeft-PixelBorderOffset, StartingTop+PixelPrintHeight+PixelBorderOffset);
LineTo(StartingLeft+PixelPrintWidth+PixelBorderOffset, StartingTop+PixelPrintHeight+PixelBorderOffset);
end;
Pen.Width:=DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSX) div DefaultDPI);
PixelBorderOffset:=MeasureUnitsToPixelsH(BorderOffset);
if pbLeft in PageBorders then
begin
MoveTo(StartingLeft-PixelBorderOffset, StartingTop-PixelBorderOffset);
LineTo(StartingLeft-PixelBorderOffset, StartingTop+PixelPrintHeight+PixelBorderOffset);
end;
if pbRight in PageBorders then
begin
MoveTo(StartingLeft+PixelPrintWidth+PixelBorderOffset, StartingTop-PixelBorderOffset);
LineTo(StartingLeft+PixelPrintWidth+PixelBorderOffset, StartingTop+PixelPrintHeight+PixelBorderOffset);
end;
end;
except
on EPrinter do ;
end;
end;
procedure TLinePrinter.SplitLineAndPrint(const Line: String);
var
Buffer, CurLine: String;
Len: Cardinal;
begin
Buffer:=Line;
repeat
CurLine:=GetClippedLine(Buffer, PixelPrintWidth);
Len:=Length(CurLine);
{If the next character isn't whitespace, slide back to the nearest.
Also, like most word processors do, I'm going to delete the
first leading whitespace character left in the next-line buffer after
the delete/newline (if one exists).}
if Len<Length(Buffer) then
begin
if not (Buffer[Len+1] in LinePrinterWhiteSpaceChars) then
begin
CurLine:=StripBackToWhiteSpace(CurLine);
Len:=Length(CurLine);
end
else
Inc(Len);
end;
WriteLine(CurLine);
Delete(Buffer, 1, Len);
until Buffer='';
end;
