Печать TMemo, TStringList или TStrings

Delphi , ОС и Железо , Принтеры и Печать

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

{ 
  The following example project 
  shows how to print a memos lines, but you can as well use 
  listbox.items, it will work with every TStrings descendent, even a 
  TStirnglist. 
}

 unit PrintStringsUnit1;

 interface

 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs,
   StdCtrls;

 type
   TForm1 = class(TForm)
     Memo1: TMemo;
     Button1: TButton;
     procedure Button1Click(Sender : TObject);
   private
     { Private declarations }
     procedure PrintHeader(aCanvas : TCanvas; aPageCount : integer;
       aTextrect : TRect; var Continue : boolean);
     procedure PrintFooter(aCanvas : TCanvas; aPageCount : integer;
       aTextrect : TRect; var Continue : boolean);
   public
     { Public declarations }
   end;

 var
   Form1 : TForm1;

 implementation

 uses Printers;
 {$R *.DFM}

 type
   THeaderFooterProc =
     procedure(aCanvas : TCanvas; aPageCount : integer;
     aTextrect : TRect; var Continue : boolean) of object;
    { Prototype for a callback method that PrintString will call 
     when it is time to print a header or footer on a page. The 
     parameters that will be passed to the callback are: 
     aCanvas   : the canvas to output on 
     aPageCount: page number of the current page, counting from 1 
     aTextRect : output rectangle that should be used. This will be 
                 the area available between non-printable margin and 
                 top or bottom margin, in device units (dots). Output 
                 is not restricted to this area, though. 
     continue  : will be passed in as True. If the callback sets it 
                 to false the print job will be aborted. }

 {+------------------------------------------------------------ 
 | Function PrintStrings 
 | 
 | Parameters : 
 |   lines: 
 |     contains the text to print, already formatted into 
 |     lines of suitable length. No additional wordwrapping 
 |     will be done by this routine and also no text clipping 
 |     on the right margin! 
 |   leftmargin, topmargin, rightmargin, bottommargin: 
 |     define the print area. Unit is inches, the margins are 
 |     measured from the edge of the paper, not the printable 
 |     area, and are positive values! The margin will be adjusted 
 |     if it lies outside the printable area. 
 |   linesPerInch: 
 |     used to calculate the line spacing independent of font 
 |     size. 
 |   aFont: 
 |     font to use for printout, must not be Nil. 
 |   measureonly: 
 |     If true the routine will only count pages and not produce any 
 |     output on the printer. Set this parameter to false to actually 
 |     print the text. 
 |   OnPrintheader: 
 |     can be Nil. Callback that will be called after a new page has 
 |     been started but before any text has been output on that page. 
 |     The callback should be used to print a header and/or a watermark 
 |     on the page. 
 |   OnPrintfooter: 
 |     can be Nil. Callback that will be called after all text for one 
 |     page has been printed, before a new page is started. The  callback 
 |     should be used to print a footer on the page. 
 | Returns: 
 |   number of pages printed. If the job has been aborted the return 
 |   value will be 0. 
 | Description: 
 |   Uses the Canvas.TextOut function to perform text output in 
 |   the rectangle defined by the margins. The text can span 
 |   multiple pages. 
 | Nomenclature: 
 |   Paper coordinates are relative to the upper left corner of the 
 |   physical page, canvas coordinates (as used by Delphis  Printer.Canvas) 
 |   are relative to the upper left corner of the printable area. The 
 |   printorigin variable below holds the origin of the canvas  coordinate 
 |   system in paper coordinates. Units for both systems are printer 
 |   dots, the printers device unit, the unit for resolution is dots 
 |   per inch (dpi). 
 | Error Conditions: 
 |   A valid font is required. Margins that are outside the printable 
 |   area will be corrected, invalid margins will raise an EPrinter
  |   exception.
  | Created: 13.05.99 by P. Below
  +------------------------------------------------------------}
 function PrintStrings(Lines : TStrings;
   const leftmargin, rightmargin,
   topmargin, bottommargin: single;
   const linesPerInch: single;
   aFont: TFont;
   measureonly: Boolean;
   OnPrintheader,
   OnPrintfooter: THeaderFooterProc): Integer;
 var
   continuePrint: Boolean;     { continue/abort flag for callbacks }
   pagecount: Integer;     { number of current page }
   textrect: TRect;       { output area, in canvas coordinates }
   headerrect: TRect;       { area for header, in canvas 
coordinates }
   footerrect: TRect;       { area for footes, in canvas 
coordinates }
   lineheight: Integer;     { line spacing in dots }
   charheight: Integer;     { font height in dots  }
   textstart: Integer;     { index of first line to print on 
                                  current page, 0-based. }

   { Calculate text output and header/footer rectangles. }
   procedure CalcPrintRects;
   var
     X_resolution : Integer;  { horizontal printer resolution, in dpi }
     Y_resolution : Integer;  { vertical printer resolution, in dpi }
     pagerect : TRect;    { total page, in paper coordinates }
     printorigin : TPoint;   { origin of canvas coordinate system in 
                                paper coordinates. }

     { Get resolution, paper size and non-printable margin from 
      printer driver. }
     procedure GetPrinterParameters;
     begin
       with Printer.Canvas do
       begin
         X_resolution := GetDeviceCaps(Handle, LOGPIXELSX);
         Y_resolution := GetDeviceCaps(Handle, LOGPIXELSY);
         printorigin.X := GetDeviceCaps(Handle, PHYSICALOFFSETX);
         printorigin.Y := GetDeviceCaps(Handle, PHYSICALOFFSETY);
         pagerect.Left := 0;
         pagerect.Right := GetDeviceCaps(Handle, PHYSICALWIDTH);
         pagerect.Top := 0;
         pagerect.Bottom := GetDeviceCaps(Handle, PHYSICALHEIGHT);
       end; { With }
     end; { GetPrinterParameters }

     { Calculate area between the requested margins, paper-relative. 
      Adjust margins if they fall outside the printable area. 
      Validate the margins, raise EPrinter exception if no text area 
      is left. }
     procedure CalcRects;
     var
       max : integer;
     begin
       with textrect do
       begin
         { Figure textrect in paper coordinates }
         Left := Round(leftmargin * X_resolution);
         if Left < printorigin.x then
           Left := printorigin.x;

         Top := Round(topmargin * Y_resolution);
         if Top < printorigin.y then
           Top := printorigin.y;

           { Printer.PageWidth and PageHeight return the size of the 
            printable area, we need to add the printorigin to get the 
            edge of the printable area in paper coordinates. }
         Right := pagerect.Right - Round(rightmargin * X_resolution);
         max := Printer.PageWidth + printorigin.X;
         if Right > max then
           Right := max;

         Bottom := pagerect.Bottom - Round(bottommargin *
           Y_resolution);
         max := Printer.PageHeight + printorigin.Y;
         if Bottom > max then
           Bottom := max;

         { Validate the margins. }
         if (Left >= Right) or (Top >= Bottom) then
           raise EPrinter.Create('PrintString: the supplied margins are too large, there'
             +
             'is no area to print left on the page.');
       end; { With }

       { Convert textrect to canvas coordinates. }
       OffsetRect(textrect, - printorigin.X, - printorigin.Y);

       { Build header and footer rects. }
       headerrect := Rect(textrect.Left, 0,
         textrect.Right, textrect.Top);
       footerrect := Rect(textrect.Left, textrect.Bottom,
         textrect.Right, Printer.PageHeight);
     end; { CalcRects }
   begin { CalcPrintRects }
     GetPrinterParameters;
     CalcRects;
     lineheight := round(Y_resolution / linesPerInch);
   end; { CalcPrintRects }

   { Print a page with headers and footers. }
   procedure PrintPage;
     procedure FireHeaderFooterEvent(event : THeaderFooterProc; r : TRect);
     begin
       if Assigned(event) then
       begin
         event(Printer.Canvas,
           pagecount,
           r,
           ContinuePrint);
           { Revert to our font, in case event handler changed 
            it. }
         Printer.Canvas.Font := aFont;
       end; { If }
     end; { FireHeaderFooterEvent }

     procedure DoHeader;
     begin
       FireHeaderFooterEvent(OnPrintHeader, headerrect);
     end; { DoHeader }

     procedure DoFooter;
     begin
       FireHeaderFooterEvent(OnPrintFooter, footerrect);
     end; { DoFooter }

     procedure DoPage;
     var
       y : integer;
     begin
       y := textrect.Top;
       while (textStart < Lines.Count) and
         (y <= (textrect.Bottom - charheight)) do
       begin
           { Note: use TextRect instead of TextOut to effect clipping 
            of the line on the right margin. It is a bit slower, 
            though. The clipping rect would be 
            Rect( textrect.left, y, textrect.right, y+charheight). }
         printer.Canvas.TextOut(textrect.Left, y, Lines[textStart]);
         Inc(textStart);
         Inc(y, lineheight);
       end; { While }
     end; { DoPage }
   begin { PrintPage }
     DoHeader;
     if ContinuePrint then
     begin
       DoPage;
       DoFooter;
       if (textStart < Lines.Count) and ContinuePrint then
       begin
         Inc(pagecount);
         Printer.NewPage;
       end; { If }
     end;
   end; { PrintPage }
 begin { PrintStrings }
   Assert(Assigned(afont),
     'PrintString: requires a valid aFont parameter!');

   continuePrint := True;
   pagecount := 1;
   textstart := 0;
   Printer.BeginDoc;
   try
     CalcPrintRects;
     {$IFNDEF WIN32}
     { Fix for Delphi 1 bug. }
     Printer.Canvas.Font.PixelsPerInch := Y_resolution;
     {$ENDIF }
     Printer.Canvas.Font := aFont;
     charheight := printer.Canvas.TextHeight('Дy');
     while (textstart < Lines.Count) and ContinuePrint do
       PrintPage;
   finally
     if continuePrint and not measureonly then
       Printer.EndDoc
     else
     begin
       Printer.Abort;
     end;
   end;

   if continuePrint then
     Result := pagecount
   else
     Result := 0;
 end; { PrintStrings }


 procedure TForm1.Button1Click(Sender : TObject);
 begin
   ShowMessage(Format('%d pages printed',
     [PrintStrings(memo1.Lines,
     0.75, 0.5, 0.75, 1,
     6,
     memo1.Font,
     False,
     PrintHeader, PrintFooter)
     ]));
 end;

 procedure TForm1.PrintFooter(aCanvas : TCanvas; aPageCount : integer;
   aTextrect : TRect; var Continue : boolean);
 var
   S: string;
   res: integer;
 begin
   with aCanvas do
   begin
     { Draw a gray line one point wide below the text }
     res := GetDeviceCaps(Handle, LOGPIXELSY);
     pen.Style := psSolid;
     pen.Color := clGray;
     pen.Width := Round(res / 72);
     MoveTo(aTextRect.Left, aTextRect.Top);
     LineTo(aTextRect.Right, aTextRect.Top);
     { Print the page number in Arial 8pt, gray, on right side of 
      footer rect. }
     S := Format('Page %d', [aPageCount]);
     Font.Name := 'Arial';
     Font.Size := 8;
     Font.Color := clGray;
     TextOut(aTextRect.Right - TextWidth(S), aTextRect.Top + res div
       18,
       S);
   end;
 end;

 procedure TForm1.PrintHeader(aCanvas : TCanvas; aPageCount : integer;
   aTextrect : TRect; var Continue : boolean);
 var
   res: Integer;
 begin
   with aCanvas do
   begin
     { Draw a gray line one point wide 4 points above the text }
     res := GetDeviceCaps(Handle, LOGPIXELSY);
     pen.Style := psSolid;
     pen.Color := clGray;
     pen.Width := Round(res / 72);
     MoveTo(aTextRect.Left, aTextRect.Bottom - res div 18);
     LineTo(aTextRect.Right, aTextRect.Bottom - res div 18);
     { Print the company name in Arial 8pt, gray, on left side of 
      footer rect. }
     Font.Name := 'Arial';
     Font.Size := 8;
     Font.Color := clGray;
     TextOut(aTextRect.Left, aTextRect.Bottom - res div 10 -
       TextHeight('W'),
       'W. W. Shyster & Cie.');
   end;
 end;

 end.

