直接打印DBGrids的内容(100分)

我做了一个程序，要求打印大量QUERY查询的内容，有些内容可直接打印。
不需设定格式直接打印DBGrids的内容即可。
我找到了一个控件，可不能控制页面大小，请各位高手帮忙。

下面是控件原程序
(* 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

WWW.51DELPHI.COM
Devexperss MasterView v1.2
Devexpress printing system v2.11

能告知在那页吗？

能告诉使作哪个控件吗/

1、Devexperss系列控件太大了，很占资源。
建议使用ftp://soft:soft@ftp.51delphi.com/ehlib21.rar，很简单，而且小。
或者用PringAtonce控件，在cn.yahoo.com中以PringAtonce为关键字查询一下，有一堆。

控件我已贴出

或者试试我做的Report Machine,可以打印DBGrid, http://rmachine.y365.com

本网站就有很多！你搜索一下。。。。。

用FASTREPORT。最好!

那里有FASTREPORT？

用ehlib

下面是使用QuickReport打印DBGrid的一段代码。打印效果还可以。

下面函数可以原样打印出所有有句柄的对象
function TForm_main.getControlbitmap(lv: TWinControl): TBitmap;
var
Ofs: Integer;
begin
Result := TBitmap.Create;
try
Result.Width := ClientWidth;
Result.Height := ClientHeight;
Result.Canvas.Brush := Brush;
Result.Canvas.FillRect(ClientRect);
Result.Canvas.Lock;
try
if GetWindowLong(Handle, GWL_STYLE) and WS_BORDER <> 0 then
Ofs := -1 //do
n't draw form border
else
Ofs := 0;
// There is no border
lv.PaintTo(Result.Canvas.Handle, Ofs, Ofs);
finally
Result.Canvas.Unlock;
end;
except
Result.Free;
raise;
end;
end;

procedure TForm_main.printControl(lv: TWinControl);
var
Ofs: Integer;
//ptBitmap: TBitmap;
FormImage: TBitmap;
Info: PBitmapInfo;
InfoSize: DWORD;
Image: Pointer;
ImageSize: DWORD;
Bits: HBITMAP;
DIBWidth, DIBHeight: Longint;
PrintWidth, PrintHeight: Longint;
begin
FormImage := TBitmap.Create;
try
FormImage.Width := lv.ClientWidth;
FormImage.Height := lv.ClientHeight;
FormImage.Canvas.Brush := Brush;
FormImage.Canvas.FillRect(lv.ClientRect);
FormImage.Canvas.Lock;
try
if GetWindowLong(Handle, GWL_STYLE) and WS_BORDER <> 0 then
Ofs := -1 //do
n't draw form border
else
Ofs := 0;
// There is no border
lv.PaintTo(FormImage.Canvas.Handle, Ofs, Ofs);
finally
FormImage.Canvas.Unlock;
end;
except
FormImage.Free;
Application.MessageBox('Print list view error', nil, MB_OK);
exit;
end;

Printer.Orientation := poLandscape;
Printer.begin
Doc;
try
FormImage := getControlbitmap(lv);
Canvas.Lock;
Canvas.TextOut(10, 10, FormatDateTime('yyyy-mm-dd hh:nn', Now()));
try
{ Paint bitmap to the printer }
with Printer, Canvasdo
begin
Bits := FormImage.Handle;
GetDIBSizes(Bits, InfoSize, ImageSize);
Info := AllocMem(InfoSize);
try
Image := AllocMem(ImageSize);
try
GetDIB(Bits, 0, Info^, Image^);
with Info^.bmiHeaderdo
begin
DIBWidth := biWidth;
DIBHeight := biHeight;
end;
case PrintScale of
poProportional:
begin
PrintWidth := MulDiv(DIBWidth, GetDeviceCaps(Handle,
LOGPIXELSX), PixelsPerInch);
PrintHeight := MulDiv(DIBHeight, GetDeviceCaps(Handle,
LOGPIXELSY), PixelsPerInch);
end;
poPrintToFit:
begin
PrintWidth := MulDiv(DIBWidth, PageHeight, DIBHeight);
if PrintWidth < PageWidth then
PrintHeight := PageHeight
else
begin
PrintWidth := PageWidth;
PrintHeight := MulDiv(DIBHeight, PageWidth, DIBWidth);
end;
end;
else
PrintWidth := DIBWidth;
PrintHeight := DIBHeight;
end;
StretchDIBits(Canvas.Handle, 50, 50, PrintWidth, PrintHeight, 0, 0,
DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
finally
Canvas.Unlock;
FormImage.Free;
end;
finally
Printer.EndDoc;
end;
end;

用 Form1.Print

　　类似的控件前两年我们也做过，而且功能比这个强得多，几乎可以打印能
放在FORM上的常用的可视化控件，如StringGrid,DBGrid,Edit,DBEdit,Bavel
等，由它们来组成各种各样格式报表，还可以自动分页、任意指定放大倍数，
当时我们做的一个大项目的所有打印程序就是用它来做的，效果还成，就是画
多层表头太麻烦。现在再回过头去看，这已是一种比较落后的方法了，所以已
不再用。
　　我们新的解决方案是用类似excel那样的电子表格平台来设计报表格式、
定义数据源和查询条件，程序员不用编写一句代码就可以完成报表格式的定义、
数据源的定义、查询条件的定义，并按用户指定的条件查询打印报表，还可以
在企业网站上以HTML格式发布报表数据......（请参看“报表问题的终极解决
方案”这个帖子）。新的来了，旧的当然就要公开乐，有感兴趣的请举手（这
可是我们开发小组花了很多心血去做的喔，不要白不要 ）。

希望看一下，学习学习
yzhshi@263.net

我举手....anzuo@21cn.com

我也看看。
mxsoftking@21cn.com

dingj@263.net
非常感谢,我正想研究一下类似东西.