如何将DBgrid中的数据做成报表以使其报表和DBgrid形式一样??(高分相送,只要答得好)

一把吉他 2003-09-13 05:42:51
如题,查了好多资料,都没有说清楚,有好多例子,运行时错误,有人做广告了一些插件,也在编译时缺少文件,我就真疯了!!


高手请多帮忙,分多多给你们送!!!

...全文
36 11 打赏 收藏 转发到动态 举报
写回复
用AI写文章
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
jingbianfc 2003-11-26
  • 打赏
  • 举报
回复
EHLIB的GRIDEH有相应的打印控件!!
zzh26 2003-11-26
  • 打赏
  • 举报
回复
用fastreport2.51可以直接打印dbgrid
hongqi162 2003-11-26
  • 打赏
  • 举报
回复
直接打印窗体怎么样??

哈哈!
一把吉他 2003-11-26
  • 打赏
  • 举报
回复
先在此谢过,好久没上网了,这回这正在试,完了我结贴
yudehui 2003-11-08
  • 打赏
  • 举报
回复
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;
yudehui 2003-11-08
  • 打赏
  • 举报
回复
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;
yudehui 2003-11-08
  • 打赏
  • 举报
回复
//这个控件就可以打印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;
一把吉他 2003-11-07
  • 打赏
  • 举报
回复
好久没上网了,真是不好意思!
希望大哥们不要介意!!

我的邮箱是litzany@sina.com

最好是能用在Delphi7.0上的!!

先谢了
angle097113 2003-09-13
  • 打赏
  • 举报
回复
我有一个关于这方面很好的控件
你可以把你的邮箱给我
suton 2003-09-13
  • 打赏
  • 举报
回复
我這裡有一個控件,可以把dbgrid裡面的數據拷貝到剪貼板,然後可以粘貼到excel,不知你要不要
frogshero 2003-09-13
  • 打赏
  • 举报
回复
用ehlib中的dbgrideh

2,496

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 数据库相关
社区管理员
  • 数据库相关社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