Function TitleWidth(Const S:String):Longint;
Var tmpFont:TFont;
Begin
With Printer.Canvas do
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.Canvas do
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.DataSet do
for t:=0 to FieldCount-1 do
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.Canvas do
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.Canvas do
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.Canvas do
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.Canvas do
for t:=2 to NPositions do
Begin
MoveTo(FMargins[LeftMargin]+Positions[t],FirstRecordY);
LineTo(FMargins[LeftMargin]+Positions[t],Printer.PageHeight-FMargins[BottomMargin]);
End;
col:=0;
With FDBGrid.DataSource.DataSet do
With Printer.Canvas do
Begin
tmpFont:=TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FTitleFont);
for t:=0 to FieldCount-1 do
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;
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;
//这个控件就可以打印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 !!!}