At 08:20 30/03/2005, you wrote:
Is this possible? If so how,
because the StrGrid.Col[0] doesn't have a width property...only a default
width that sets all of them the same including the fixed column!
Grid.ColWidths[n] := 108;
Grid.RowHeights[n] := 48;
Also, I was under the impression I could store a stringgrid with any
string info it's cells contain, including that in it's fixed columns, to a
text file and then load the stringgrid back up with that same info directly
from the file. It seems the individual column text can be saved that way
but not all in one file. How is this handled?
I normally save it to a table, like a data aware grid, but you have to code
that yourself.
Finally, Because this particular grid will be used by a restaurant
manager to set her waitress's working hours, I need to be able to print a
copy of the grid out in landscape format after she has made all the entries
for a particular week. I don't want a print screen because that would show
the entire form...just the grid itself. How can this best be accomplished?
Attached is a unit with a couple of routines for printing from string
grids. They were written a few years ago, either in D1 or D4, but I think
they all worked and I have just checked that they compile in D7.
>From "Robert Meek"
Personal e-mail: [EMAIL PROTECTED]
dba / "Tangentals Design"
Visit us at: www.TangentalsDesign.com
Home of "The Keep"!
Member of: "Association of Shareware Professionals"
Moderator for: "The Delphi", "Delphi-DB", and "Delphi-Talk"
programming lists at elists.org, and "DelphiTalk.net"
at www.DelphiTalk.net
_______________________________________________
Delphi mailing list -> [email protected]
http://www.elists.org/mailman/listinfo/delphi
unit DataPrint;
(* basic classes for generic printing *)
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, DBTables, StdCtrls, Buttons, Grids, DBClient;
type
TDataPrinter = class
private
FLineheight,
FLinesPerPage,
FDataLines,
FPages,
FPageNo,
FRecNo,
FCols,
FRows: integer;
ArrayInit: boolean;
FColData: array of array of integer;
procedure SetJust(Just, Col: integer);
procedure SetDisp(Disp, Col: integer);
procedure SetIdx(Idx, Col: integer);
procedure InitArray;
protected
public
property Justification[Just: integer]: integer write SetJust;
property DisplayWidth[Disp: integer]: integer write SetDisp;
property ColumnIndex[Idx: integer]: integer write SetIdx;
constructor Create;
constructor CreateSize(Cols: integer);
function SimplePrint(Grid: TStringGrid; HeadStr: string = ''; po: integer =
0): integer; overload;
function WidePrint(Grid: TStringGrid; HeadStr: string = ''; po: integer =
0): integer; overload;
function SimplePrint(Grid: TStringGrid; FText: TStringList; po: integer =
0): integer; overload;
function WidishPrint(Grid: TStringGrid; HeadStr: string = ''; po: integer =
0): integer; overload;
end;
implementation
uses
Printers;
procedure TDataPrinter.SetJust(Just, Col: integer);
begin
if (ArrayInit) and (Col < Length(FColData)) then FColData[Col, 1] := Just;
end;
procedure TDataPrinter.SetDisp(Disp, Col: integer);
begin
if (ArrayInit) and (Col < Length(FColData)) then FColData[Col, 2] := Disp;
end;
procedure TDataPrinter.SetIdx(Idx, Col: integer);
begin
if (ArrayInit) and (Col < Length(FColData)) then FColData[Col, 0] := Idx;
end;
constructor TDataPrinter.Create;
begin
Inherited Create;
ArrayInit := false;
FCols := 0;
FRows := 0;
end;
constructor TDataPrinter.CreateSize(Cols: integer);
begin
Inherited Create;
FRows := 0;
FCols := Cols;
InitArray;
end;
(* initialise column data array *)
procedure TDataPrinter.InitArray;
var
i, j: integer;
begin
SetLength(FColData, (FCols + 1)); //need to hold end of last row
for i := 0 to (FCols) do begin //so array is cols + 1
SetLength(FColData[i], 3);
FColData[i,0] := i; //initialise to current index
for j := 1 to 2 do
FColData[i,j] := 0; //initialise to zero
end; //for
ArrayInit := true; // should not be done again
end;
(*
Accept TStringGrid, assuming that the column indexes have been set after
construction, if required. This uses the current font and does not try to
resize the font. It is also left justified only.
The maximum data width for each column is found and set with respect to the
canvas. Top and left margins are set and line spacing calculated. It is a
large spacing to allow for grid lines, which are always drawn.
Column headers and page numbers are written on all pages.
It uses the current printer, which will be the default unless a different
printer has already been selected from within this occurrence of the program.
NB if A3 has been previously selected, then that is what will be used.
If the printing is too wide, then only the stuff that fits will be printed.
*)
function TDataPrinter.SimplePrint(Grid: TStringGrid; HeadStr: string = '';
po: integer = 0): integer;
var
CurHeight, CurIndent, LeftMargin, TopMargin, XOffset, YOffset, FarRight:
integer;
c, p, r, sl, TopStart: integer;
tmpStr, trimStr: string;
begin
try
Result := 0;
if not ArrayInit then begin
FCols := Grid.ColCount;
InitArray;
end;
with Printer do begin
if po = 0 then Orientation := poPortrait
else if po = 1 then Orientation := poLandscape; //pass 2 to ignore
this setting
LeftMargin := Canvas.TextWidth('XXXXX');
TopMargin := (Canvas.TextHeight('X') * 2);
FLineHeight := (Canvas.TextHeight('H')* 2);
FLinesPerPage := ((PageHeight - TopMargin) div FLineHeight) - 2; //data
lines
FDataLines := FLinesPerpage;
if ((Grid.RowCount) mod FLinesPerPage) = 0 then
FPages := ((Grid.RowCount) div FLinesPerPage)
else FPages := ((Grid.RowCount) div FLinesPerPage) + 1;
if HeadStr <> '' then begin //header string has text so add 2 lines
per page
if ((Grid.RowCount + (FPages * 2)) mod FLinesPerPage) = 0 then
FPages := ((Grid.RowCount + (FPages * 2)) div FLinesPerPage)
else FPages := ((Grid.RowCount + (FPages * 2)) div FLinesPerPage) + 1;
FDataLines := FLinesPerpage - 2;
end;
XOffset := Canvas.TextWidth('c');
YOffset := FLineheight div 4;
FColData[0,2] := LeftMargin;
FarRight := LeftMargin;
for c := 0 to Pred(FCols) do begin
sl := 3;
tmpStr := 'XXX';
for r := 0 To Pred(Grid.RowCount) do begin
trimStr := Trim(Grid.Cells[c,r]);
if Length(trimStr) > sl then begin
sl := Length(trimStr);
tmpStr := Copy(trimStr,1,sl);
end; //if
end;
if sl < 15 then AppendStr(tmpStr, 'XX') else AppendStr(tmpStr, 'XXXX');
FColData[(c + 1),2] := Canvas.TextWidth(tmpStr);
FarRight := FarRight + Canvas.TextWidth(tmpStr);
end;
FPageNo := 1;
CurHeight := TopMargin;
FRecNo := 1;
BeginDoc;
for p := 1 to FPages do begin //for each page
CurIndent := 0; //set top line
TopStart := TopMargin;
if HeadStr <> '' then begin //write header
Canvas.TextOut(LeftMargin, CurHeight, HeadStr);
inc(CurHeight, (FLineHeight * 2));
TopStart := CurHeight;
end; //if header string has text
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(FarRight, (CurHeight - YOffset));
for c := 0 to Pred(FCols) do begin //print headers
Inc(CurIndent, FColData[c,2]);
Canvas.TextOut(CurIndent, CurHeight, Grid.Cells[FColData[c,0],0]);
end; //for c - done headers
inc(Curheight, FLineHeight); //next line
for r := 1 to (FDataLines) do begin //for each data line
CurIndent := 0; //set to page left
if FRecNo < Grid.RowCount then begin //if not yet last
record
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(FarRight, (CurHeight - YOffset));
for c := 0 to Pred(FCols) do begin //for each column
Inc(CurIndent, FColData[c,2]);
Canvas.TextOut(CurIndent, CurHeight,
Grid.Cells[FColData[c,0],FRecNo]);
end; //for c - data cell
inc(FRecNo); //count records
inc(CurHeight, FLineHeight); //next line
end; //if not last record
end; //for r
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(FarRight, (CurHeight - YOffset)); //draw last line
CurIndent := -XOffset;
for c := 0 to Pred(FCols) do begin //draw vertical
lines
Inc(CurIndent, FColData[c,2]);
Canvas.MoveTo(CurIndent, (TopStart - YOffset));
Canvas.LineTo(CurIndent, (CurHeight - YOffset));
end;
Canvas.MoveTo(FarRight, (TopStart - YOffset)); //right hand
vertical line
Canvas.LineTo(FarRight, (CurHeight - YOffset));
Canvas.TextOut((PageWidth - LeftMargin), (Pageheight - FLineHeight),
IntToStr(FPageNo));
if FPageNo < FPages then begin
inc(FPageNo);
CurHeight := TopMargin;
NewPage;
end;
end; //for p
EndDoc;
end; //with printer
Result := FRecNo;
except
on EPrinter do begin
Printer.Abort;
ShowMessage('Unknown printer error');
end;
on E: exception do
ShowMessage('Unknown error with printing job');
end;
end;
(*
Adaptation of Simpleprint, the same but adds the process of checking the width
and printing the necessary pages to capture the whole width of the grid.
NB Built in assumption that it will not be more than 99 pages wide.
Accept TStringGrid, assuming that the column indexes have been set after
construction, if required. This uses the current font and does not try to
resize the font. It is also left justified only.
The maximum data width for each column is found and set with respect to the
canvas. Top and left margins are set and line spacing calculated. It is a
large spacing to allow for grid lines, which are always drawn.
Column headers and page numbers are written on all pages.
It uses the curent printer, which will be the default unless a different
printer has already been selected from within this occurrence of the program.
NB if A3 has been previously selected, then that is what will be used.
*)
function TDataPrinter.WidePrint(Grid: TStringGrid; HeadStr: string = '';
po: integer = 0): integer;
var
CurHeight, CurIndent, LeftMargin, TopMargin, XOffset, YOffset, FarRight,
RightMargin, PageRight, PageSetheight, PageSetRec: integer;
c, p, pw, r, sl, w, TopStart: integer;
tmpStr: string;
ColChg: array[1..99,1..3] of integer;
begin
try
Result := 0;
for c := 0 to 99 do begin ColChg[c,1] := 0; ColChg[c,2] := 0; ColChg[c,3]
:= 0; end;
if not ArrayInit then begin
FCols := Grid.ColCount;
InitArray;
end;
with Printer do begin
if po = 0 then Orientation := poPortrait //pass 2 to ignore this
setting
else if po = 1 then Orientation := poLandscape;
//check whether it will all fit on one page landscape
if (po = 0) and (Grid.RowCount < 28)then Orientation := poLandscape;
//set margins and drawing parameters
LeftMargin := Canvas.TextWidth('XXXXX');
TopMargin := (Canvas.TextHeight('X') * 2);
RightMargin := (PageWidth - (LeftMargin + Canvas.TextWidth('XX')));
FLineHeight := (Canvas.TextHeight('H')* 2);
FLinesPerPage := ((PageHeight - TopMargin) div FLineHeight) - 2; //data
lines
FDataLines := FLinesPerPage;
if ((Grid.RowCount) mod FLinesPerPage) = 0 then
FPages := ((Grid.RowCount) div FLinesPerPage)
else FPages := ((Grid.RowCount) div FLinesPerPage) + 1;
if HeadStr <> '' then begin //header string has text so add 2 lines
per page
if ((Grid.RowCount + (FPages * 2)) mod FLinesPerPage) = 0 then
FPages := ((Grid.RowCount + (FPages * 2)) div FLinesPerPage)
else FPages := ((Grid.RowCount + (FPages * 2)) div FLinesPerPage) + 1;
FDataLines := FDataLines - 2;
end;
XOffset := Canvas.TextWidth('c');
YOffset := FLineheight div 4;
FColData[0,2] := LeftMargin;
FarRight := LeftMargin;
PageRight := LeftMargin;
pw := 1; //initialise to 1 page wide
ColChg[pw,1] := FColData[0,0]; //initilise to to index of 1st
column
for c := 0 to Pred(FCols) do begin
sl := 3;
tmpStr := 'XXX';
for r := 0 To Pred(Grid.RowCount) do begin
if Length(Grid.Cells[c,r]) > sl then begin
sl := Length(Grid.Cells[c,r]);
tmpStr := Copy(Grid.Cells[c,r],1,sl);
end; //if
end;
if sl < 15 then AppendStr(tmpStr, 'XX') else AppendStr(tmpStr, 'XXXX');
FColData[(c + 1),2] := Canvas.TextWidth(tmpStr);
FarRight := FarRight + Canvas.TextWidth(tmpStr);
PageRight := PageRight + Canvas.TextWidth(tmpStr);
if PageRight > RightMargin then begin //error if more than 19
pages wide
ColChg[pw,2] := (c - 1); //this column did not fit
ColChg[pw,3] := PageRight - Canvas.TextWidth(tmpStr);
inc(pw); //add to pages wide
ColChg[pw,1] := c; //first column on new page
FColData[(c),2] := LeftMargin; //offset on next page
PageRight := LeftMargin + Canvas.TextWidth(tmpStr); //1st column
end; //if too wide
end; //for c
ColChg[pw,2] := (c - 1); //set last //c will have been incremented
ColChg[pw,3] := PageRight; //set position of last line
FPageNo := 1;
CurHeight := TopMargin;
FRecNo := 1;
BeginDoc;
for p := 1 to FPages do begin //for each page down
PageSetHeight := CurHeight; //store top of page
PageSetRec := FRecno; //store 1st record for page
for w := 1 to pw do begin
CurHeight := PageSetheight; //reset to top of page
FRecno := PageSetRec; //reset 1st record
TopStart := CurHeight;
if HeadStr <> '' then begin //write header
Canvas.TextOut(LeftMargin, CurHeight, HeadStr);
inc(CurHeight, (FLineHeight * 2));
TopStart := CurHeight;
end; //if header string has text
CurIndent := 0; //set top line
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(ColChg[w,3], (CurHeight - YOffset));
for c := ColChg[w,1] to ColChg[w,2] do begin //print
headers
Inc(CurIndent, FColData[c,2]);
Canvas.TextOut(CurIndent, CurHeight, Grid.Cells[FColData[c,0],0]);
end; //for c - done headers
inc(Curheight, FLineHeight); //next line
for r := 1 to (FDataLines) do begin //for each data line
CurIndent := 0; //set to page left
if FRecNo < Grid.RowCount then begin //if not yet last
record
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(ColChg[w,3], (CurHeight - YOffset));
for c := ColChg[w,1] to ColChg[w,2] do begin //for
each column
Inc(CurIndent, FColData[c,2]);
Canvas.TextOut(CurIndent, CurHeight,
Grid.Cells[FColData[c,0],FRecNo]);
end; //for c - data cell
inc(FRecNo); //count records
inc(CurHeight, FLineHeight); //next line
end; //if not last record
end; //for r
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(ColChg[w,3], (CurHeight - YOffset)); //draw last line
CurIndent := -XOffset;
for c := ColChg[w,1] to ColChg[w,2] do begin //draw
vertical lines
Inc(CurIndent, FColData[c,2]);
Canvas.MoveTo(CurIndent, (TopStart - YOffset));
Canvas.LineTo(CurIndent, (CurHeight - YOffset));
end;
Canvas.MoveTo(ColChg[(w),3], (TopStart - YOffset)); //right hand
vertical line
Canvas.LineTo(ColChg[(w),3], (CurHeight - YOffset));
if pw > 1 then Canvas.TextOut((PageWidth - LeftMargin), (Pageheight -
FLineHeight), IntToStr(FPageNo) + '-' + IntToStr(w))
else Canvas.TextOut((PageWidth - LeftMargin), (Pageheight -
FLineHeight), IntToStr(FPageNo));
if w < pw then begin
CurHeight := TopMargin;
NewPage;
end; //not last page across
end; //for w
if FPageNo < FPages then begin
inc(FPageNo);
CurHeight := TopMargin;
NewPage;
end;
end; //for p
EndDoc;
end; //with printer
Result := FRecNo;
except
on EPrinter do begin
Printer.Abort;
ShowMessage('Unknown printer error');
end;
on E: exception do
ShowMessage('Unknown error with printing job');
end;
end;
//special adaptation for DC's reports -- to be ???
function TDataPrinter.WidishPrint(Grid: TStringGrid; HeadStr: string = '';
po: integer = 0): integer;
var
CurHeight, CurIndent, LeftMargin, TopMargin, XOffset, YOffset, FarRight,
RightMargin, PageRight, PageSetheight, PageSetRec: integer;
c, p, pw, r, sl, w, TopStart: integer;
tmpStr: string;
ColChg: array[1..99,1..3] of integer;
begin
try
Result := 0;
for c := 0 to 99 do begin ColChg[c,1] := 0; ColChg[c,2] := 0; ColChg[c,3]
:= 0; end;
if not ArrayInit then begin
FCols := Grid.ColCount - 2;
InitArray;
end;
with Printer do begin
if po = 0 then Orientation := poPortrait //pass 2 to ignore this
setting
else if po = 1 then Orientation := poLandscape;
//check whether it will all fit on one page landscape
if (po = 0) and (Grid.RowCount < 28)then Orientation := poLandscape;
//set margins and drawing parameters
LeftMargin := Canvas.TextWidth('XXXXX-XXXXXXXXXXXXXXX');
TopMargin := (Canvas.TextHeight('X') * 2);
RightMargin := (PageWidth - (LeftMargin + Canvas.TextWidth('XX')));
FLineHeight := (Canvas.TextHeight('H')* 2);
FLinesPerPage := ((PageHeight - TopMargin) div FLineHeight) - 2; //data
lines
FDataLines := FLinesPerPage;
if ((Grid.RowCount) mod FLinesPerPage) = 0 then
FPages := ((Grid.RowCount) div FLinesPerPage)
else FPages := ((Grid.RowCount) div FLinesPerPage) + 1;
if HeadStr <> '' then begin //header string has text so add 2 lines
per page
if ((Grid.RowCount + (FPages * 2)) mod FLinesPerPage) = 0 then
FPages := ((Grid.RowCount + (FPages * 2)) div FLinesPerPage)
else FPages := ((Grid.RowCount + (FPages * 2)) div FLinesPerPage) + 1;
FDataLines := FDataLines - 2;
end;
XOffset := Canvas.TextWidth('c');
YOffset := FLineheight div 4;
FColData[0,2] := LeftMargin;
FarRight := LeftMargin;
PageRight := LeftMargin;
pw := 1; //initialise to 1 page wide
ColChg[pw,1] := FColData[0,0]; //initilise to to index of 1st
column
for c := 0 to Pred(FCols) do begin
sl := 3;
tmpStr := 'XXX';
for r := 0 To Pred(Grid.RowCount) do begin
if Length(Grid.Cells[c,r]) > sl then begin
sl := Length(Grid.Cells[c,r]);
tmpStr := Copy(Grid.Cells[c,r],1,sl);
end; //if
end;
if sl < 15 then AppendStr(tmpStr, 'XX') else AppendStr(tmpStr, 'XXXX');
FColData[(c + 1),2] := Canvas.TextWidth(tmpStr);
FarRight := FarRight + Canvas.TextWidth(tmpStr);
PageRight := PageRight + Canvas.TextWidth(tmpStr);
if PageRight > RightMargin then begin //error if more than 19
pages wide
ColChg[pw,2] := (c - 1); //this column did not fit
ColChg[pw,3] := PageRight - Canvas.TextWidth(tmpStr);
inc(pw); //add to pages wide
ColChg[pw,1] := c; //first column on new page
FColData[(c),2] := LeftMargin; //offset on next page
PageRight := LeftMargin + Canvas.TextWidth(tmpStr); //1st column
end; //if too wide
end; //for c
ColChg[pw,2] := (c - 1); //set last //c will have been incremented
ColChg[pw,3] := PageRight; //set position of last line
FPageNo := 1;
CurHeight := TopMargin;
FRecNo := 1;
BeginDoc;
for p := 1 to FPages do begin //for each page down
PageSetHeight := CurHeight; //store top of page
PageSetRec := FRecno; //store 1st record for page
for w := 1 to pw do begin
CurHeight := PageSetheight; //reset to top of page
FRecno := PageSetRec; //reset 1st record
TopStart := CurHeight;
if HeadStr <> '' then begin //write header
Canvas.TextOut(LeftMargin, CurHeight, HeadStr);
inc(CurHeight, (FLineHeight * 2));
TopStart := CurHeight;
end; //if header string has text
CurIndent := 0; //set top line
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(ColChg[w,3], (CurHeight - YOffset));
for c := ColChg[w,1] to ColChg[w,2] do begin //print
headers
Inc(CurIndent, FColData[c,2]);
Canvas.TextOut(CurIndent, CurHeight, Grid.Cells[FColData[c,0],0]);
end; //for c - done headers
inc(Curheight, FLineHeight); //next line
for r := 1 to (FDataLines) do begin //for each data line
CurIndent := 0; //set to page left
if FRecNo < Grid.RowCount then begin //if not yet last
record
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(ColChg[w,3], (CurHeight - YOffset));
for c := ColChg[w,1] to ColChg[w,2] do begin //for
each column
Inc(CurIndent, FColData[c,2]);
Canvas.TextOut(CurIndent, CurHeight,
Grid.Cells[FColData[c,0],FRecNo]);
end; //for c - data cell
inc(FRecNo); //count records
inc(CurHeight, FLineHeight); //next line
end; //if not last record
end; //for r
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(ColChg[w,3], (CurHeight - YOffset)); //draw last line
CurIndent := -XOffset;
for c := ColChg[w,1] to ColChg[w,2] do begin //draw
vertical lines
Inc(CurIndent, FColData[c,2]);
Canvas.MoveTo(CurIndent, (TopStart - YOffset));
Canvas.LineTo(CurIndent, (CurHeight - YOffset));
end;
Canvas.MoveTo(ColChg[(w),3], (TopStart - YOffset)); //right hand
vertical line
Canvas.LineTo(ColChg[(w),3], (CurHeight - YOffset));
if pw > 1 then Canvas.TextOut((PageWidth - LeftMargin), (Pageheight -
FLineHeight), IntToStr(FPageNo) + '-' + IntToStr(w))
else Canvas.TextOut((PageWidth - LeftMargin), (Pageheight -
FLineHeight), IntToStr(FPageNo));
if w < pw then begin
CurHeight := TopMargin;
NewPage;
end; //not last page across
end; //for w
if FPageNo < FPages then begin
inc(FPageNo);
CurHeight := TopMargin;
NewPage;
end;
end; //for p
EndDoc;
end; //with printer
Result := FRecNo;
except
on EPrinter do begin
Printer.Abort;
ShowMessage('Unknown printer error');
end;
on E: exception do
ShowMessage('Unknown error with printing job');
end;
end;
(***********************************************************************)
(* Prints contents of stringlist before grid, but assumes that it will all fit
on the first page *)
function TDataPrinter.SimplePrint(Grid: TStringGrid; FText: TStringList;
po: integer = 0): integer;
var
CurHeight, CurIndent, LeftMargin, TopMargin, XOffset, YOffset, FarRight:
integer;
c, p, r, sl, TopStart: integer;
tmpStr, trimStr: string;
begin
try
Result := 0;
if not ArrayInit then begin
FCols := Grid.ColCount;
InitArray;
end;
with Printer do begin
if po = 0 then Orientation := poPortrait
else if po = 1 then Orientation := poLandscape;
LeftMargin := Canvas.TextWidth('XXXXX');
TopMargin := (Canvas.TextHeight('X') * 2);
FLineHeight := (Canvas.TextHeight('H')* 2);
FLinesPerPage := ((PageHeight - TopMargin) div FLineHeight) - 2; //data
lines
if (Grid.RowCount mod FLinesPerPage) = 0 then
FPages := ((Grid.RowCount + FText.Count + 2) div FLinesPerPage)
else FPages := (Grid.RowCount div FLinesPerPage) + 1;
XOffset := Canvas.TextWidth('c');
YOffset := FLineheight div 4;
FColData[0,2] := LeftMargin;
FarRight := LeftMargin;
for c := 0 to Pred(FCols) do begin
sl := 3;
tmpStr := 'XXX';
for r := 0 To Pred(Grid.RowCount) do begin
trimStr := Trim(Grid.Cells[c,r]);
if Length(trimStr) > sl then begin
sl := Length(trimStr);
tmpStr := Copy(trimStr,1,sl);
end; //if
end;
if sl < 15 then AppendStr(tmpStr, 'XX') else AppendStr(tmpStr, 'XXXX');
FColData[(c + 1),2] := Canvas.TextWidth(tmpStr);
FarRight := FarRight + Canvas.TextWidth(tmpStr);
end;
FPageNo := 1;
CurHeight := TopMargin;
FRecNo := 1;
BeginDoc;
for r := 0 to Pred(FText.Count) do begin
Canvas.TextOut(LeftMargin, CurHeight, FText[r]);
inc(CurHeight, FLineHeight);
end; //for r = done other text
inc(CurHeight, FLineHeight);
//now start on the grid
for p := 1 to FPages do begin //for each page
CurIndent := 0; //set top line
TopStart := CurHeight;
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(FarRight, (CurHeight - YOffset));
for c := 0 to Pred(FCols) do begin //print headers
Inc(CurIndent, FColData[c,2]);
Canvas.TextOut(CurIndent, CurHeight, Grid.Cells[FColData[c,0],0]);
end; //for c - done headers
inc(Curheight, FLineHeight); //next line
for r := 1 to (FLinesPerPage) do begin //for each data
line
CurIndent := 0; //set to page left
if FRecNo < Grid.RowCount then begin //if not yet last
record
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(FarRight, (CurHeight - YOffset));
for c := 0 to Pred(FCols) do begin //for each column
Inc(CurIndent, FColData[c,2]);
Canvas.TextOut(CurIndent, CurHeight,
Grid.Cells[FColData[c,0],FRecNo]);
end; //for c - data cell
inc(FRecNo); //count records
inc(CurHeight, FLineHeight); //next line
end; //if not last record
end; //for r
Canvas.MoveTo((LeftMargin - XOffset), (Curheight - YOffset));
Canvas.LineTo(FarRight, (CurHeight - YOffset)); //draw last line
CurIndent := -XOffset;
for c := 0 to Pred(FCols) do begin //draw vertical
lines
Inc(CurIndent, FColData[c,2]);
Canvas.MoveTo(CurIndent, (TopStart - YOffset));
Canvas.LineTo(CurIndent, (CurHeight - YOffset));
end;
Canvas.MoveTo(FarRight, (TopStart - YOffset)); //right hand
vertical line
Canvas.LineTo(FarRight, (CurHeight - YOffset));
Canvas.TextOut((PageWidth - LeftMargin), (Pageheight - FLineHeight),
IntToStr(FPageNo));
if FPageNo < FPages then begin
inc(FPageNo);
CurHeight := TopMargin;
NewPage;
end;
end; //for p
EndDoc;
end; //with printer
Result := FRecNo;
except
on EPrinter do begin
Printer.Abort;
ShowMessage('Unknown printer error');
end;
on E: exception do
ShowMessage('Unknown error with printing job');
end;
end;
end.
_______________________________________________
Delphi mailing list -> [email protected]
http://www.elists.org/mailman/listinfo/delphi
