如何打印DBgrid?(50分)

如何打印DBgrid?

有个 PrintAtOnce 控件

好用吗?

//这个控件就可以打印TDBGrid.

{ TPrintGrid Component VERSION 1.0 4-1995 }
{ Allows to print a DBGrid with some configuration }
{ Sorry for my english. Some parts of this code are in catalan-spanish }

{ Send me your comments and remember: ITS BETA, ITS FREE AND YOU HAVE THE SOURCES }
{ Good luck !!!}

unit UPrigrid;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs,DBGrids,DsgnIntf;

Const MaxPages=1000;
MaxCols=100;

TopMargin =1;
BottomMargin =2;
LeftMargin =3;
RightMargin =4;

type
TMyFontProperty=class(TClassProperty)
public
function GetAttributes:TPropertyAttributes;override;
procedure Edit;override;
end;


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

TPrintGrid = class(TComponent)
private
{ Private declarations }
tmpFile :Text;
FDBGrid :TDBGrid;
FHeaderInTitle :Boolean;
FHeaderAlign :TAlignment;
FLinesFont,
FHeaderFont,
FTitleFont :TFont;
FPageNLabel :String;
FPageNPos :TPageNumberPos;
FScreenViewer,
FHeader,
FPrintADMTitle :String;
FirstRecordY,
LinesWidth,
LinesHeight,
RecCounter :Longint;
FToScreen,
FTitulosAlign :Boolean;
tmpPageNo,
FFromPage,
FToPage :Longint;
NPositions :Integer;
FMargins :Array[1..4] of Integer;
{ top,bottom,left,right }
Positions :Array[1..MaxCols] of Longint;
FColLines,
FRowLines,
FBorder :Boolean;
HorizGap,
VertGap :Integer;
Procedure WriteLineScreen(Const S:String);
Function GetMargins(Index:Integer):Integer;
Procedure SetMargins(Index:Integer;
Value:Integer);
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner:TComponent);
override;
Destructor Destroy;
override;
Procedure Print;
Procedure PrintDialog;
property Margins[Index:Integer]:Integer read GetMargins write SetMargins;
published
{ Published declarations }
property DBGrid:TDBGrid read FDBGrid write FDBGrid;
property PrintAdmTitle:String read FPrintADMTitle write FPrintADMTitle;
property HeaderInTitle:Boolean read FHeaderInTitle write FHeaderinTitle;
property Header:String read FHeader write FHeader;
property HeaderAlignment:TAlignment read FHeaderAlign write FHeaderAlign;
property TitleFont:TFont read FTitleFont write FTitleFont;
property HeaderFont:TFont read FHeaderFont write FHeaderFont;
property LinesFont:TFont read FLinesFont write FLinesFont;
property ToScreen:Boolean read FToScreen write FToScreen;
property ScreenViewer:String read FScreenViewer write FScreenViewer;
property FromPage:Longint read FFromPage write FFromPage;
property ToPage:Longint read FToPage write FToPage;
property Border:Boolean read FBorder write FBorder;
property ColLines:Boolean read FColLines write FColLines;
property RowLines:Boolean read FRowLines write FRowLines;
property AlignedTitles:Boolean read FTitulosAlign write FTitulosAlign;
property HorizontalGap:Integer read HorizGap write HorizGap;
property VerticalGap:Integer read VertGap write VertGap;
property PageNumberPos:TPageNumberPos read FPageNPos write FPageNPos;
property PageNumberLabel:String read FPageNLabel write FPageNLabel;
end;


procedure Register;

implementation

Uses Printers,DB;

function TMyFontProperty.GetAttributes:TPropertyAttributes;
begin

Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
end;


procedure TMyFontProperty.Edit;
var
FontDialog: TFontDialog;
FMyFont:TFont;
begin

FontDialog := TFontDialog.Create(Application);
try
FMyFont:=TFont(GetOrdValue);
FontDialog.Font.Assign(FMyFont);
FontDialog.Options := FontDialog.Options + [fdForceFontExist];
if FontDialog.Execute then

begin

FMyFont.Assign(FontDialog.Font);
Designer.Modified;
end;

finally
FontDialog.Free;
end;

end;


Function TPrintGrid.GetMargins(Index:Integer):Integer;
begin

result:=FMargins[Index];
end;


Procedure TPrintGrid.SetMargins(Index:Integer;
Value:Integer);
begin

FMargins[Index]:=Value;
end;


Procedure TPrintGrid.WriteLineScreen(Const S:String);
begin

if (tmpPageNo>=FFromPage) and
(tmpPageNo<=FToPage) then
Writeln(tmpFile,s);
end;


Destructor TPrintGrid.Destroy;
begin

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


Constructor TPrintGrid.Create(AOwner:TComponent);
begin

