Memo1-Print

2 отговора 100 прегледа
#1

Memo1-Print

Shte prozvychi sigyrno mnogo glypavo,no az ne znam-"Kak da rapechatam teksta
ot Memo1 i Stringgrid1 na printer"

Отговор
в отговор на Pesho #2

Re: Memo1-Print

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;

//използваш я така:
....

PrintStrings(Memo1.Lines, MyFont, 'Разпечатка на нещо си')

...
// MyFont е създаден и инициализиран предварително

Отговор