Tprinter print any table control

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.