一个打印的问题（关于dbgrid中显示的内容）(100分)

如何打印出Tdbgrid中的全部内容，并加标题和表格线。

刚才贴了一个呀。。[]
(* PRTGRID.PAS -- TPrintGrid v3.0b.
Update as of Mar 22, 1997. This minor update fixes some bugs
and adds a few new features. Nothing of any Earth-shaking
importance, but itdo
es make a nice VCL a little nicer.

Thanks to these folks who helped fix bugs and add new features:
- Rene' Schwietzke. Nov 29, 1996 - new features
- Steve Turner - the best fix for the "range error"/GPF
regarding the check of the printer orientation.

Several others also sent fixes for the printer orientation bug,
but Steve's seemed like the best solution.

Changes since v3.0:
- FullPage property added;
lets you choose to print a full page,
or only the used part (Page number stays at bottom)

- RowLine now prints a line after the last record, if you
are using lines between each row of text

- If the printed text line is wider than the paper, a user dialog
now comes up asking if user wants to cancel the print

- Some printer drivers caused a "range error"/GPF when the
VCL checked the printer orientation. This has been fixed by
Steve Turner.
*)

(* PRTGRID.PAS -- TPrintGrid v3.0b.
This is a Delphi v1 component that lets you print a DBGrid.
Publicdo
main by Eric W. Engler. Mar 21, 1997.

User can select DPI and Orientation using the std printer
configuration dialog. As this code is now, there will be slight
variances in sizing and proportions for different DPI settings,
but it will look acceptable. I have tested with 300 and 600 DPI
laser printers, but I haven't tested with 1200 DPI yet.
I think the user can chg printers via the dialog at run time and
this will still work OK, but I haven't tested this.
This will need modifications if you modify a DBGrid to allow
multi-row column headers or data values (or if you embed bitmaps),
but most owner-draw code added to the grid to control colors won't
conflict with this component.

By the way: this component goes along nicely with the TDBSearch
component, which searches for text in grids.
*)

(* todo
:
1. chg HorizGap to a percentage of a char size using
detail line font
2. Although VertGapPct is already supposed to be based on
a percent of char size, I had to tweak it in a DPI-dependant
manner to get reasonable sizing at both 300 and 600 DPI. Why?
3. Change margin specs to a DPI-independant measurement, instead
of pixel counts (perhaps keyed to detail font char size;
or
if you feel agressive, tie them to inches. Pay attention to
Orientation and paper size differences).
4. Make sure that all sizing formulas produce identically-
sized and proportioned reports at both 300 DPI and 600 DPI
(and up!). As I said, this now works much better but it's
output isn't identically sized at 300 and 600.
5. Automatically default Orientation depending on how wide
the grid is. Also, perhaps you want to use larger fonts
for the printed report if the screen grid is small. Maybe
call this an "autolayout" property?
6. Perhaps the "Print to File" option should bring up a dialog
box giving format options like quoted comma-separated fields,
etc.
*)

unit Prtgrid;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, DBGrids, DB, Printers, ExtCtrls;

const
MaxPages = 1000;
MaxCols = 100;

type
TPageNumberPos = (pnNone, pnTopLeft, pnTopCenter, pnTopRight,
pnBotLeft, pnBotCenter, pnBotRight);

TPrintGrid = class(TComponent)
private
FFullPage: Boolean;
{ new property RS 29.11.1996 }
OutFileName : TFileName;
FDBGrid: TDBGrid;
FTitleFont: TFont;
FColHeaderFont: TFont;
FLinesFont: TFont;
FTitleAlign: TAlignment;
FOrientation: TPrinterOrientation;
FPageNLabel: String;
FDateLabel: String;
FPageNPos: TPageNumberPos;
FDatePos: TPageNumberPos;
FPrintFileName: String;
FPrintFileDir: String;
FTitle: String;
FPrintMgrTitle: String;
FirstRecordY: longint;
DetailLineCharWidth: longint;
DetailLineCharHeight: longint;
RecCounter: longint;
FPrintToFile: boolean;
PrinterPageNo: longint;
FFromPage: longint;
FEndPage: longint;
NPositions: integer;
FTopMargin: integer;
FBottomMargin: integer;
FLeftMargin: integer;
FRightMargin: integer;
Positions: array[1..MaxCols] of longint;
FColLines: boolean;
FRowLines: boolean;
FBorder: boolean;
FHorizGap: integer;
{ number of pixels bet. grid columns }
FVertGap: integer;
{ percent of vert char hgt }
procedure WriteAllToFile;
procedure SetTitleFont(Value: TFont);
procedure SetColHeaderFont(Value: TFont);
procedure SetLinesFont(Value: TFont);
procedure SetDBGrid(Value: TDBGrid);
function GetDBGrid: TDBGrid;
procedure SetPrintMgrTitle(const TmpStr: String);
function GetPrintMgrTitle: String;
function ColHeaderWidth(const ColHeaderStr: String): longint;
function ColHeaderHeight: longint;
procedure CalcPrinterPositions;
function SetAlign(align:TAlignment;
Left, Right: longint): longint;
function SetPagePosX(PagePos: TPageNumberPos;
Left, Right: longint): longint;
function SetPagePosY(PagePos: TPageNumberPos;
Top, Bottom: longint): longint;
function PrepareAlign(Field: TField;
Col: integer): longint;
procedure WriteTitleToPrinter;
procedure WriteColHdrsToPrinter(PosY: longint);
procedure WriteRecordToPrinter;
procedure PageJump;
function RealWidth: longint;
function AllPageFilled: boolean;
procedure SetPixelsPerInch;
function GetOrientation : TPrinterOrientation;
function RealToStr(x: Real): String;
procedure InitializePrinter;
protected
procedure SetName(const Value: TComponentName);
override;
public
constructor Create(AOwner:TComponent);
override;
destructor Destroy;
override;
procedure Print;
procedure PrintDialog;
procedure SaveToFile;
published
property LeftMargin: integer read FLeftMargin write FLeftMargin;
property TopMargin: integer read FTopMargin write FTopMargin;
property RightMargin: integer read FRightMargin write FRightMargin;
property BottomMargin: integer read FBottomMargin
write FBottomMargin;
property ColHeaderFont: TFont read FColHeaderFont
write SetColHeaderFont;
property TitleFont: TFont read FTitleFont write SetTitleFont;
property LinesFont: TFont read FLinesFont write SetLinesFont;
property DBGrid: TDBGrid read GetDBGrid write SetDBGrid;
property PrintMgrTitle: String read GetPrintMgrTitle
write SetPrintMgrTitle;
property Title: String read FTitle write FTitle;
property TitleAlignment: TAlignment read FTitleAlign
write FTitleAlign;
property Orientation: TPrinterOrientation read FOrientation
write FOrientation;
property PrintToFile: boolean read FPrintToFile write FPrintToFile;
property FullPage: boolean read FFullPage write FFullPage;{RS 29.11.1996}
property PrintFileName: String read FPrintFileName
write FPrintFileName;
property PrintFileDir: String read FPrintFileDir
write FPrintFileDir;
property FromPage: longint read FFromPage write FFromPage;
property EndPage: longint read FEndPage write FEndPage;
property Border: boolean read FBorder write FBorder;
property ColLines: boolean read FColLines write FColLines;
property RowLines: boolean read FRowLines write FRowLines;
property HorizontalGap: integer read FHorizGap write FHorizGap;
property VerticalGapPct: integer read FVertGap write FVertGap;
property PageNumberPos: TPageNumberPos read FPageNPos
write FPageNPos;
property PageNumberLabel: String read FPageNLabel
write FPageNLabel;
property DatePos: TPageNumberPos read FDatePos write FDatePos;
property DateLabel: String read FDateLabel write FDateLabel;
end;


