Распечатать только выделенный в 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
;

 { 
  The richedit1.perform( EM_FORMATRANGE call returns the index of the 
  last character that could be fitted into the passed fmtrange.rc, + 1. 
  So if  multiple pages are required one repeats with fmtrange.chrg.cpMin 
  set to this value, until all characters have been printed. 
}

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

• Escape код PASSTHROUGH
• Вместо печати графики использовать резидентный шрифт принтера
• Вывести все способы подачи бумаги для печати