inherited Create(AOwner);
FTitleFont:=TFont.Create;
FHeaderFont:=TFont.Create;
FLinesFont:=TFont.Create;
{ DEFAULT VALUES FOR ALL PROPERTIES }
FDBGrid:=nil;
FHeader:='';
FPrintADMTitle:='';
RecCounter:=0;
HorizGap:=2;
FMargins[TopMargin]:=0;
FMargins[BottomMargin]:=0;
FMargins[LeftMargin]:=0;
FMargins[RightMargin]:=0;
FToScreen:=False;
FScreenViewer:='';
FFromPage:=1;
FToPage:=MaxPages;
FTitulosAlign:=True;
FBorder:=True;
FColLines:=True;
FRowLines:=False;
FHeaderAlign:=taCenter;
FHeaderIntitle:=False;
FPageNPos:=pnTopRight;
FPageNLabel:='Page: ';
end;


Procedure TPrintGrid.Print;

Function Max(a,b:Longint):Longint;
{ typical function... }
begin

if a>b then
result:=a else
result:=b;
end;


Function ConstStr(C:Char;
N:Integer):String;
{ returns a filled string }
Var S:String;
begin

if n>0 then

begin

SetLength(S,N);
FillChar(s[1],N,Ord(C));
result:=S;
end
else
result:='';
end;


Function OpenTextForWrite(var f:text;
Const ss:String):Boolean;
begin

if ss<>'' then

begin

{$I-}
AssignFile(f,ss);
rewrite(f);
{$I+}
result:=(ioresult=0);
End else
result:=False;
end;


Function LongiScreen(tmp:TField):Longint;
begin

result:=Max(tmp.DisplayWidth,Length(tmp.DisplayLabel));
end;


Function RestoBlancos(tmp:TField;
Const Prefijo:String):String;
begin

result:=ConstStr(' ',LongiScreen(tmp)-Length(Prefijo));
end;


Function TitleWidth(Const S:String):Longint;
Var tmpFont:TFont;
begin

With Printer.Canvasdo

begin

tmpFont:=TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FTitleFont);
result:=TextWidth(s);
Font.Assign(tmpFont);
tmpFont.Free;
end;

end;


Function TitleHeight:Longint;
Var tmpFont:TFont;
begin

With Printer.Canvasdo

begin

tmpFont:=TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FTitleFont);
result:=TextHeight('M');
Font.Assign(tmpFont);
tmpFont.Free;
end;

end;


Procedure CalculatePositions;
Var longitud,t:Longint;
begin

NPositions:=0;
if FBorder then
Positions[1]:=1 else
Positions[1]:=0;
With FDBGrid.DataSource.DataSetdo

for t:=0 to FieldCount-1do

With Fields[t]do

if Visible then

begin

inc(NPositions);
longitud:=Max(TitleWidth(Fields[t].DisplayLabel),
(LinesWidth*Fields[t].DisplayWidth));
Positions[NPositions+1]:=Positions[NPositions]+Longitud+HorizGap;
end;

end;


Function SetAlign(align:TAlignment;
Left,Right:Longint):Longint;
Var PosX:Longint;
begin

PosX:=0;
with Printer.Canvasdo

begin

case Align of
taLeftJustify : SetTextAlign(Handle,TA_LEFT);
taRightJustify: SetTextAlign(Handle,TA_RIGHT);
taCenter : SetTextAlign(Handle,TA_CENTER);
end;

case Align of
taLeftJustify: PosX:=Left+HorizGap;
taRightJustify: PosX:=Right-HorizGap;
taCenter : PosX:=Left+Round((Right-Left)/2);
end;

end;

result:=PosX;
end;


Function SetPagePos(PagePos:TPageNumberPos;
Left,Right:Longint):Longint;
Var PosX:Longint;
begin

PosX:=0;
with Printer.Canvasdo

begin

case PagePos of
pnTopLeft,
pnBotLeft: begin
SetTextAlign(Handle,TA_LEFT);
PosX:=Left+HorizGap;
end;

pnTopRight,
pnBotRight: begin
SetTextAlign(Handle,TA_RIGHT);
PosX:=Right-HorizGap;
end;

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

end;

end;

result:=PosX;
end;


Function PrepareAlign(Field:TField;
Col:Integer):Longint;
begin

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


Procedure WriteHeaderToPrinter;
Var col,PosX,t,tmpTitleHeight:Longint;
TmpFont:TFont;
begin

if (tmpPageNo>=FFromPage) and
(tmpPageNo<=FToPage) then

begin

tmpTitleHeight:=TitleHeight;
if (FHeader<>'') Or (FPageNPos in [pnTopLeft,pnTopCenter,pnTopRight]) then

