哈哈，给分分
Procedure TACDListerMain.PrintTable;
Var
margins: TRect;
spacing: Integer;
Cols: TList;
Dlg: TPrintProgressDlg;
Procedure SetColumnWidth;
Var
i, k, w: Integer;
begin
Printer.Canvas.Font.Style := [ fsBold ];
For i := 0 To Pred( Grid.ColCount )do
Cols.Add( Pointer( Printer.Canvas.TextWidth( Grid.Cells[ i,0 ] )));
Printer.Canvas.Font.Style := [];
For i := 1 To Pred( Grid.RowCount )do
For k := 0 To Pred( Grid.ColCount )do
begin
w:= Printer.Canvas.TextWidth( Grid.Cells[ k, i ] );
If w > Integer( Cols[ k ] ) then
Cols[ k ] := Pointer( w );
end;
{ For }
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 }
Proceduredo
Print;
Var
i: Integer;
y: Integer;
Proceduredo
Line(lineno: Integer);
Var
x, n: Integer;
r: TRect;
th: Integer;
begin
If Length(Grid.Cells[0,lineno]) = 0 then
Exit;
x:= margins.left;
With Printer.Canvasdo
begin
th := TextHeight( '膟' );
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, Grid.Cells[ n, lineno ] );
x := r.right + spacing;
end;
{ For }
end;
{ With }
y := y + th;
end;
{do
Line }
Proceduredo
Header;
begin
y:= margins.top;
With Printer.Canvasdo
begin
Font.Style := [ fsBold ];
do
Line( 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;
{do
Header }
begin
y:= 0;
For i := 1 To Pred( Grid.RowCount )do
begin
Dlg.Progress( i );
Application.ProcessMessages;
If FPrintAborted then
Exit;
If y = 0 then
do
Header;
do
Line( i );
If y >= margins.bottom then
begin
Printer.NewPage;
y:= 0;
end;
{ If }
end;
{ For }
end;
{do
Print }
begin
FPrintAborted := False;
Dlg := TPrintProgressDlg.Create( Application );
With Dlgdo
try
OnAbort := PrintAborted;
Display( cPrintPreparation );
SetProgressRange( 0, Grid.RowCount );
Show;
Application.ProcessMessages;
Printer.Orientation := poLandscape;
Printer.begin
Doc;
Cols:= Nil;
try
Cols:= TLIst.Create;
Printer.Canvas.Font.Assign( Grid.Font );
SetColumnWidth;
Display( cPrintProceeding );
Application.ProcessMessages;
do
Print;
finally
Cols.Free;
If FPrintAborted then
Printer.Abort
else
Printer.EndDoc;
end;
finally
Close;
end;
{ With }
end;
{ TACDListerMain.PrintTable }
