procedure PrintStrings(S: TStrings; Font: TFont; Title: string);
var
LeftMargin, TopMargin, LineCoord, LineOnPage, LinesOnDoc,
CurrentLine, TextHeight, LinesPerPage, LineInterval: integer;
procedure StartDoc;
begin
LinesOnDoc := S.Count;
Printer.Canvas.Font.Assign(Font);
Printer.Canvas.TextOut(0, 0, ' ');
LeftMargin := (Printer.Canvas.Font.PixelsPerInch) div 2;
TopMargin := (Printer.Canvas.Font.PixelsPerInch) div 2;
TextHeight := Abs(Printer.Canvas.Font.Height);
LineInterval := TextHeight + (TextHeight div 2);
LinesPerPage := (Printer.PageHeight - TopMargin) div LineInterval;
CurrentLine := 0;
end;
function MorePages:boolean;
begin
Result := (CurrentLine < LinesOnDoc) and
not Printer.Aborted;
end;
procedure StartPage;
begin
LineOnPage := 0;
LineCoord := TopMargin;
end;
procedure NextPage;
begin
if MorePages then Printer.NewPage;
end;
function MoreLines:boolean;
begin
Result := (LineOnPage < LinesPerPage) and
(LineOnPage < LinesOnDoc) and
not Printer.Aborted;
end;
procedure NextLine;
begin
Inc(LineOnPage);
Inc(LineCoord, LineInterval);
Inc(CurrentLine);
end;
procedure PrintLine;
begin
Printer.Canvas.TextOut(LeftMargin, LineCoord, S.Strings[CurrentLine]);
end;
begin
Printer.Title := Title;
Printer.BeginDoc;
StartDoc;
while MorePages do
begin
StartPage;
while MoreLines do
begin
PrintLine;
NextLine;
Application.ProcessMessages;
end;
NextPage;
end;
Printer.EndDoc;
end;
|