Znalazłem takie procedurki, ale jest problem, ponieważ tekst, który mam w richedit jest z formatowaniem (pogrubienie, podkreślenie, wielkość czcionki), a zastosowane tam komendy "kasują" formatowanie i tekst wydrukowany jest niesformatowany.
Procedure tform1.PrintPagedRichEdit ( RichEdit : TRichEdit; DocName : String );
var iPos, iPage: integer;
sSaveText, sCurrentPageText, sRemainingText: string;
bOnePageDocument: boolean;
begin
iPos := Pos(#12, RichEdit.Text);
bOnePageDocument := True;
{save off the current richedit text}
sSaveText := RichEdit.Text;
iPage := 0;
repeat
{Scan Richedit for #12 characters that indicate page breaks}
iPos := Pos(#12, RichEdit.Text);
if (iPos > 0) then begin
bOnePageDocument := False;
{Copy the text up until the page break}
sCurrentPageText := Copy(RichEdit.Text, 1, iPos - 1);
{Save off the text that follows the page break}
sRemainingText := Copy(RichEdit.Text, iPos + 1, Length
(RichEdit.Text)-iPos);
{Set the RichEdit to the current page text and print it}
RichEdit.Text := sCurrentPageText;
inc(iPage);
PrintRichEdit(RichEdit, DocName + ' - page ' + IntToStr(iPage));
RichEdit.Text := sRemainingText;
end
else begin
if bOnePageDocument then begin
{Normal print, no page break characters found}
PrintRichEdit(RichEdit, DocName);
end
else begin
{Print the last page of a multi-page document}
inc(iPage);
PrintRichEdit(RichEdit, DocName + ' - page ' + IntToStr(iPage));
end;
end;
until (iPos <= 0);
{We overwrote the text for printing, so restore the original}
RichEdit.Text := sSaveText;
end;
Procedure tform1.PrintRichEdit ( RichEdit : TRichEdit; DocName : String );
var
Range: TFormatRange;
LastChar, MaxLen, LogX, LogY, OldMap, xqtr, yqtr : Integer;
SaveRect: TRect;
sPage : String;
begin
FillChar(Range, SizeOf(TFormatRange), 0);
with Printer, Range do begin
Title := DocName;
BeginDoc;
hdc := Handle;
hdcTarget := hdc;
LogX := GetDeviceCaps(Handle, LOGPIXELSX);
LogY := GetDeviceCaps(Handle, LOGPIXELSY);
xqtr := logx div 4;
yqtr := logy div 4;
if IsRectEmpty(RichEdit.PageRect) then begin
rc.top := logy + (2*yqtr);
rc.right := ((PageWidth * 1440) div LogX)-xqtr;
rc.bottom := ((PageHeight * 1440) div LogY)-((yqtr * 2) + logy );
rc.Left := rc.Left + xqtr;
end
else begin
rc.left := RichEdit.PageRect.Left * 1440 div LogX;
rc.top := RichEdit.PageRect.Top * 1440 div LogY;
rc.right := RichEdit.PageRect.Right * 1440 div LogX;
rc.bottom := RichEdit.PageRect.Bottom * 1440 div LogY;
end;
rcPage := rc;
SaveRect := rc;
LastChar := 0;
MaxLen := RichEdit.GetTextLen;
chrg.cpMax := -1;
{ ensure printer DC is in text map mode }
OldMap := SetMapMode(hdc, MM_TEXT);
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); { flush
buffer }
try
repeat
rc := SaveRect;
chrg.cpMin := LastChar;
LastChar := SendMessage(RichEdit.Handle, EM_FORMATRANGE, 1,
Longint(@Range));
If true {frmOptions.cbPrintDocName.Checked} Then
Printer.Canvas.TextOut (((Printer.PageWidth-xqtr) div 2) -
(Printer.Canvas.TextWidth(ExtractFileName(DocName)) div 2),
(yqtr div 2), ExtractFileName(docName));
If true {frmOptions.cbPrintPageNo.Checked} Then Begin
Printer.Canvas.Pen.Width := 2;
Printer.Canvas.MoveTo ( xqtr, Printer.PageHeight-yqtr );
Printer.Canvas.LineTo ( Printer.PageWidth-xqtr,
Printer.PageHeight-yqtr );
sPage := Format ( 'Page: %d', [Printer.PageNumber]);
Printer.Canvas.TextOut (((Printer.PageWidth-xqtr) div 2) -
(Printer.Canvas.TextWidth(sPage) div 2),
(Printer.PageHeight-(yqtr) + (yqtr div 4)), sPage );
End;
if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
until (LastChar >= MaxLen) or (LastChar = -1);
EndDoc;
finally
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); { flush
buffer }
SetMapMode(hdc, OldMap); { restore previous map mode }
Application.ProcessMessages;
end;
end;
end;