Пример использования функциональности печати в Delphi для вывода содержимого компонента TMemo или TStringList.

Код определяет функцию PrintStrings, которая принимает несколько параметров, включая текст для печати, рамки, шрифт и флаг измерения только (т.е., подсчет страниц без фактической печати). Функция рассчитывает количество страниц, необходимых для печати текста, и печатает каждую страницу с заголовками и подвалами.

Процедуры PrintHeader и PrintFooter являются callback-функциями, вызываемыми функцией PrintStrings, чтобы напечатать заголовок и подвал на каждой странице. В этом примере они рисуют серую линию выше и ниже текста, а также печатают название компании в Arial 8pt, серый, слева от заголовка.

Код также включает форму с кнопкой, которая вызывает функцию PrintStrings, чтобы напечатать содержимое компонента TMemo. Рамки, шрифт и другие параметры устанавливаютсяusing свойства компонента TMemo.

Следующий разбор кода:

• PrintStrings: Функция принимает несколько параметров и рассчитывает количество страниц, необходимых для печати текста.
• CalcPrintRects: Процедура рассчитывает область между запрошенными рамками, корректирует их, если они выходят за пределы печатаемой области, и проверяет рамки. Она также конвертирует прямоугольник текста в координаты канваса.
• PrintPage: Процедура печатает страницу с заголовками и подвалами. Она вызывает FireHeaderFooterEvent, чтобы выполнить callback-функции для заголовка и подвала.
• Button1Click: Событийный обработчик, вызываемый при клике кнопки на форме. Он вызывает функцию PrintStrings, чтобы напечатать содержимое компонента TMemo.

Обратите внимание, что это код использует функциональность печати Delphi, которая может не быть совместима с всеми принтерами или драйверами принтеров. Кроме того, код предполагает, что шрифт, используемый в компоненте TMemo, является действительным и может использоваться для печати.

Печать TMemo, TStringList или TStrings: пример программы на Delphi, которая демонстрирует способ печати текста из memo-компонента, списка строк или любого другого компонента, наследуемого от TStrings.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Принтеры и Печать ::