{
The following example project
shows how to print a memos lines, but you can as well use
listbox.items, it will work with every TStrings descendent, even a
TStirnglist.
}unit PrintStringsUnit1;
interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender : TObject);
private{ Private declarations }procedure PrintHeader(aCanvas : TCanvas; aPageCount : integer;
aTextrect : TRect; var Continue : boolean);
procedure PrintFooter(aCanvas : TCanvas; aPageCount : integer;
aTextrect : TRect; var Continue : boolean);
public{ Public declarations }end;
var
Form1 : TForm1;
implementationuses Printers;
{$R *.DFM}type
THeaderFooterProc =
procedure(aCanvas : TCanvas; aPageCount : integer;
aTextrect : TRect; var Continue : boolean) ofobject;
{ Prototype for a callback method that PrintString will call
when it is time to print a header or footer on a page. The
parameters that will be passed to the callback are:
aCanvas : the canvas to output on
aPageCount: page number of the current page, counting from 1
aTextRect : output rectangle that should be used. This will be
the area available between non-printable margin and
top or bottom margin, in device units (dots). Output
is not restricted to this area, though.
continue : will be passed in as True. If the callback sets it
to false the print job will be aborted. }{+------------------------------------------------------------
| Function PrintStrings
|
| Parameters :
| lines:
| contains the text to print, already formatted into
| lines of suitable length. No additional wordwrapping
| will be done by this routine and also no text clipping
| on the right margin!
| leftmargin, topmargin, rightmargin, bottommargin:
| define the print area. Unit is inches, the margins are
| measured from the edge of the paper, not the printable
| area, and are positive values! The margin will be adjusted
| if it lies outside the printable area.
| linesPerInch:
| used to calculate the line spacing independent of font
| size.
| aFont:
| font to use for printout, must not be Nil.
| measureonly:
| If true the routine will only count pages and not produce any
| output on the printer. Set this parameter to false to actually
| print the text.
| OnPrintheader:
| can be Nil. Callback that will be called after a new page has
| been started but before any text has been output on that page.
| The callback should be used to print a header and/or a watermark
| on the page.
| OnPrintfooter:
| can be Nil. Callback that will be called after all text for one
| page has been printed, before a new page is started. The callback
| should be used to print a footer on the page.
| Returns:
| number of pages printed. If the job has been aborted the return
| value will be 0.
| Description:
| Uses the Canvas.TextOut function to perform text output in
| the rectangle defined by the margins. The text can span
| multiple pages.
| Nomenclature:
| Paper coordinates are relative to the upper left corner of the
| physical page, canvas coordinates (as used by Delphis Printer.Canvas)
| are relative to the upper left corner of the printable area. The
| printorigin variable below holds the origin of the canvas coordinate
| system in paper coordinates. Units for both systems are printer
| dots, the printers device unit, the unit for resolution is dots
| per inch (dpi).
| Error Conditions:
| A valid font is required. Margins that are outside the printable
| area will be corrected, invalid margins will raise an EPrinter
| exception.
| Created: 13.05.99 by P. Below
+------------------------------------------------------------}
function PrintStrings(Lines : TStrings;
const leftmargin, rightmargin,
topmargin, bottommargin: single;
const linesPerInch: single;
aFont: TFont;
measureonly: Boolean;
OnPrintheader,
OnPrintfooter: THeaderFooterProc): Integer;
var
continuePrint: Boolean; { continue/abort flag for callbacks }
pagecount: Integer; { number of current page }
textrect: TRect; { output area, in canvas coordinates }
headerrect: TRect; { area for header, in canvas
coordinates }
footerrect: TRect; { area for footes, in canvas
coordinates }
lineheight: Integer; { line spacing in dots }
charheight: Integer; { font height in dots }
textstart: Integer; { index of first line to print on
current page, 0-based. }{ Calculate text output and header/footer rectangles. }procedure CalcPrintRects;
var
X_resolution : Integer; { horizontal printer resolution, in dpi }
Y_resolution : Integer; { vertical printer resolution, in dpi }
pagerect : TRect; { total page, in paper coordinates }
printorigin : TPoint; { origin of canvas coordinate system in
paper coordinates. }{ Get resolution, paper size and non-printable margin from
printer driver. }procedure GetPrinterParameters;
beginwith Printer.Canvas dobegin
X_resolution := GetDeviceCaps(Handle, LOGPIXELSX);
Y_resolution := GetDeviceCaps(Handle, LOGPIXELSY);
printorigin.X := GetDeviceCaps(Handle, PHYSICALOFFSETX);
printorigin.Y := GetDeviceCaps(Handle, PHYSICALOFFSETY);
pagerect.Left := 0;
pagerect.Right := GetDeviceCaps(Handle, PHYSICALWIDTH);
pagerect.Top := 0;
pagerect.Bottom := GetDeviceCaps(Handle, PHYSICALHEIGHT);
end; { With }end; { GetPrinterParameters }{ Calculate area between the requested margins, paper-relative.
Adjust margins if they fall outside the printable area.
Validate the margins, raise EPrinter exception if no text area
is left. }procedure CalcRects;
var
max : integer;
beginwith textrect dobegin{ Figure textrect in paper coordinates }
Left := Round(leftmargin * X_resolution);
if Left < printorigin.x then
Left := printorigin.x;
Top := Round(topmargin * Y_resolution);
if Top < printorigin.y then
Top := printorigin.y;
{ Printer.PageWidth and PageHeight return the size of the
printable area, we need to add the printorigin to get the
edge of the printable area in paper coordinates. }
Right := pagerect.Right - Round(rightmargin * X_resolution);
max := Printer.PageWidth + printorigin.X;
if Right > max then
Right := max;
Bottom := pagerect.Bottom - Round(bottommargin *
Y_resolution);
max := Printer.PageHeight + printorigin.Y;
if Bottom > max then
Bottom := max;
{ Validate the margins. }if (Left >= Right) or (Top >= Bottom) thenraise EPrinter.Create("PrintString: the supplied margins are too large, there"
+
"is no area to print left on the page.");
end; { With }{ Convert textrect to canvas coordinates. }
OffsetRect(textrect, - printorigin.X, - printorigin.Y);
{ Build header and footer rects. }
headerrect := Rect(textrect.Left, 0,
textrect.Right, textrect.Top);
footerrect := Rect(textrect.Left, textrect.Bottom,
textrect.Right, Printer.PageHeight);
end; { CalcRects }begin{ CalcPrintRects }
GetPrinterParameters;
CalcRects;
lineheight := round(Y_resolution / linesPerInch);
end; { CalcPrintRects }{ Print a page with headers and footers. }procedure PrintPage;
procedure FireHeaderFooterEvent(event : THeaderFooterProc; r : TRect);
beginif Assigned(event) thenbegin
event(Printer.Canvas,
pagecount,
r,
ContinuePrint);
{ Revert to our font, in case event handler changed
it. }
Printer.Canvas.Font := aFont;
end; { If }end; { FireHeaderFooterEvent }procedure DoHeader;
begin
FireHeaderFooterEvent(OnPrintHeader, headerrect);
end; { DoHeader }procedure DoFooter;
begin
FireHeaderFooterEvent(OnPrintFooter, footerrect);
end; { DoFooter }procedure DoPage;
var
y : integer;
begin
y := textrect.Top;
while (textStart < Lines.Count) and
(y <= (textrect.Bottom - charheight)) dobegin{ Note: use TextRect instead of TextOut to effect clipping
of the line on the right margin. It is a bit slower,
though. The clipping rect would be
Rect( textrect.left, y, textrect.right, y+charheight). }
printer.Canvas.TextOut(textrect.Left, y, Lines[textStart]);
Inc(textStart);
Inc(y, lineheight);
end; { While }end; { DoPage }begin{ PrintPage }
DoHeader;
if ContinuePrint thenbegin
DoPage;
DoFooter;
if (textStart < Lines.Count) and ContinuePrint thenbegin
Inc(pagecount);
Printer.NewPage;
end; { If }end;
end; { PrintPage }begin{ PrintStrings }
Assert(Assigned(afont),
"PrintString: requires a valid aFont parameter!");
continuePrint := True;
pagecount := 1;
textstart := 0;
Printer.BeginDoc;
try
CalcPrintRects;
{$IFNDEF WIN32}{ Fix for Delphi 1 bug. }
Printer.Canvas.Font.PixelsPerInch := Y_resolution;
{$ENDIF }
Printer.Canvas.Font := aFont;
charheight := printer.Canvas.TextHeight("Дy");
while (textstart < Lines.Count) and ContinuePrint do
PrintPage;
finallyif continuePrint andnot measureonly then
Printer.EndDoc
elsebegin
Printer.Abort;
end;
end;
if continuePrint then
Result := pagecount
else
Result := 0;
end; { PrintStrings }procedure TForm1.Button1Click(Sender : TObject);
begin
ShowMessage(Format("%d pages printed",
[PrintStrings(memo1.Lines,
0.75, 0.5, 0.75, 1,
6,
memo1.Font,
False,
PrintHeader, PrintFooter)
]));
end;
procedure TForm1.PrintFooter(aCanvas : TCanvas; aPageCount : integer;
aTextrect : TRect; var Continue : boolean);
var
S: string;
res: integer;
beginwith aCanvas dobegin{ Draw a gray line one point wide below the text }
res := GetDeviceCaps(Handle, LOGPIXELSY);
pen.Style := psSolid;
pen.Color := clGray;
pen.Width := Round(res / 72);
MoveTo(aTextRect.Left, aTextRect.Top);
LineTo(aTextRect.Right, aTextRect.Top);
{ Print the page number in Arial 8pt, gray, on right side of
footer rect. }
S := Format("Page %d", [aPageCount]);
Font.Name := "Arial";
Font.Size := 8;
Font.Color := clGray;
TextOut(aTextRect.Right - TextWidth(S), aTextRect.Top + res div
18,
S);
end;
end;
procedure TForm1.PrintHeader(aCanvas : TCanvas; aPageCount : integer;
aTextrect : TRect; var Continue : boolean);
var
res: Integer;
beginwith aCanvas dobegin{ Draw a gray line one point wide 4 points above the text }
res := GetDeviceCaps(Handle, LOGPIXELSY);
pen.Style := psSolid;
pen.Color := clGray;
pen.Width := Round(res / 72);
MoveTo(aTextRect.Left, aTextRect.Bottom - res div 18);
LineTo(aTextRect.Right, aTextRect.Bottom - res div 18);
{ Print the company name in Arial 8pt, gray, on left side of
footer rect. }
Font.Name := "Arial";
Font.Size := 8;
Font.Color := clGray;
TextOut(aTextRect.Left, aTextRect.Bottom - res div 10 -
TextHeight("W"),
"W. W. Shyster & Cie.");
end;
end;
end.
Если Вас заинтересовала или понравилась информация по разработке на Delph - "Печать TMemo, TStringList или TStrings", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу: Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи, в сообщение обязательно указывайте название или ссылку на статью!