Unit PagePrnt

Uncomment this $DEFINE to produce the shareware version.} {You must also uncomment the line in PgPrnAbt.} //{$DEFINE PAGEPRINT_SHAREWARE} (******************************************************************************* TPagePrinter Version 2.0 8/8/96 - 10/26/97 Copyright © 1996-1997 Bill Menees bmenees@usit.net http://www.public.usit.net/bmenees This is a VCL component that encapsulates the Printer object and does Print Preview. I make no claim to it's correct functioning, so use it at your own risk. It **REQUIRES** long strings, enhanced metafiles, the Win32 common controls, and it makes use of several Win32 specific API calls. This means it can't be used with Delphi 1.0, so please don't ask, beg, threaten, etc. It has been tested with and seems to work fine with Delphi 2.0, Delphi 3.0, and C++Builder 1.0. Before you e-mail me with a question, MAKE SURE YOU CHECK THE SOURCE CODE FIRST! I don't mind helping people with problems if they have honestly tried to solve the problem first. However, I won't even reply to questions whose answers are obvious when you look at the source (e.g. Can I use this with Delphi 1.0?). Historical Note: This component has its origins in TLinePrinter. I started off calling this component TLinePrinter Version 2.0, but I decided a new class name was more appropriate for several reasons. The main reason was that TLinePrinter is a non-visual component, and the new component is a visual component. I didn't want the new visual component to start showing up on forms where the V.1.0 component hadn't shown! A new class name also gave me the chance to redefine the interface entirely. I added, edited, renamed, and deleted many properties, methods, events, and units. I think you'll agree the changes are for the better. *******************************************************************************) {$LONGSTRINGS ON

Classes

TPageList -
TPagePrinter -

Functions

ExpandTabsAsSpaces - If there is nowhere to break, just return the whole line.
FillGradient -
GenSpace - TabStr:=''; for i:=1 to TabSize do TabStr:=TabStr+' ';
ReplaceSubString - Typically gutters are symmetrical on printers, but GetDeviceCaps doesn't report back bottom or right gutters.
StripBackToWhiteSpace -
TokenizeString - Currently, this routine is terribly inefficient since Pos always starts back at the beginning of the string.

Types

TGradientOrientation
TLineSpacing
TMeasurement
TMeasureUnit
TPageBorder
TPageBorders
TPixels
TPrintCanvas
TPrintPage
TZoomLocation

Constants

DateField
DefaultAvailablePageHeightIn
DefaultAvailablePageHeightMm
DefaultAvailablePageWidthIn
DefaultAvailablePageWidthMm
DefaultBorderWidth
DefaultDPI
DefaultGutterLeftIn
DefaultGutterLeftMm
DefaultGutterTopIn
DefaultGutterTopMm
DefaultPhysicalPageHeightIn
DefaultPhysicalPageHeightMm
DefaultPhysicalPageWidthIn
DefaultPhysicalPageWidthMm
LineField
PageField
ProgressFinishMsg
SendingPagesMsg
TimeField
TitleField

Variables


Functions


function ExpandTabsAsSpaces(const S: String; const TabSize: Cardinal): String;

If there is nowhere to break, just return the whole line.

procedure FillGradient(Canvas: TCanvas; Rc: TRect; LeftTopColor, RightBottomColor: TColor; Orientation: TGradientOrientation);


function GenSpace(const Size: Cardinal): String;

TabStr:=''; for i:=1 to TabSize do TabStr:=TabStr+' ';

function ReplaceSubString(const OldSubStr, NewSubStr: String; S: String): String;

Typically gutters are symmetrical on printers, but GetDeviceCaps doesn't report back bottom or right gutters. If I calculate these gutters based on other information returned by GetDeviceCaps (instead of just assuming things are symmetrical), I get a smaller and typically incorrect result. I think symmetric gutters are what we want in most cases, but you can comment this $DEFINE out if you want the gutters to be calculated based on the exact values returned by GetDeviceCaps.} {$DEFINE USE_SYMMETRIC_GUTTERS} {$R PagePrnt.dcr} {=============================================================================} { Non-methods that may prove useful elsewhere. } {=============================================================================

function StripBackToWhiteSpace(const S: String): String;


procedure TokenizeString(const S: String; TokenSeparator: Char; Tokens: TStringList);

Currently, this routine is terribly inefficient since Pos always starts back at the beginning of the string. However, our header, footer, and table strings are usually very short, so this doesn't matter much in practice.

Types


TGradientOrientation = (goHorizontal, goVertical);

TLineSpacing = (lsHalfSpace, lsSingleSpace, lsSingleAndAHalf, lsDoubleSpace);

TMeasurement = Double

TMeasureUnit = (muInches, muMillimeters);

TPageBorder = (pbTop, pbBottom, pbLeft, pbRight);

TPageBorders = set of TPageBorder

TPixels = Cardinal

TPrintCanvas = TMetafileCanvas

TPrintPage = TMetafile

TZoomLocation = (zlTopLeft, zlTopCenter, zlCenter);

Constants

DateField = '{$DATE}'

These are expanded only in Headers, Footers, and Tables.

DefaultAvailablePageHeightIn = 10.5

In Inches

DefaultAvailablePageHeightMm = 284.0

In Millimeters

DefaultAvailablePageWidthIn = 8.0

DefaultAvailablePageWidthMm = 198.0

DefaultBorderWidth = 2

In Pixels

DefaultDPI = 300

DefaultGutterLeftIn = 0.25

DefaultGutterLeftMm = 6.0

DefaultGutterTopIn = 0.25

DefaultGutterTopMm = 6.0

DefaultPhysicalPageHeightIn = 11.0

DefaultPhysicalPageHeightMm = 297.0

DefaultPhysicalPageWidthIn = 8.5

DefaultPhysicalPageWidthMm = 210.0

LineField = '{$LINE}'

PageField = '{$PAGE}'

ProgressFinishMsg = ''

Progress Dialog Messages

SendingPagesMsg = 'Sending Pages To Printer'

TimeField = '{$TIME}'

TitleField = '{$TITLE}'


Variables