Tprinter print any table control

Source: Internet
Author: User
Tags textout

Unit MyLib;

Interface

Uses
Classes, Printers, DBGrids, Graphics, Sysutils, Windows, Forms, DB, Grids,
Dialogs, ComObj, Controls, StdCtrls, ShellAPI;

Type // print Tdbgrid
TPrnOut = class (TObject)
Procedure PrintHeader (s: string );
Procedure PrintFoot (s: string );
Procedure PrintLine (x1, y1, x2, y2: integer );
Procedure PrintRow (Items: TStringList; rowDBGrid: TDBGrid );
Procedure PrintColumns (colDBGrid: TDBGrid );
Procedure PrintRecords (recDBGrid: TDBGrid );
Procedure PrintPart (MDBG, PDBG: TDBGrid );
Procedure singledbuplint (DBgrid: TDBGrid; Header, Footer: string );
Procedure doubledbuplint (MainDBG, PartDBG: TDBGrid; Header, Footer: string );
Private
{Private declarations}
StrHead, strFoot: string;
IPage: integer;
IWordWidth, iWordHeight: integer; // unit word width and word height
IAmount: integer;
IPageHeight, iPageWidth: integer; // valid print area height and width
PixelsInInchX: integer;
{Number of pixels in 1/10 of an inch. This is used for lin spacing}
TenthsOfInchPixelsY: Integer;
End;

Type // print TstringGrid
TStrGridPrn = class (TObject)
Procedure PrintHeader (s: string );
Procedure PrintFoot (s: string );
Procedure PrintLine (x1, y1, x2, y2: integer );
Procedure PrintRow (Items: TStringList; StrGrid: TStringGrid );
Procedure PrintColumns (StrGrid: TStringGrid );
Procedure PrintRecords (StrGrid: TStringGrid );
Procedure StrGridPrint (StrGrid: TStringGrid; Header, Footer: string );
Private
{Private declarations}
StrHead, strFoot: string;
IPage: integer;
IWordWidth, iWordHeight: integer; // unit word width and word height
IAmount: integer;
IPageHeight, iPageWidth: integer; // valid print area height and width
PixelsInInchX: integer;
{Number of pixels in 1/10 of an inch. This is used for lin spacing}
TenthsOfInchPixelsY: Integer;
End;

Implementation

{TPrnOut}

Procedure TPrnOut. PrintHeader (s: string );
Begin
{Page header printing}
If s = ''then s: = '<no title> ';
With Printer do
Begin
With Canvas. Font do
Begin
Size: = 12;
Name: = ' ';
End;
If (not Aborted) then
Canvas. TextOut (PageWidth div 2)-(Canvas. TextWidth (s) div 2), 0, s );
IAmount: = iAmount + Canvas. TextHeight (s) * 2;
End;
End;

Procedure TPrnOut. PrintFoot (s: string );
Var
Str: string;
Begin
{Footer printing}
If s = ''then str: = s + 'dide' + IntToStr (iPage) + 'page'
Else str: = s + ''+ 'ted' + IntToStr (iPage) + 'page ';

With Printer do
If (not Aborted) then
Canvas. TextOut (PageWidth div 2)-(Canvas. TextWidth (str) div 2 ),
(IPageHeight-iWordHeight), str );
IAmount: = 0;
IPage: = iPage + 1;
End;

Procedure TPrnOut. PrintLine (x1, y1, x2, y2: integer );
Begin
With Printer. Canvas do
Begin
MoveTo (x1, y1 );
LineTo (x2, y2 );
End;
End;

Procedure TPrnOut. PrintRow (Items: TStringList; rowDBGrid: TDBGrid );
Var
OutRect: TRect;
I: integer;
Inches: Double;
Begin
OutRect. Left: = 50;
OutRect. Top: = iAmount;
With Printer. Canvas do
Begin
For I: = 0 to Items. Count-1 do
Begin
Inches: = LongInt (Items. Objects [I]) * 0.1;
OutRect. Right: = OutRect. Left + Round (PixelsInInchx * Inches );

If OutRect. Right> iPageWidth then
Begin
{Line feed printing}
OutRect. Left: = 70;
OutRect. Right: = 70 + OutRect. Left + Round (PixelsInInchx * Inches );
IAmount: = iAmount + iWordHeight;
OutRect. Top: = iAmount;
End;

{Page feed}
If (iAmount + iWordHeight)> (iPageHeight-iWordHeight) then
Begin
PrintFoot (''); // print the footer
IAmount: = 0;
If not Printer. Aborted then
Printer. NewPage;
PrintHeader ('');
PrintColumns (rowDBGrid); // print the column header
OutRect. Left: = 70;
OutRect. Right: = 70 + OutRect. Left + Round (PixelsInInchx * Inches );
IAmount: = iAmount + iWordHeight;
OutRect. Top: = iAmount;
End;

