Распечатать TStrings на принтере по умолчанию

Советы » Принтеры и Печать » Распечатать TStrings на принтере по умолчанию

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

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com