With Printer.Canvasdo

begin

tmpFont:=TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FHeaderFont);
PosX:=SetAlign(FHeaderAlign,FMargins[LeftMargin],
FMargins[LeftMargin]+Positions[NPositions+1]);
TextOut(PosX,FMargins[TopMargin],FHeader);
FirstRecordY:=FMargins[TopMargin]+TextHeight('M')+tmpTitleHeight;
PosX:=SetPagePos(FPageNPos,FMargins[LeftMargin],
FMargins[LeftMargin]+Positions[NPositions+1]);
TextOut(PosX,FMargins[TopMargin],FPageNLabel+IntToStr(tmpPageNo));
Font.Assign(tmpFont);
tmpFont.Free;
End
else
FirstRecordY:=FMargins[TopMargin]+tmpTitleHeight;

if FBorder then

begin

if FHeaderinTitle then

Printer.Canvas.Rectangle(FMargins[LeftMargin],FMargins[TopMargin],
FMargins[LeftMargin]+Positions[NPositions+1],
Printer.PageHeight-FMargins[BottomMargin])
else

Printer.Canvas.Rectangle(FMargins[LeftMargin],FirstRecordY-tmpTitleHeight,
FMargins[LeftMargin]+Positions[NPositions+1],
Printer.PageHeight-FMargins[BottomMargin])
end;

if FColLines then

With Printer.Canvasdo

for t:=2 to NPositionsdo

begin

MoveTo(FMargins[LeftMargin]+Positions[t],FirstRecordY);
LineTo(FMargins[LeftMargin]+Positions[t],Printer.PageHeight-FMargins[BottomMargin]);
end;

col:=0;
With FDBGrid.DataSource.DataSetdo

With Printer.Canvasdo

begin

tmpFont:=TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FTitleFont);
for t:=0 to FieldCount-1do

With Fields[t]do

if Visible then

begin

inc(Col);
PosX:=PrepareAlign(Fields[t],Col);
TextOut(FMargins[LeftMargin]+PosX,FirstRecordY-tmpTitleHeight,DisplayLabel);
end;

moveto(FMargins[LeftMargin],FirstRecordY);
Lineto(FMargins[LeftMargin]+Positions[NPositions+1],FirstRecordY);
Font.Assign(tmpFont);
tmpFont.Free;
end;

end;

end;


Procedure WriteHeader;
Var t:Longint;
s,slin:String;
begin

if FToScreen then

With FDBGrid.DataSource.DataSetdo

begin

WriteLineScreen(FHeader);
WriteLineScreen('');
s:='';
slin:='';
for t:=0 to FieldCount-1do

With Fields[t]do

if Visible then

begin

if (Not AlignedTitles) or (Alignment=taLeftJustify) then

begin

s:=s+DisplayLabel;
s:=s+RestoBlancos(Fields[t],DisplayLabel)+' ';
End
else

begin

s:=s+RestoBlancos(Fields[t],DisplayLabel);
s:=s+DisplayLabel+' ';
end;

slin:=slin+ConstStr('-',LongiScreen(Fields[t]))+' ';
end;

WriteLineScreen(s);
WriteLineScreen(slin);
End
else
WriteHeaderToPrinter;
end;


Procedure WriteRecordToPrinter;
var Col,t,PosX,PosY:Longint;
tmpFont:TFont;
begin

if (tmpPageNo>=FFromPage) and
(tmpPageNo<=FToPage) then

begin

With FDBGrid.DataSource.DataSetdo

begin

Col:=0;
PosY:=FirstRecordY+RecCounter*LinesHeight;
for t:=0 to FieldCount-1do

With Fields[t]do

if Visible then

With Printer.Canvasdo

begin

tmpFont:=TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FLinesFont);
inc(Col);
PosX:=PrepareAlign(Fields[t],Col);
TextOut(FMargins[LeftMargin]+PosX,PosY,DisplayText);
Font.Assign(tmpFont);
tmpFont.Free;
end;

if FRowLines then

With Printer.Canvasdo

begin

MoveTo(FMargins[LeftMargin],PosY);
LineTo(FMargins[LeftMargin]+Positions[NPositions+1],PosY);
end;

end;

end;

end;


Procedure WriteRecord;
var t:Word;
s,st:String;
begin

if not FToScreen then
WriteRecordToPrinter
else

begin

With FDBGrid.DataSource.DataSetdo

begin

s:='';
for t:=0 to FieldCount-1do

With Fields[t]do

if Visible then

begin

st:=DisplayText;
if Alignment=taLeftJustify then

s:=s+Copy(st,1,LongiScreen(Fields[t]))+RestoBlancos(Fields[t],st)
else