If not printer. Aborted then
TextRect (OutRect, OutRect. Left, OutRect. Top, Items [I]);
OutRect. Left: = OutRect. Right;
End;
End;
IAmount: = iAmount + iWordHeight + 2;
End;

Procedure TPrnOut. PrintColumns (colDBGrid: TDBGrid );
Var
Lst: TStringList;
I: integer;
Begin
{Print Column Title}
Lst: = TStringList. Create;
Try
{Get the printer size}
With printer. Canvas do
Begin
Font. Style: = [fsBold, fsUnderline];
IWordWidth: = TextWidth ('x ');
IWordHeight: = TextHeight ('x ');
End;
For I: = 0 to colDBGrid. Columns. Count-1 do
Lst. AddObject (colDBGrid. Columns [I]. Title. Caption,
Pointer (colDBGrid. Columns [I]. Width div 10) + 2 ));

PrintRow (lst, colDBGrid );
Printer. Canvas. Font. Style: = [];
Except
Lst. Free;
Printer. EndDoc;
End;
End;

Procedure TPrnOut. PrintRecords (recDBGrid: TDBGrid );
Var
Lst: TStringList;
I: integer;
Begin
{Print records}
Lst: = TStringList. Create;
Try
With recDBGrid. DataSource. DataSet do
Begin
First;
While (not Eof) or Printer. Aborted do
Begin
Application. ProcessMessages;
For I: = 0 to recDBGrid. Columns. Count-1 do
Lst. AddObject (recDBGrid. Columns [I]. Field. DisplayText,
Pointer (recDBGrid. Columns [I]. Width div 10) + 2 ));
PrintRow (lst, recDBGrid); // print rows
Lst. Clear;
Next;
End;
End;
Finally
Lst. Free;
End;
End;

Procedure TPrnOut. PrintPart (MDBG, PDBG: TDBGrid );
Var
Lst: TStringList;
I: integer;
Begin
Lst: = TStringList. Create;
Try
With MDBG. DataSource. DataSet do
Begin
First;
While (not Eof) do
Begin
Application. ProcessMessages;
For I: = 0 to FieldDefs. Count-1 do
Lst. AddObject (MDBG. Columns [I]. Field. DisplayText,
Pointer (MDBG. Columns [I]. Width div 10) + 2 ));
PrintRow (lst, MDBG); // print rows
Lst. Clear;
PrintColumns (PDBG );
PrintRecords (PDBG );
Next;
End;
End;
Finally
Lst. Free;
End;
End;

Procedure TPrnOut. singledbuplint (DBGrid: TDBGrid;
Header, Footer: string );
Begin
Screen. Cursor: = crHourglass;
StrHead: = Header;
StrFoot: = Footer;
IPage: = 1;
{Single table printing}
Try
With Printer do
Begin
PixelsInInchX: = GetDeviceCaps (Handle, LOGPIXELSX );
TenthsOfInchPixelsY: = GetDeviceCaps (Printer. Handle, LOGPIXELSY) div 10;
IPageHeight: = PageHeight;
IPageWidth: = PageWidth; // subtract the left and right margins
Canvas. Font. Size: = 11;
BeginDoc;
End;
{Print page header}
PrintHeader (Header );
{Print title bar: bold, underline}
PrintColumns (DBGrid );
{Print loop records}
PrintRecords (DBGrid );
{Print footer: page number}
PrintFoot (Footer );
Finally
Printer. EndDoc;
Screen. Cursor: = crDefault;
End;
End;

Procedure TPrnOut. doubledbuplint (MainDBG, PartDBG: TDBGrid;
Header, Footer: string );
Begin
Screen. Cursor: = crHourglass;
IPage: = 1;
{Detail table printing}
Try
With Printer do
Begin
PixelsInInchX: = GetDeviceCaps (Handle, LOGPIXELSX );
TenthsOfInchPixelsY: = GetDeviceCaps (Printer. Handle, LOGPIXELSY) div 10;
IPageHeight: = PageHeight;
IPageWidth: = PageWidth; // subtract the left and right margins
Canvas. Font. Size: = 11;
BeginDoc;
End;
{Print page header}
PrintHeader (Header );
{Print title bar: bold, underline}
PrintColumns (MainDBG );
{Print loop records}
PrintPart (MainDBG, PartDBG );
{Print footer: page number}
PrintFoot (Footer );
{New page START: repeat the previous work}
Finally
Printer. EndDoc;
Screen. Cursor: = crDefault;
End;
End;

{TStrGridPrn}

Procedure TStrGridPrn. PrintHeader (s: string );
Begin
{Page header printing}
If s = ''then s: = '<no title> ';
With Printer do
Begin
With Canvas. Font do
Begin
Size: = 12;
Name: = ' ';
End;
If (not Aborted) then
Canvas. TextOut (PageWidth div 2)-(Canvas. TextWidth (s) div 2), 0, s );
IAmount: = iAmount + Canvas. TextHeight (s) * 2;
End;
End;

