procedurePrintStrings(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
;