Imprimer le texte sélectionné dans un TRichedit

uses
Richedit;

procedure TForm1.Button1Click(Sender: TObject);
var
printarea: TRect;
richedit_outputarea: TRect;
printresX, printresY: Integer;
fmtRange: TFormatRange;
nextChar: Integer;
S: string;
begin
Printer.BeginDoc;
try
with Printer.Canvas do
begin
printresX := GetDeviceCaps(Handle, LOGPIXELSX);
printresY := GetDeviceCaps(Handle, LOGPIXELSY);
printarea :=
Rect(printresX, // 1 inch left margin
printresY * 3 div 2, // 1.5 inch top margin
Printer.PageWidth - printresX, // 1 inch right margin
Printer.PageHeight - printresY * 3 div 2 // 1.5 inch
Bottom Margin);
// Define a rectangle for the rich edit text. The height is set
to the
// maximum. But we need to convert from device units to twips,
// 1 twip = 1/1440 inch or 1/20 point.
richedit_outputarea :=
Rect(printarea.Left * 1440 div printresX,
printarea.Top * 1440 div printresY,
printarea.Right * 1440 div printresX,
printarea.Bottom * 1440 div printresY);

// Tell rich edit to format its text to the printer. First set
// up data record for message:
fmtRange.hDC := Handle; // printer handle
fmtRange.hdcTarget := Handle; // ditto
fmtRange.rc := richedit_outputarea;
fmtRange.rcPage := Rect(0, 0,
Printer.PageWidth * 1440 div printresX,
Printer.PageHeight * 1440 div printresY);
// set range of characters to print to selection
fmtRange.chrg.cpMin := richedit1.selstart;
fmtRange.chrg.cpMax := richedit1.selStart + richedit1.sellength - 1;

// remove characters that need not be printed from end of
selection.
// failing to do so screws up the repeat loop below.
S := richedit1.SelText;
while (fmtRange.chrg.cpMax > 0) and
(S[fmtRange.chrg.cpMax] <= ' ') do Dec(fmtRange.chrg.cpMax);

repeat
// Render the text
nextChar := richedit1.Perform(EM_FORMATRANGE, 1, Longint(@fmtRange));
if nextchar < fmtRange.chrg.cpMax then
begin
// more text to print
printer.newPage;
fmtRange.chrg.cpMin := nextChar;
end; { If }
until nextchar >= fmtRange.chrg.cpMax;

// Free cached information
richedit1.Perform(EM_FORMATRANGE, 0, 0);
end;
finally
Printer.EndDoc;
end;
end;
Ajouter un commentaire
Pseudo
Adresse email
Site internet (optionnel)
Votre commentaire
Fiche de l'article
Mise a jour15/06/2002
VisualisationVu 1118 fois
PublicInternaute zz
CategorieDelphi - Trucs et astuces - Objet
Auteur de l'article
SwissDelphiCenter SwissDelphiCenter
connecté le 02/11/2011
329 articles dans la section
Contacter l'auteur