Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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. 
}