Procedure TStrGridPrn. PrintFoot (s: string );
Var
Str: string;
Begin
{Footer printing}
If s = ''then str: = s + 'dide' + IntToStr (iPage) + 'page'
Else str: = s + ''+ 'ted' + IntToStr (iPage) + 'page ';

With Printer do
If (not Aborted) then
Canvas. TextOut (PageWidth div 2)-(Canvas. TextWidth (str) div 2 ),
(IPageHeight-iWordHeight), str );
IAmount: = 0;
IPage: = iPage + 1;
End;

Procedure TStrGridPrn. PrintLine (x1, y1, x2, y2: integer );
Begin
With Printer. Canvas do
Begin
MoveTo (x1, y1 );
LineTo (x2, y2 );
End;
End;

Procedure TStrGridPrn. PrintRow (Items: TStringList; StrGrid: TStringGrid );
Var
OutRect: TRect;
I: integer;
Inches: Double;
Begin
OutRect. Left: = 50;
OutRect. Top: = iAmount;
With Printer. Canvas do
Begin
For I: = 0 to Items. Count-1 do
Begin
Inches: = LongInt (Items. Objects [I]) * 0.1;
OutRect. Right: = OutRect. Left + Round (PixelsInInchx * Inches );

If OutRect. Right> iPageWidth then
Begin
{Line feed printing}
OutRect. Left: = 70;
OutRect. Right: = 70 + OutRect. Left + Round (PixelsInInchx * Inches );
IAmount: = iAmount + iWordHeight;
OutRect. Top: = iAmount;
End;

{Page feed}
If (iAmount + iWordHeight)> (iPageHeight-iWordHeight) then
Begin
PrintFoot (''); // print the footer
IAmount: = 0;
If not Printer. Aborted then
Printer. NewPage;
PrintHeader ('');
PrintColumns (StrGrid); // print the column header
OutRect. Left: = 70;
OutRect. Right: = 70 + OutRect. Left + Round (PixelsInInchx * Inches );
IAmount: = iAmount + iWordHeight;
OutRect. Top: = iAmount;
End;

If not printer. Aborted then
TextRect (OutRect, OutRect. Left, OutRect. Top, Items [I]);
OutRect. Left: = OutRect. Right;
End;
End;
IAmount: = iAmount + iWordHeight + 2;
End;

Procedure TStrGridPrn. PrintColumns (StrGrid: TStringGrid );
Var
Lst: TStringList;
I: integer;
Begin
{Print Column Title}
Lst: = TStringList. Create;
Try
{Get the printer size}
With printer. Canvas do
Begin
Font. Style: = [fsBold, fsUnderline];
IWordWidth: = TextWidth ('x ');
IWordHeight: = TextHeight ('x ');
End;
For I: = 0 to StrGrid. ColCount-1 do
Lst. AddObject (StrGrid. Cells [I, 0],
Pointer (StrGrid. ColWidths [I] div 10) + 2 ));

PrintRow (lst, StrGrid );
Printer. Canvas. Font. Style: = [];
Except
Lst. Free;
Printer. EndDoc;
End;
End;

Procedure TStrGridPrn. PrintRecords (StrGrid: TStringGrid );
Var
Lst: TStringList;
I, iRow: integer;
Begin
{Print records}
Lst: = TStringList. Create;
Try
For iRow: = 1 to StrGrid. RowCount-1 do
Begin
Application. ProcessMessages;
For I: = 0 to StrGrid. ColCount-1 do
Lst. AddObject (StrGrid. Cells [I, iRow],
Pointer (StrGrid. ColWidths [I] div 10) + 2 ));
PrintRow (lst, StrGrid); // print rows
Lst. Clear;
End;
Finally
Lst. Free;
End;
End;

Procedure TStrGridPrn. StrGridPrint (StrGrid: TStringGrid;
Header, Footer: string );
Begin
Screen. Cursor: = crHourglass;
StrHead: = Header;
StrFoot: = Footer;
IPage: = 1;
{Single table printing}
Try
With Printer do
Begin
PixelsInInchX: = GetDeviceCaps (Handle, LOGPIXELSX );
TenthsOfInchPixelsY: = GetDeviceCaps (Printer. Handle, LOGPIXELSY) div 10;
IPageHeight: = PageHeight;
IPageWidth: = PageWidth; // subtract the left and right margins
Canvas. Font. Size: = 11;
BeginDoc;
End;
{Print page header}
PrintHeader (Header );
{Print title bar: bold, underline}
PrintColumns (StrGrid );
{Print loop records}
PrintRecords (StrGrid );
{Print footer: page number}
PrintFoot (Footer );
Finally
Printer. EndDoc;
Screen. Cursor: = crDefault;
End;
End;

End.

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.