Mega Code Archive
Printing a TStringGrid
<![CDATA[
Title: Printing a TStringGrid
Question: How do I print the selected rows of a TStringGrid?
Answer:
Here is a component that I wrote to print out the selected lines (to the printer) of a TStringGrid, its called TPrintGrid.
I hope enjoy it, if you have any questions, comments, suggestions - please don't hesitate to ask me.
-Bradley Baumann
www.scrapcode.com
bradley@bestweb.net / _@scrapcode.com
unit PrintGrid;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, Printers;
type
TPrintGrid = class(TStringGrid)
private
FPrintAborted:boolean;
protected
public
procedure PrintGrid;
published
end;
procedure Register;
implementation
procedure TPrintGrid.PrintGrid;
var
margins: trect;
spacing: integer;
cols: tlist;
procedure setcolumnwidth;
var
i, k, w: integer;
begin
Printer.Canvas.Font.Style := [ fsBold ];
for i := 0 to pred( ColCount ) do
Cols.Add(Pointer(Printer.Canvas.TextWidth(cells[i,0])));
printer.canvas.font.style := [];
for i := 1 to pred(rowcount ) do
for k := 0 to pred(colcount ) do
begin
w:= printer.canvas.textwidth( cells[ k, i ] );
if w integer( cols[ k ] ) then
cols[ k ] := pointer( w );
end;
w := 2 * printer.canvas.font.pixelsperinch div 3;
margins :=rect( w, w, printer.pagewidth-w, printer.pageheight - w );
spacing := printer.canvas.font.pixelsperinch div 10;
w := 0;
for i := 0 to pred(cols.count) do
w := w + integer( cols[ i ] ) + spacing;
w := w - spacing;
if w (margins.right-margins.left ) then
begin
w := w - (margins.right-margins.left );
cols[ cols.count-2 ] :=pointer( integer( cols[ cols.count-2 ] ) - w );
end; { if }
w:= 0;
for i := 0 to pred(cols.count) do
w := w + integer( cols[ i ] ) + spacing;
margins.right := w - spacing + margins.left;
end; { setcolumnwidth }
procedure doprint;
var
i: integer;
y: integer;
procedure doline(lineno: integer);
var
x, n: integer;
r: trect;
th: integer;
begin
if length(cells[1,lineno]) = 0 then exit;
x:= margins.left;
with printer.canvas do
begin
th := textheight( 'y' );
for n := 0 to pred( cols.count ) do
begin
r := rect( 0, 0, integer(cols[ n ]), th);
offsetrect( r, x, y );
textrect( r, x, y, cells[ n, lineno ] );
x := r.right + spacing;
end; { for }
end; { with }
y := y + th;
end; { doline }
procedure doheader;
begin
y := margins.top;
with printer.canvas do
begin
font.style := [ fsbold ];
doline( 0 );
pen.width := font.pixelsperinch div 72;
pen.color := clblack;
moveto( margins.left, y );
lineto( margins.right, y );
inc( y, 2 * pen.width );
font.style := [ ];
end; { with }
end; { doheader }
begin
y:= 0;
for i := 1 to pred( rowcount ) do
begin
application.processmessages;
if fprintaborted then
exit;
if y = 0 then
doheader;
doline( i );
if y = margins.bottom then
begin
printer.newpage;
y:= 0;
end; { if }
end; { for }
end; { doprint }
begin
fprintaborted := false;
try
show;
application.processmessages;
if printer.printing then
{$ifdef win32}
printer.abort;
{$else}
abortdoc( printer.canvas.handle );
{$endif}
printer.begindoc;
cols:= nil;
try
cols:= tlist.create;
{$ifndef win32}
printer.canvas.font.pixelsperinch :=
getdevicecaps( printer.handle, logpixelsy );
{$endif}
printer.canvas.font.assign( font );
printer.canvas.font.color :=clblack;
printer.canvas.pen.color := clblack;
setcolumnwidth;
application.processmessages;
doprint;
finally
cols.free;
if fprintaborted then
{$ifdef win32}
printer.abort
{$else}
abortdoc( printer.canvas.handle )
{$endif}
else
printer.enddoc;
end;
finally
begin
end;
end;
end; { with }
procedure Register;
begin
RegisterComponents('PrintGrid', [TPrintGrid]);
end;
end.
]]>