procedure Register;

implementation

var
TextMetrics: TTextMetric;
CurrentOrientation: TPrinterOrientation;

function Max(a, b: longint): longint;
begin

if a > b then

Result := a
else

Result := b;
end;


function HeightScale(Value: longint;
Pct: integer): longint;
begin

if Pct > 100 then

Pct := 100
else
if Pct < 0 then

Pct := 0;

if Pct = 0 then

Result := Value
else

Result := Value + MulDiv(Value, Pct, 100);
end;


function CenterY(PosY, TextHt, Pct: longint): longint;
begin

Result := PosY + (HeightScale(TextHt, Pct) - TextHt) div 2;
end;


constructor TPrintGrid.Create(AOwner:TComponent);
begin

inherited Create(AOwner);

{ We need to create new font objects because we're not going to
use any from the caller's program. We will, however, "borrow"
a pointer to the caller's TDBGrid object, so wedo
n't want to
allocate a new TDBGrid object here. Note that the declarations
of these objects near the top of this file is just allocating
pointers - not actual storage locations. }
FColHeaderFont := TFont.Create;
FTitleFont := TFont.Create;
FLinesFont := TFont.Create;

{ DEFAULT VALUES FOR ALL PROPERTIES }
{ These defaults will be overridden by the developer's changes made
in the Object Inspector at design time. These defaults are only the
starting values that will initially be shown in the Object Inspector.
Once changed, the new values will be automatically written to the
Form file (which is often called object serialization). All property
values are automatically made persistant bec. of class TPersistant
in the Object inheritance tree for all controls. However, changes
made to properties at run time will not be persistant between different
program runs. }
{ Note: If you change these defaults, you must rebuild the component
library in order for the new defaults to take effect. Some developers
forget this step, since a compile of a user's program will include a
compile of the latest components - most changes to this file will take
effect without recompiling the component library. The component
library itself is only used to interact with developer during design
time. }
FDBGrid := nil;
{ Will point to caller's DBGrid object }
FTitle := '';
FPrintMgrTitle := '';
RecCounter := 0;
FHorizGap := 8;
{ pixels bet grid columns, in addition to width
of a space character }
FVertGap := 40;
{ percent of char height }

{ Margin settings: pixels, in addition to the std printer "gutter"
of .25" (which is the edge area that printer can't print on).
We need at least a small number here to ensure consistant output
with different printers;
some of which have overly optimistic
minimum gutter specs. }
{ The fixed top gutter is normally bigger than the bottom fixed
gutter on our HP printers, so we'll give a little smaller top
margin for our use }
FTopMargin := 60;
FBottomMargin := 110;
FLeftMargin := 30;
FRightMargin := 30;

FPrintToFile := False;
FPrintFileName := 'PRN.LST';
FPrintFileDir := 'C:/';

FFullPage := false;
{RS 29.11.1996}
FFromPage := 1;
FEndPage := MaxPages;
FBorder := False;
{ box around entire page }
FColLines := True;
{ vert lines bet grid columns }
FRowLines := False;
{ horiz lines bet grid rows }

FTitleAlign := taCenter;
FPageNPos := pnBotCenter;
FPageNLabel := 'Page: ';
FDatePos := pnTopRight;
FDateLabel := '';
{ actual date is put here automatically, but the calling
program can specify a date here to override dflt }
FOrientation := poLandscape;

FTitleFont.Name := 'Arial';
FTitleFont.Style := [fsBold];
FTitleFont.Size := 12;
FColHeaderFont.Name := 'Arial';
FColHeaderFont.Style := [fsBold];
FColHeaderFont.Size := 10;
FLinesFont.Name := 'Arial';
FLinesFont.Style := [];
FLinesFont.Size := 9;
end;


destructor TPrintGrid.Destroy;
begin

FColHeaderFont.Free;
FTitleFont.Free;
FLinesFont.Free;
inherited Destroy;
end;


procedure TPrintGrid.SetColHeaderFont(Value: TFont);
begin

FColHeaderFont.Assign(Value);
end;


procedure TPrintGrid.SetTitleFont(Value: TFont);
begin

FTitleFont.Assign(Value);
end;


procedure TPrintGrid.SetLinesFont(Value: TFont);
begin

FLinesFont.Assign(Value);
end;


procedure TPrintGrid.SetDBGrid(Value: TDBGrid);
begin

FDBGrid := Value;
{ Same as: FDBGrid.Assign(Value);
}
end;


function TPrintGrid.GetDBGrid: TDBGrid;
begin

Result := FDBGrid;
end;


procedure TPrintGrid.SetPrintMgrTitle(const TmpStr: String);
begin

FPrintMgrTitle := TmpStr;
end;


function TPrintGrid.GetPrintMgrTitle: String;
begin

Result := FPrintMgrTitle;
end;


procedure TPrintGrid.SetName(const Value: TComponentName);
var
ChangeText: Boolean;
begin

ChangeText := (Name = FPrintMgrTitle) and ((Owner = nil)
or not (Owner is TPrintGrid)
or not (csLoading in TPrintGrid(Owner).ComponentState));
inherited SetName(Value);
if ChangeText then

FPrintMgrTitle := Value;
end;

{----------------------------------------------------------------}

{ only used for file output }
procedure TPrintGrid.WriteAllToFile;
var
OutFile: TextFile;
BookMark1: TBookMark;
FieldNo: longint;
TmpStr: String;
begin

if OutFileName = '' then

OutFileName := 'PRN.LST';

{$I-} { turn off exception generation }
AssignFile(OutFile, OutFileName);
Rewrite(OutFile);
{ Open for Write }
{$I+} { re-enable exceptions }
if IOResult <> 0 then

begin

ShowMessage('Error opening output file:' + OutFileName);
Exit;
{ go back to caller }
end;


with FDBGrid.DataSource.DataSetdo

begin

{ Write main title line to a file }
Writeln(OutFile, FTitle+' - Import me into Excel (tab delimited)');
{ We only print the main title and col headers one time
if output is to a file. The file is meant to be
imported into MicroSoft Excel - excess headers just
get in the way }

TmpStr := '';
{ reset String }
{ Accumulate the column names into string TmpStr }
for FieldNo := 0 to FieldCount - 1do

if Fields[FieldNo].Visible then

{ Note: #9 is the dflt delimiter ("tab") for fields in Excel }
TmpStr := TmpStr + Fields[FieldNo].DisplayLabel + #9;
WriteLn(OutFile, TmpStr);
{ write column header line }

{ loop thru all records, printing them to a file }
try
Screen.Cursor := crHourGlass;
Bookmark1 := GetBookMark;
{ save our datasource location }
DisableControls;
{ momentarily stop DBGrid display updates }
RecCounter := 0;

{ useful message for debugging:
if Positions[NPositions+1] > RealWidth then

ShowMessage('NOTE: Report Width Is Greater Than Paper Width.');}

First;
{ read first rec from datasource }
while not EOFdo

begin

TmpStr := '';
{ reset String }

{ Accumulate the data from each column into TmpStr }
for FieldNo := 0 to FieldCount - 1do

if Fields[FieldNo].Visible then

{ Note: #9 is the dflt delimiter ("tab") for fields in Excel }
TmpStr := TmpStr + Fields[FieldNo].DisplayText + #9;

WriteLn(OutFile, TmpStr);
{ write current record to file }
Inc(RecCounter);
Next;
{ read next rec from datasource }
end;

{ end "while not EOF" }

finally
Screen.Cursor := crDefault;
EnableControls;
{ re-enable DBGrid display }
CloseFile(OutFile);
GotoBookMark(BookMark1);
{ re-position datasrc back to where it was }
FreeBookMark(BookMark1);
end;

{ end of try...finally }
end;

{ end with }
end;

{--------------------------------------------------------------------}
{ From heredo
wn, most procs/fun's are only used for printer output. }

{ return the width of a column header in pixels }
function TPrintGrid.ColHeaderWidth(const ColHeaderStr: String): longint;
var
tmpFont: TFont;
begin

with Printer.Canvasdo

begin

tmpFont := TFont.Create;
{ make a temp font object }
tmpFont.Assign(Font);
{ save orig Printer font in temp object }
Font.Assign(FColHeaderFont);
{ select Column Header font }
SetPixelsPerInch;
{ get width in pixels }
Result := TextWidth(ColHeaderStr);
Font.Assign(tmpFont);
{ put the orig printer font back }
tmpFont.Free;
{ free the temp font object }
SetPixelsPerInch;
end;

end;


{ return the height of the column header in pixels }
function TPrintGrid.ColHeaderHeight: longint;
var
tmpFont: TFont;
begin

with Printer.Canvasdo

begin

tmpFont := TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FColHeaderFont);
SetPixelsPerInch;
Result := HeightScale(TextHeight('M'), FVertGap);
Font.Assign(tmpFont);
SetPixelsPerInch;
tmpFont.Free;
end;

end;


procedure TPrintGrid.CalcPrinterPositions;
var
ColWidth, FieldNo: longint;
begin

{ Print column indexes are 1-based }
{ Datasource indexes are 0-based }
{ Positions[1] is x-coord or where to strt printing first column }
if FBorder then

Positions[1] := 1
else

Positions[1] := 0;

NPositions := 0;
{ we'll keep count to determine tot. # of print columns }
with FDBGrid.DataSource.DataSetdo

for FieldNo := 0 to FieldCount - 1do

if Fields[FieldNo].Visible then

begin

inc(NPositions);
{ increment column index }

{--------------------------------------------------------------------------
The width of each column (in pixels) should be the greater of:
col. header width ( := ColHeaderWidth(Fields[t].DisplayLabel) )
or
col. data width ( := DetailLineCharWidth * Fields[t].DisplayWidth )
The units of each of these is "width of 1 avg char in the current font. }

{ DisplayWidth is max no. of detail line chars }
{ DisplayLabel is the text of the column header }
(* ShowMessage('hdr wd='
+ IntToStr(ColHeaderWidth(Fields[FieldNo].DisplayLabel)));
ShowMessage('dsp wd='
+ IntToStr(DetailLineCharWidth * Fields[FieldNo].DisplayWidth));
ShowMessage('fld siz='
+ IntToStr(Fields[FieldNo].DisplayWidth));
*)
ColWidth := Max(ColHeaderWidth(Fields[FieldNo].DisplayLabel),
(DetailLineCharWidth * Fields[FieldNo].DisplayWidth));
{ Set starting loc. of next column }
{ Positions[NPositions] is the start loc of current column }
{ FHorizGap is gap between columns }
Positions[NPositions + 1] := Positions[NPositions]
+ ColWidth + FHorizGap;
{--------------------------------------------------------------------------}
end;

{ end with }
end;


function TPrintGrid.SetAlign(align: TAlignment;
Left, Right:longint):longint;
var
PosX: longint;
begin

with Printer.Canvasdo

begin

case Align of
taLeftJustify:
begin

SetTextAlign(Handle, TA_LEFT);
{ PosX is where to begin
printing this col }
PosX := Left + FHorizGap;
end;

taRightJustify:
begin

SetTextAlign(Handle, TA_RIGHT);
PosX := Right - FHorizGap;
end;

taCenter:
begin

SetTextAlign(Handle, TA_CENTER);
PosX := Left + Round((Right - Left) / 2);
end;

end;

{ end case }
end;

{ end of "with Printer.Canvas" }
Result := PosX;
end;


function TPrintGrid.SetPagePosX(PagePos: TPageNumberPos;
Left, Right: longint): longint;
var
PosX: longint;
begin

with Printer.Canvasdo

begin

case PagePos of
pnTopLeft, pnBotLeft:
begin

SetTextAlign(Handle, TA_LEFT);
PosX := Left + FHorizGap;
end;

pnTopRight, pnBotRight:
begin

SetTextAlign(Handle, TA_RIGHT);
PosX := Right - FHorizGap;
end;

pnTopCenter, pnBotCenter:
begin

SetTextAlign(Handle, TA_CENTER);
PosX := Left + Round((Right - Left)/2);
end;

end;

{ end case }
end;

{ end of "with Printer.Canvas" }
Result := PosX;
end;


function TPrintGrid.SetPagePosY(PagePos: TPageNumberPos;
Top,
Bottom: longint): longint;
var
PosY: longint;
begin

case PagePos of
pnBotLeft, pnBotCenter, pnBotRight:
begin

PosY := Bottom;
end;

else

PosY := Top;
end;

{ end case }
Result := PosY;
end;


function TPrintGrid.PrepareAlign(Field:TField;
Col:integer): longint;
begin

Result := SetAlign(Field.Alignment, Positions[col], Positions[col + 1]);
end;


{ Note that the Windows printer interface gives you a "full-page"
paradigm. We can print to any part of the current page, similar
in concept to using cursor positioning codes on a CRT. This
procedure will print the main title, column headers, and footer
line, as-needed. }
procedure TPrintGrid.WriteTitleToPrinter;
var
PosX, PosY, FieldNo, tmpColHeaderHeight: longint;
TmpFont: TFont;
tmpFontCreated: boolean;
begin

if (PrinterPageNo >= FFromPage) and (PrinterPageNo <= FEndPage) then

with Printer.Canvasdo

begin

tmpColHeaderHeight := ColHeaderHeight;
{ We will print a footer and/or main title line if any one
of these is true:
a) main title text has been set
b) date has been requested on the listing
c) page number has been requested on the listing }
if (FTitle <> '') or (FDatePos <> pnNone)
or (FPageNPos <> pnNone) then

begin

tmpFont := TFont.Create;
tmpFont.Assign(Font);
{ save active font }
Font.Assign(FTitleFont);
{ select the title font }
SetPixelsPerInch;
tmpFontCreated := True;
end
else

tmpFontCreated := False;
{ we didn't need a footer or title line }

if FDatePos <> pnNone then

begin

{ Use date string specified by caller, if one was set }
if FDateLabel = '' then

FDateLabel := FormatDateTime('mmm d, yyyy',SysUtils.Date);
{ Print the date at specified location }
PosX := SetPagePosX(FDatePos, FLeftMargin,
FLeftMargin + RealWidth);
PosY := SetPagePosY(FDatePos, FTopMargin,
Printer.PageHeight - FBottomMargin);
TextOut(PosX, PosY, FDateLabel);
{ title font is active }
end;


if FTitle <> '' then

begin

{ Print the report Title;
title font is active }
PosX := SetAlign(FTitleAlign, FLeftMargin, FLeftMargin + RealWidth);
TextOut(PosX, FTopMargin, FTitle);
end;


if FPageNPos <> pnNone then

begin

PosX := SetPagePosX(FPageNPos, FLeftMargin,
FLeftMargin + RealWidth);
PosY := SetPagePosY(FPageNPos, FTopMargin,
Printer.PageHeight - FBottomMargin + 8);
TextOut(PosX, PosY, FPageNLabel + IntToStr(PrinterPageNo));
end;


if (FTitle <> '')
or (FDatePos in [pnTopLeft, pnTopCenter, pnTopRight])
or (FPageNPos in [pnTopLeft, pnTopCenter, pnTopRight]) then

FirstRecordY := FTopMargin + HeightScale(TextHeight('M'),
FVertGap) + tmpColHeaderHeight
else

FirstRecordY := FTopMargin + tmpColHeaderHeight;

if tmpFontCreated then

begin

Font.Assign(tmpFont);
{ restore original font }
SetPixelsPerInch;
tmpFont.Free;
end;


{ RS 29.11.1996 }
{if FBorder then

begin

Rectangle(FLeftMargin,
FirstRecordY - tmpColHeaderHeight,
FLeftMargin + RealWidth,
Printer.PageHeight - FBottomMargin);
end;

}{ end of "if FBorder" }

{RS 29.11.1996}
if FFullPage then

if FColLines then

for FieldNo := 2 to NPositionsdo

begin

MoveTo(FLeftMargin + Positions[FieldNo], FirstRecordY);
LineTo(FLeftMargin + Positions[FieldNo],
Printer.PageHeight - FBottomMargin);
end;

{ ends both "for" and "if" }

if dgTitles in FDBGrid.Options then

WriteColHdrsToPrinter(FirstRecordY - tmpColHeaderHeight);
end;

end;


{ This procedure prints column headers. This is similar to
WriteRecordToPrinter, but this one accepts the Y position as an
argument, and prints headers instead of data. }
procedure TPrintGrid.WriteColHdrsToPrinter(PosY: longint);
var
Col, PosX: longint;
DSrcFld: longint;
TmpFont: TFont;
Rect: TRect;
begin

with FDBGrid.DataSource.DataSet, Printer.Canvasdo

begin

tmpFont := TFont.Create;
tmpFont.Assign(Font);
{ save current font }
Font.Assign(FColHeaderFont);
{ set column hdr font active }
SetPixelsPerInch;
{ find top and bottom loc's of box surrounding detail lines }
Rect.top := CenterY(PosY, TextHeight('M'), 2*FVertGap);
{ EWE: added 2* }
Rect.bottom := FirstRecordY+((RecCounter + 1) * TextHeight('M'));

{ "DSrcFld" will point to the DBGrid's datasource fields,
and "Col" will point to the printed columns }
Col := 0;
for DSrcFld := 0 to FieldCount - 1do

begin

if Fields[DSrcFld].Visible then

begin

inc(Col);
{ FHorizGap is the gap between columns (in pixels) }
PosX := FLeftMargin + PrepareAlign(Fields[DSrcFld], Col);
Rect.left := FLeftMargin + Positions[Col] + FHorizGap;
Rect.right := FLeftMargin + Positions[Col+1] - FHorizGap;
TextRect(Rect, PosX, Rect.top, Fields[DSrcFld].DisplayLabel);
end;

end;

{ Underline col headers }
Moveto(FLeftMargin, FirstRecordY);
Lineto(FLeftMargin + RealWidth, FirstRecordY);

Font.Assign(tmpFont);
{ restore original font }
SetPixelsPerInch;
tmpFont.Free;
end;

{ end with }
end;


{ Print all columns of one detail line to the printer }
procedure TPrintGrid.WriteRecordToPrinter;
var
Col, PosX, PosY, FieldNo: longint;
DSrcFld: longint;
tmpFont: TFont;
Rect: TRect;
begin

if (PrinterPageNo >= FFromPage) and (PrinterPageNo <= FEndPage) then

with FDBGrid.DataSource.DataSet, Printer.Canvasdo

begin

tmpFont := TFont.Create;
tmpFont.Assign(Font);
{ save current font }
Font.Assign(FLinesFont);
{ set detail line font active }
SetPixelsPerInch;

Col := 0;
PosY := FirstRecordY + RecCounter * DetailLineCharHeight;
Rect.top := CenterY(PosY, TextHeight('M'), FVertGap);
Rect.bottom:=FirstRecordY+((RecCounter+1) * DetailLineCharHeight);

{ "DSrcFld" will point to the DBGrid's datasrc fields, and "Col"
will point to the printed columns }
for DSrcFld := 0 to FieldCount - 1do

begin

if Fields[DSrcFld].Visible then

begin

inc(Col);
PosX := FLeftMargin + PrepareAlign(Fields[DSrcFld], Col);
Rect.left := FLeftMargin + Positions[Col] + FHorizGap;
Rect.right := FLeftMargin + Positions[Col+1] - FHorizGap;
TextRect(Rect, PosX, Rect.top, Fields[DSrcFld].DisplayText);
end;

end;


if FRowLines then

begin

MoveTo(FLeftMargin, PosY);
LineTo(FLeftMargin + RealWidth, PosY);
end;


{RS 29.11.1996}
if not FFullPage then

if FColLines then

for FieldNo := 2 to NPositionsdo

begin

MoveTo(FLeftMargin + Positions[FieldNo], FirstRecordY);
LineTo(FLeftMargin + Positions[FieldNo],
PosY + DetailLineCharHeight);
end;

{ ends both "for" and "if" }

Font.Assign(tmpFont);
{ restore orig font }
SetPixelsPerInch;
tmpFont.Free;
end;

end;


procedure TPrintGrid.PageJump;
begin

RecCounter := 0;
if (PrinterPageNo >= FFromPage) and (PrinterPageNo < FEndPage) then

Printer.NewPage;
inc(PrinterPageNo);
end;


{ return the real width of the paper in units of "# of chars" using
the current font }
function TPrintGrid.RealWidth: longint;
begin

Result := Printer.PageWidth - FLeftMargin - FRightMargin;
end;


function TPrintGrid.AllPageFilled: boolean;
begin

Result := (not FPrintToFile)
and ((FirstRecordY + (RecCounter + 1) * DetailLineCharHeight)
>= (Printer.PageHeight - FBottomMargin));
end;


{ Print the Grid to EITHER a File or a Printer;
no dialog used }
procedure TPrintGrid.Print;
var
return_code: boolean;
St: array[0..255] of Char;
BookMark: TBookMark;
t: integer;
tmpFont: TFont;
FieldNo, PosY: longint;
TmpStr: String;
CurrentOrientation: TPrinterOrientation;
tmpStyle: TBrushStyle;
begin

if not Assigned(FDBGrid) then

raise Exception.Create('Error: FDBGrid Not Assigned.');
if FPrintToFile then

begin

WriteAllToFile;
Exit;
{ go back to caller }
end;


{ We're "Printing All" to Printer from here on ...}
InitializePrinter;

with FDBGrid.DataSource.DataSetdo

begin

try
Bookmark := GetBookMark;
{ save our datasource location }
DisableControls;
{ momentarily stop DBGrid display updates }
RecCounter := 0;
PrinterPageNo := 1;

{ calc where to place each field in horizontal plane }
CalcPrinterPositions;

{ useful message for debugging: }
{ and useful for the users: RS 29.11.1996 }
if (Positions[NPositions + 1] > RealWidth) then

begin

if MessageDlg('Printed width is larger than paper width.'+
' Abort the print-out?',
mtConfirmation, mbYesNoCancel, 0 )<>idNo then

begin

{ stop printing }
Printer.Abort;
exit;
{ leaves this place immediately }
end;

end;


Screen.Cursor := crHourGlass;

First;
{ read first rec from datasource }
while not EOFdo

begin

if RecCounter = 0 then

WriteTitleToPrinter;
WriteRecordToPrinter;
Inc(RecCounter);
Next;
{ read next rec from datasource }

{ page break processing }
if AllPageFilled then

begin

PageJump;
if PrinterPageNo > FEndPage then

break;
{ exit from loop;
we'redo
ne }
end;

end;

{ end "while not EOF" }

{ Underline last Record }
{ RS 26.11.1996 }
if FRowLines then

begin

PosY := FirstRecordY + RecCounter * DetailLineCharHeight;
Printer.Canvas.MoveTo(FLeftMargin, PosY);
Printer.Canvas.LineTo(FLeftMargin + RealWidth, PosY);
end;


{ draws a rectangle around the sheet but only
if needed and fullpage changed
RS 29.11.1996 }
if FBorder then

begin

tmpStyle:=Printer.Canvas.Brush.Style;
Printer.Canvas.Brush.Style:=bsClear;
if FullPage then

Printer.Canvas.Rectangle(FLeftMargin,
FirstRecordY - ColHeaderHeight,
FLeftMargin + RealWidth,
Printer.PageHeight - FBottomMargin)
else

Printer.Canvas.Rectangle(FLeftMargin,
FirstRecordY - ColHeaderHeight,
FLeftMargin + RealWidth,
PosY);
Printer.Canvas.Brush.Style:=tmpStyle;
end;

{ end of "if FBorder" }

finally
EnableControls;
{ re-enable DBGrid display }
Screen.Cursor := crDefault;
GotoBookMark(BookMark);
FreeBookMark(BookMark);
Printer.EndDoc;
end;

{ end of try...finally }
end;

{ end with }
end;


{ used for BOTH File and Printer output;
always gives std dialog }
procedure TPrintGrid.PrintDialog;
var
M: integer;
begin

with TPrintDialog.Create(Self)do

begin

try
Options := [poPageNums, poPrintToFile, poWarning];
MinPage := 1;
MaxPage := MaxPages;
FFromPage := 1;
FEndPage := MaxPages;
{ In order to make the dialog box default to the Orientation
selected by calling pgm, we need to set it now via the
"TPrinter" object - not via the TPrintDialog!
Note that "Printer.Orientation" isn't a readable property:
we can set it, but not check it.
The Dialog gets it's initial Orientation setting by
checking the current print driver status. }
{Printer.Orientation := FOrientation;
RS 29.11.1996}

{ "Execute" runs the Common Control Print Dialog }
if Execute then

begin

{ NOTE: In Delphi v1, we can NOT check Printer.Orientation
upon coming back from the dialog to see which exact
orientation the user selected. But the actual Windows
printer will use the correct orientation specified by
the dialog box, we just can't tell here what that is. }

{ We can now check the page range user wants to print,
and whether he wants to print to a file }
if PrintRange = prPageNums then

begin

FFromPage := FromPage;
FEndPage := EndPage;
end;

{ Set our orientation var to what user selected in dialog }
FOrientation:=GetOrientation;
if PrintToFile then

SaveToFile { go and print to a file }
else

begin

FPrintToFile := false;
{do
n't print to file }
Print;
{ go and print to printer }
end;

end;

{ end Execute }

finally
Free;
end;

{ end of "try...finally" }
end;

{ end of "with TPrintDialog" }
end;


{ only used for File output }
{ Call this function ONLY if you know beforehand that the user
will want to print to a File. This will prompt the user for
a filename. If youdo
n't want to prompt the user for a name (if
you just want to use the dflt name specified in Object inspector),
then
do
this: set property "PrintToFile" to TRUE, and call method
"Print", instead of this one. }
procedure TPrintGrid.SaveToFile;
begin

{ Use the "File Save as" dialog to get a filename}
FPrintToFile := true;
with TSaveDialog.Create(Self)do

begin

try
{ Set the filemask filter for the File...Save
Common Dialog }
Filter :=
'List Files (*.LST)|*.LST|Any file(*.*)|*.*';
if FPrintFileDir <> '' then

InitialDir := FPrintFileDir;
if FPrintFileName <> '' then
{do
we have a dflt fname? }
begin

FileName := FPrintFileName;
Filter := Filter + '|This file (*'
+ ExtractFileExt(FileName) + ')|*'
+ ExtractFileExt(FileName);
FilterIndex := 3;
end;


{ Run the File...Save dialog }
if Execute then

begin

{ FileName is now set to what the user picked }
FPrintFileDir := ExtractFilePath(FileName);
FPrintFileName := ExtractFileName(FileName);
OutFileName := FileName;
{ ShowMessage('Now printing to file: ' + FileName);
}
Print;
{do
the print to the file }
end;


finally
Free;
end;

{ end of "try...finally" }
end;

{ end of "with TSaveDialog" }
end;


{ This is mostly a bug fix function to make up for weaknesses in Delphi's
TPrinter object. TPrinter scales the font based on printer's PixelsPerInch.
However, the bug prevented it from scaling correctly bec. it didn't have the
printer's handle when it tried to get the PixelsPerInch. Here, we force
it to get the handle, then
we set PixelsPerInch, then
we reassign the font
size back to force it to get scaled again (this time correctly).
This code causes no trouble with Delphi v2.01, but it may only be NEEDED
on Delphi v1.xx (most pgmmers use it on v2.xx also).
You must call this immed. after you change the printer font! }
procedure TPrintGrid.SetPixelsPerInch;
var
FontSize: integer;
begin

if not Printer.Printing then

ShowMessage('Error: begin
Doc not called before SetPixelsPerInch');

{ PixelsPerInch of any font is just the printer resolution, which is usu.
300 or more (except fordo
t matrix printers, where it could be as low
as 90, depending on the printer setting: draft vs. NLQ vs. LQ).
This isn't going to change for different fonts, but it must be
set right for all of them in order for the automatic size scaling
to work right. Note that some printers have different resolutions in
the X and Y directions. }

{ NOTE: GetTextMetrics uses handle of printer canvas, but
GetDeviceCaps uses handle of printer. }
FontSize:=Printer.Canvas.Font.Size;
{ save size in points }
Printer.Canvas.Font.PixelsPerInch:=GetDeviceCaps(Printer.Handle,LOGPIXELSY);
{ restore size in points;
will correctly scale Font size units now }
Printer.Canvas.Font.Size := FontSize;

{ Call the Windows API function GetTextMetrics() to get the specifics
of the particular font. }
GetTextMetrics( Printer.Canvas.Handle,TextMetrics );
end;


{ This convoluted code is from EDSPRINT.PAS. We just want to get
the actual printer orientation currently in effect. Note that the
"Orientation" property of TPrinter is write-only (at least in
Delphi v1 it is). }
{ Call this function once, after user isdo
ne with print dialog,
but before begin
Doc }
function TPrintGrid.GetOrientation : TPrinterOrientation;
var
FDevice: PChar;
FDriver: PChar;
FPort: PChar;
FHandle: THandle;
FDeviceMode: PDevMode;
begin

GetMem (FDevice, 255);
GetMem (FDriver, 255);
GetMem (FPort, 255);
Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
if FHandle = 0 then

begin

{ driver not loaded }
Printer.PrinterIndex := Printer.PrinterIndex;
{ force Printer object to load driver }
Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
end;

if FHandle <> 0 then

begin

FDeviceMode := Ptr(FHandle, 0);
{ FDeviceMode now points to Printer.DeviceMode }
{ Following fix is from Steve Turner }
case FDeviceMode^.dmOrientation of
dmOrient_Portrait: result := poPortrait;
dmOrient_Landscape: result := poLandscape;
else

result := poLandscape;
end;

{ end case }
end
else

begin

ShowMessage('Error getting printer device mode');
end;

FreeMem (FDevice, 255);
FreeMem (FDriver, 255);
FreeMem (FPort, 255);
end;


procedure TPrintGrid.InitializePrinter;
begin

{ Orientation must be set before begin
Doc, because it also
ensures that the right printer driver is being used. }
Printer.Orientation := FOrientation;
{ Once wedo
the "begin
Doc", we're committed to using
at least 1 sheet of paper! The output will start printing
after EndDoc if nothing else
is in the queue. }
Printer.begin
Doc;
Printer.Title := FPrintMgrTitle;
Printer.Canvas.Font.Assign(FLinesFont);
{ set detail line font active }
SetPixelsPerInch;

FVertGap:= Trunc(TextMetrics.tmHeight * 0.8);
FHorizGap:= TextMetrics.tmMaxCharWidth div 4;

DetailLineCharHeight := HeightScale(TextMetrics.tmHeight,FVertGap);
DetailLineCharWidth := TextMetrics.tmMaxCharWidth;

(* Display metric/sizing info here for debugging.
Here's some typical metrics:
Printer = HP4, network laser printer, max res=600 DPI
Arial, 8 point, style=normal
paper width=8 inches, Portrait Orientation
paper height=11.5 inches
300 DPI 600 DPI
------------------------------------------------------
pg wid=2400 | pg wid=4800
pg hgt=3168 | pg hgt=6336
Font PPI=300 | Font PPI=600

using FontMetrics:
avg char wid=15 | avg char wid=30
max char wid=35 | max char wid=70

using Printer.Canvas.TextWidth:
'W' char wid=34 | 'W' char wid=63

Sample text using Printer.Canvas.TextWidth:
width samp text=394 | width samp text=824

ShowMessage('printer page width: ' + IntToStr(Printer.PageWidth));
ShowMessage('printer page height: ' + IntToStr(Printer.PageHeight));
ShowMessage('Font PPI: ' + IntToStr(Printer.Canvas.Font.PixelsPerInch));
ShowMessage('Font name, size: ' + Printer.Canvas.Font.Name + ', '
+ IntToStr(Printer.Canvas.Font.Size));

ShowMessage('max char width (TextMetrics): '
+ IntToStr(TextMetrics.tmMaxCharWidth));
ShowMessage('max char width (Canvas.TextWidth - auto scaled): '
+ IntToStr(Printer.Canvas.TextWidth('W')));
ShowMessage('Avg char width (TextMetrics): '
+ IntToStr(TextMetrics.tmAveCharWidth));
ShowMessage('Avg char width (Canvas.TextWidth - auto scaled): '
+ IntToStr(Printer.Canvas.TextWidth('j')));

ShowMessage('Width of sample text: ' +
IntToStr(Printer.Canvas.TextWidth('this is sample text for sizing')));
*)
end;


function TPrintGrid.RealToStr(x: Real): String;
var
Str1: String[15];
begin

Str(x, Str1);
result:=Str1;
end;


procedure Register;
begin

RegisterComponents('Samples', [TPrintGrid]);
end;


end.

*
* Juri-Gagarin-Str. 2 * Brandenburg, Germany =
*
* WH II/Zi.: 520 * =
*
*
* phone: +49(0)355/20769 * WWW : http://www.informatik.tu-cottbus.de/~rs=
*
***************************************************************************=
***
Some things are higher than small !

=20

不知道是否有分隔线。[]

ehlib'dbgrideh

各位大吓，有没有简单而又有效的答案，要具体点。

老兄，用ehlib吧，支持直接打印和多表头，很爽！

哇，这程序太猛呢！！简单点啊

小一点的，不过没有线了。[]
uses
DBGrids, QuickRpt, DB, Qrctrls,qrprntr,printers;

procedure PrintDBGrid(DBGrid: TDBGrid;
pTitle: string);
const
VER_MSG = '显示信息';
VG_UnitName='公司名称';
var
aReport: TQuickRep;
i, aLeft: integer;
PageHeaderBand1: TQRBand;
ColumnHeaderBand1: TQRBand;
DetailBand1: TQRBand;
PageFooterBand1: TQRBand;
oldBmk: TBookMark;
begin

if not DBGrid.DataSource.DataSet.Active then

begin

ShowMessage('数据集没有打开!');
Exit;
end;


oldBmk := DBGrid.DataSource.DataSet.GetBookmark;
DBGrid.DataSource.DataSet.First;
aReport := TQuickRep.Create(nil);
PageHeaderBand1 := aReport.CreateBand(rbPageHeader);
ColumnHeaderBand1 := aReport.CreateBand(rbColumnHeader);
DetailBand1 := aReport.CreateBand(rbDetail);
PageFooterBand1 := aReport.CreateBand(rbPageFooter);
aReport.DataSet := DBGrid.DataSource.DataSet;
aReport.Font := DBGrid.Font;
DetailBand1.Height := 27;

with TQRLabel(PageHeaderBand1.AddPrintable(TQRLabel))do

begin

Caption := pTitle;
Top := 10;
Left := 0;
Font.Style := [fsBold];
Font.Size := 14;
Width := 0;
end;


aLeft := 0;
for i := 0 to DBGrid.FieldCount - 1do

aLeft := aLeft + DBGrid.Columns.Width + 10;

if aLeft > 728 then

aReport.Page.Orientation := poLandscape
else

aReport.Page.Orientation := poPortrait;
with TQRShape(PageHeaderBand1.AddPrintable(TQRShape))do

begin

Top := 37;
Left := 0;
Height := 2;
pen.Width := 2;
Width := PageHeaderBand1.Width;
end;

with TQRShape(PageFooterBand1.AddPrintable(TQRShape))do

begin

Top := 2;
Left := 0;
Height := 1;
pen.Width := 1;
Width := PageFooterBand1.Width;
end;

with TQRLabel(PageHeaderBand1.AddPrintable(TQRLabel))do

begin

Font.Size := 8;
Caption := VG_UnitName;
Top := PageHeaderBand1.height - Height - 5;
Left := PageHeaderBand1.Width - length(VER_MSG) * Font.Size - 5;
end;

with TQRSysData(PageFooterBand1.AddPrintable(TQRSysData))do

begin

Data := qrsDateTime;
Top := 10;
Left := 0;
end;

with TQRLabel(PageFooterBand1.AddPrintable(TQRLabel))do

begin

Caption := '第';
Top := 10;
Left := PageFooterBand1.Width - 380;
end;

with TQRSysData(PageFooterBand1.AddPrintable(TQRSysData))do

begin

Data := qrsPageNumber;
Top := 10;
Left := PageFooterBand1.Width - 360;
end;

with TQRLabel(PageFooterBand1.AddPrintable(TQRLabel))do

begin

Caption := '页';
Top := 10;
Left := PageFooterBand1.Width - 300;
end;

with TQRLabel(PageFooterBand1.AddPrintable(TQRLabel))do

begin

Caption := '记录总数：';
Top := 10;
Left := PageFooterBand1.Width - 180;
end;

with TQRSysData(PageFooterBand1.AddPrintable(TQRSysData))do

begin

Data := qrsDetailCount;
Top := 10;
Left := PageFooterBand1.Width - 100;
end;


aLeft := 0;
for i := 0 to DBGrid.FieldCount - 1do

begin

if DBGrid.Columns.Visible = false then

continue;
if aLeft + DBGrid.Columns.Width > PageHeaderBand1.Width then

Break;
with TQRShape(ColumnHeaderBand1.AddPrintable(TQRShape))do

begin

Height := 1;
Top := ColumnHeaderBand1.Height - 5;
Left := aLeft;
Width := DBGrid.Columns.Width;
end;


with TQRLabel(ColumnHeaderBand1.AddPrintable(TQRLabel))do

begin

AutoSize := false;
Width := DBGrid.Columns.Width;
Caption := DBGrid.Columns.Title.Caption;
Alignment := taCenter;
Top := 10;
Left := aLeft;
end;


with TQRDBText(DetailBand1.AddPrintable(TQRDBText))do

begin

DataSet := DBGrid.DataSource.DataSet;
DataField := DBGrid.Columns.FieldName;
Alignment := DBGrid.Columns.Alignment;
Top := 5;
Left := aLeft;
AutoSize := False;
Width := DBGrid.Columns.Width;
end;


aLeft := aLeft + DBGrid.Columns.Width + 10;
end;


aReport.Preview;

ColumnHeaderBand1.Free;
DetailBand1.Free;
PageFooterBand1.Free;
PageHeaderBand1.Free;

aReport.Free;

DBGrid.DataSource.DataSet.GotoBookmark(oldBmk);
DBGrid.DataSource.DataSet.FreeBookmark(oldBmk);
end;

上面的几位高手，你们的两个控件都不能安装噢，
它有很多报错的，可以使用吗？

我有一个代码，是用printer实现的，要的话，留个email吧

你好 ：
womanlee,我是fbb,^_^。先谢谢你，我想要你的代码，我的E＿mail:
fbb588@163.com

用ehlib控件吧，非常方便。

C好的，没有问题