s:=s+RestoBlancos(Fields[t],st)+Copy(st,1,LongiScreen(Fields[t]));
s:=s+' ';
end;

end;

WriteLineScreen(s);
end;

end;


Procedure PageJump;
begin

RecCounter:=0;
if not FToScreen then

if (tmpPageNo>=FFromPage) and
(tmpPageNo<FToPage) then
Printer.NewPage;
inc(tmpPageNo);
end;


Function GuessViewer:String;
{ stupid tricky }
Var ff:File;
n:Longint;
begin

AssignFile(ff,'tmp.txt');
n:=0;
try
Reset(ff);
n:=FileSize(ff);
closefile(ff);
finally
if n>32000 then
result:='write'
else
result:='notepad';
end;

end;


Function RealWidth:Longint;
begin

Result:=Printer.PageWidth-FMargins[LeftMargin]-FMargins[RightMargin];
end;


Function AllPageFilled:Boolean;
begin

result:=(FToScreen and (RecCounter=66)) or
(not FToScreen and
((FirstRecordY+(RecCounter-1)*LinesHeight)>=
(Printer.PageHeight-FMargins[BottomMargin])));
end;


var res:Boolean;
St:Array[0..255] of Char;
Programa:String;
MyBookMark:TBookMark;
t:Integer;
tmpFont:TFont;
begin

if Not Assigned(FDBGrid) then
Raise Exception.Create('PrintGrid. No DBGrid specified!');
if FToScreen then
res:=OpenTextForWrite(tmpFile,'tmp.txt')
else

begin

With Printerdo

begin

Title:=FPrintAdmTitle;
begin
Doc;
With Canvasdo

begin

tmpFont:=TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FLinesFont);
LinesHeight:=TextHeight('M');
LinesWidth:=TextWidth('0');
Font.Assign(tmpFont);
tmpFont.Free;
end;

end;

end;

if res then

begin

With FDBGrid.DataSource.DataSetdo

try
Screen.Cursor:=crHourGlass;
MyBookmark:=GetBookMark;
DisableControls;
First;
RecCounter:=0;
tmpPageNo:=1;
CalculatePositions;
{ where to place each field in horizontal plane? }
if not FToScreen and (Positions[NPositions+1]>RealWidth) then

ShowMessage('Report width is greater than paper');
{ useful in design }
While not eofdo

begin

if RecCounter=0 then
WriteHeader;
WriteRecord;
Inc(RecCounter);
next;
if AllPageFilled then

begin

PageJump;
if tmpPageNo>FToPage then
break;
end;

end;

finally
Screen.Cursor:=crDefault;
GotoBookMark(MyBookMark);
EnableControls;
FreeBookMark(MyBookMark);
if FToScreen then

begin

System.closefile(tmpFile);
if FScreenViewer='' then
Programa:=GuessViewer
else
Programa:=FScreenViewer;
WinExec(StrPCopy(St,Programa+' tmp.txt'),SW_SHOWMAXIMIZED);
End
else
Printer.EndDoc;
end;

end
else
raise Exception.Create('Error al obrir la impresora');
end;


Procedure TPrintGrid.PrintDialog;
begin

With TPrintDialog.Create(Self)do

try
Options:=[poPageNums];
MinPage:=1;
MaxPage:=MaxPages;
FFromPage:=1;
FToPage:=MaxPages;
if Execute then

begin

if PrintRange=prPageNums then

begin

FFromPage:=FromPage;
FToPage:=ToPage;
end;

Print;
end;

finally
Free;
end;

end;


procedure Register;
begin

RegisterComponents('Data Controls', [TPrintGrid]);
RegisterPropertyEditor(TypeInfo(TFont),
TPrintGrid,'TitleFont',TMyFontProperty);
RegisterPropertyEditor(TypeInfo(TFont),
TPrintGrid,'HeaderFont',TMyFontProperty);
RegisterPropertyEditor(TypeInfo(TFont),
TPrintGrid,'LinesFont',TMyFontProperty);
end;


end.

http://member.netease.com/~tomcar/ 有一个DBGRID增强控件，非常好用！支持打印！

DBGridEH is Too POWERFUL !!!

用Quick Report
Quick Report.DataSet:=DbGrid.DataSource.DataSet;

沈前卫：
.......
.....

Procedure PageJump;
begin

RecCounter:=0;
if not FToScreen then

if (tmpPageNo>=FFromPage) and
(tmpPageNo32000 then
result:='write' ----> 这句有问题呀？
else
result:='notepad';
end;

end;

......

为什么不用QuickRep打印很方便的。

实在要打印DBGrid ,干脆打印窗体好了！快

对呀。。。

如果使用动态查询、在显示字段不定的情况下，用QuickRep进行排版很困难！你不这样认为吗？

多人接受答案了。

收藏