写了一个报表生成器,基于FastReport的,我这个程序本身没有扩展任何功能,只是集成FastReport的功能而已,不过因为FastReport本省功能的强

  • 主题发起人 delphilai
  • 开始时间
Capot@21cn.com
 
不好意思,不知道哪位dfw把邮箱密码改了,现在上传到ftp上去了,请大家用
http://www.info98.net/ReportBuilder.rar
下载。谢谢!
 
另外,我在
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1899782
发布了报表动态生成源代码,请有需要的 Look 一下。
 
既然在http://www.delphibbs.com/delphibbs/dispq.asp?lid=1899782
发布了报表动态生成源代码,这个报表生成器也公布源代码算了,大家下载之后参考运行界面效果和下面的源代码,相信对你做报表有点参考价值。
1、主窗体单元:
============================================
unit uMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, FR_Desgn, FR_Class, Db, ADODB, Menus, StdCtrls, Printers, FR_DSet,
FR_DBSet, Buttons, ExtCtrls, FR_View, ToolWin, ActnList, FR_RRect,
FR_Chart, FR_BarC, FR_Shape, FR_ChBox, FR_Rich, FR_OLE;
type
TfrmMain = class(TForm)
StatusBar: TStatusBar;
Report: TfrReport;
ReportDesigner: TfrDesigner;
ADOConnection: TADOConnection;
ReportDataSet: TADOQuery;
DBDataSet: TfrDBDataSet;
DataSource: TDataSource;
Preview: TfrPreview;
ToolBar1: TToolBar;
btnDataSetDefine: TSpeedButton;
btnSaveReport: TSpeedButton;
btnOpenReport: TSpeedButton;
btnPageWidth: TSpeedButton;
btnOnePage: TSpeedButton;
btnZoomTo100: TSpeedButton;
btnClose: TSpeedButton;
btnNextPage: TSpeedButton;
btnPrevPage: TSpeedButton;
btnFirstPage: TSpeedButton;
btnPrintReport: TSpeedButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
btnConnectDatabase: TSpeedButton;
ToolButton3: TToolButton;
btnLastPage: TSpeedButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ActionList1: TActionList;
ActionConnectDatabase: TAction;
ActionOpenReport: TAction;
ActionAbout: TAction;
ActionDataSetDefine: TAction;
ActionReportDefine: TAction;
btnReportDefine: TSpeedButton;
btnReportPreview: TSpeedButton;
ActionReportPreview: TAction;
ActionClose: TAction;
ActionFirstPage: TAction;
ActionPrevPage: TAction;
ActionNextPage: TAction;
ActionLastPage: TAction;
ActionPageWidth: TAction;
ActionOnePage: TAction;
ActionTwoPages: TAction;
ActionZoomTo100: TAction;
ActionSaveReport: TAction;
ActionPrintReport: TAction;
frOLEObject1: TfrOLEObject;
frRichObject1: TfrRichObject;
frCheckBoxObject1: TfrCheckBoxObject;
frShapeObject1: TfrShapeObject;
frBarCodeObject1: TfrBarCodeObject;
frChartObject1: TfrChartObject;
frRoundRectObject1: TfrRoundRectObject;
ToolButton6: TToolButton;
btnCreateDataset: TSpeedButton;
ActionCreateDataSet: TAction;
btnAbout: TSpeedButton;
ToolButton7: TToolButton;
GroupBox1: TGroupBox;
cmbDatasets: TComboBox;
procedure ActionConnectDatabaseExecute(Sender: TObject);
procedure ActionAboutExecute(Sender: TObject);
procedure ActionDataSetDefineExecute(Sender: TObject);
procedure ActionReportDefineExecute(Sender: TObject);
procedure ActionReportPreviewExecute(Sender: TObject);
procedure ActionCloseExecute(Sender: TObject);
procedure ADOConnectionAfterConnect(Sender: TObject);
procedure ADOConnectionAfterDisconnect(Sender: TObject);
procedure ReportDataSetAfterOpen(DataSet: TDataSet);
procedure ReportDataSetAfterClose(DataSet: TDataSet);
procedure ActionOpenReportExecute(Sender: TObject);
procedure ActionFirstPageExecute(Sender: TObject);
procedure ActionPrevPageExecute(Sender: TObject);
procedure ActionNextPageExecute(Sender: TObject);
procedure ActionLastPageExecute(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ActionPageWidthExecute(Sender: TObject);
procedure ActionOnePageExecute(Sender: TObject);
procedure ActionTwoPagesExecute(Sender: TObject);
procedure ActionZoomTo100Execute(Sender: TObject);
procedure ActionSaveReportExecute(Sender: TObject);
procedure ActionPrintReportExecute(Sender: TObject);
procedure ActionCreateDataSetExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure showConnectionInfo;
procedure showDataSetInfo;
public
{ Public declarations }
end;

var
frmMain: TfrmMain;
implementation
uses uConnectDatabase, uAbout, uCommon, uDataSetDefine;
{$R *.DFM}
procedure TfrmMain.ActionConnectDatabaseExecute(Sender: TObject);
begin
frmConnectDatabase:=TfrmConnectDatabase.Create(application);
try
if frmConnectDatabase.ShowModal=mrok then
begin
ADOConnection.Close;
if frmConnectDatabase.RB1.Checked then
ADOConnection.ConnectionString:=Format(C_ConnectionStringWindows,
[frmConnectDatabase.cmbSqlServer.Text,
frmConnectDatabase.CmbDatabase.Text])
else
begin
ADOConnection.ConnectionString:=Format(C_ConnectionStringUser,
[frmConnectDatabase.cmbSqlServer.Text,
frmConnectDatabase.CmbDatabase.Text,
frmConnectDatabase.edtName.Text,
frmConnectDatabase.edtPwd.Text
] );
if frmConnectDatabase.cbSavePwd.Checked then
ADOConnection.ConnectionString:=ADOConnection.ConnectionString+'True'
else
ADOConnection.ConnectionString:=ADOConnection.ConnectionString+'false';

end;
Try
ADOConnection.Open;
Messagedlg('连接成功!',mtinformation,[mbok],0);
except
Messagedlg('初始化提供者时发生错误。连接失败!用户'+frmConnectDatabase.edtName.Text+'登入失败!',mtWarning,[mbok],0);
end;
end;
frmConnectDatabase.Close;
finally
frmConnectDatabase.free;
end;
end;

procedure TfrmMain.ActionAboutExecute(Sender: TObject);
begin
with TAboutBox.Create(Application)do
begin
showmodal;
Close;
free;
end;
end;

procedure TfrmMain.ActionDataSetDefineExecute(Sender: TObject);
begin
CheckConnected;
if Not frmMain.ADOConnection.Connected then
exit;
if cmbDatasets.Items.Count<1 then
exit;
if cmbDatasets.ItemIndex<0 then
cmbDatasets.ItemIndex:=0;
frmDataSetDefine:=TfrmDataSetDefine.Create(Application);
try
frmDataSetDefine.Memo1.Lines.Text:=frmMain.ReportDataSet.SQL.Text;
if frmDataSetDefine.ShowModal=mrok then
begin
TADOQuery(frmMain.FindComponent(cmbDatasets.Text)).Close;
TADOQuery(frmMain.FindComponent(cmbDatasets.Text)).SQL.Text:=frmDataSetDefine.Memo1.Lines.Text;
try
TADOQuery(frmMain.FindComponent(cmbDatasets.Text)).Open;
except
Messagedlg('数据集定义失败!',mtwarning,[mbok],0);
end;
end;
frmDataSetDefine.Close;
finally
frmDataSetDefine.free;
end;
end;

procedure TfrmMain.ActionReportDefineExecute(Sender: TObject);
begin
Report.DesignReport;
end;

procedure TfrmMain.ActionReportPreviewExecute(Sender: TObject);
begin
Report.ShowReport;
end;

procedure TfrmMain.ActionCloseExecute(Sender: TObject);
begin
self.close;
end;

procedure TFrmMain.showConnectionInfo;
begin
if AdoConnection.Connected then
StatusBar.Panels[0].Text:='数据库已经连接'
else
StatusBar.Panels[0].Text:='数据库未连上';

end;

procedure TFrmMain.showDataSetInfo;
begin
if ReportdataSet.Active then
StatusBar.Panels[1].Text:='数据集已经定义'
else
StatusBar.Panels[1].Text:='数据集未定义';

end;

procedure TfrmMain.ADOConnectionAfterConnect(Sender: TObject);
begin
showConnectionInfo;
end;

procedure TfrmMain.ADOConnectionAfterDisconnect(Sender: TObject);
begin
showConnectionInfo;
end;

procedure TfrmMain.ReportDataSetAfterOpen(DataSet: TDataSet);
begin
showDataSetInfo;
end;

procedure TfrmMain.ReportDataSetAfterClose(DataSet: TDataSet);
begin
showDataSetInfo;
end;

procedure TfrmMain.ActionOpenReportExecute(Sender: TObject);
begin
Preview.LoadFromFile;
end;

procedure TfrmMain.ActionFirstPageExecute(Sender: TObject);
begin
Preview.First;
end;

procedure TfrmMain.ActionPrevPageExecute(Sender: TObject);
begin
Preview.Prev;
end;

procedure TfrmMain.ActionNextPageExecute(Sender: TObject);
begin
Preview.Next;
end;

procedure TfrmMain.ActionLastPageExecute(Sender: TObject);
begin
Preview.Last;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
if cmbDataSets.Items.Count>0 then
begin
cmbDataSets.ItemIndex:=0;
end;
end;

procedure TfrmMain.ActionPageWidthExecute(Sender: TObject);
begin
Preview.PageWidth;
end;

procedure TfrmMain.ActionOnePageExecute(Sender: TObject);
begin
Preview.OnePage;
end;

procedure TfrmMain.ActionTwoPagesExecute(Sender: TObject);
begin
Preview.TwoPages;
end;

procedure TfrmMain.ActionZoomTo100Execute(Sender: TObject);
begin
Preview.Zoom:=100;
end;

procedure TfrmMain.ActionSaveReportExecute(Sender: TObject);
begin
Preview.SaveToFile;
end;

procedure TfrmMain.ActionPrintReportExecute(Sender: TObject);
begin
try
Preview.Print;
except
MessageDlg('打印失败,没发现打印机!',mtwarning,[mbok],0);
end;

end;

procedure TfrmMain.ActionCreateDataSetExecute(Sender: TObject);
var
V_Name:String;
begin
V_Name:='ReportDataSet'+InttoStr(cmbDatasets.Items.Count);
if InputQuery('请输入数据集英文名称','DataSet Name:',V_Name) then
begin
v_Name:=Trim(V_Name);
if cmbDatasets.Items.IndexOf(V_Name)>0 then
begin
Messagedlg('数据集名称已经存在,创建新数据集失败!',mtwarning,[mbok],0);
exit;
end;
with TADOQuery.Create(self)do
begin
Name:=V_Name;
parent:=Self;
cmbDatasets.Items.Add(V_Name);
cmbDataSets.ItemIndex:=cmbDataSets.Items.IndexOf(V_Name);
Connection:=ADOConnection;
ActionDataSetDefineExecute(nil);
end;
end;

end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
Report.Pages.Add;
Report.PrepareReport;
Preview.Connect(Report);
end;

end.
2/公用单元:
===================================================
unit uCommon;
interface
uses
Classes, Windows,Controls, ComObj, Forms,Messages,SysUtils, WinSock {$IFDEF Delphi6},Variants{$EndIf} , Dialogs, uMain, uDataSetDefine ;
function CheckConnected:Boolean;
Function NetGetSQLServerList(var List: Tstringlist): boolean;
implementation
function CheckConnected:Boolean;
begin
Result:=True;
if Not frmMain.ADOConnection.Connected then
begin
if Messagedlg('数据库没有连接!是否立即配置?',mtconfirmation,[mbYes,mbNo],0)=mrYes then
frmMain.ActionConnectDatabase.Execute;
Result:=False;
end;
end;

Function NetGetSQLServerList(var List: Tstringlist): boolean;
var
i: integer;
SQLServer: Variant;
ServerList: Variant;
begin
Result := False;
List.Clear;
try
SQLServer := CreateOleObject('SQLDMO.Application');
ServerList := SQLServer.ListAvailableSQLServers;
for i := 1 to Serverlist.Countdo
list.Add (Serverlist.item(i));
Result := True;
Finally
SQLServer := NULL;
ServerList := NULL;
end;
end;

end.
3、数据库连接单元:
======================================================================
unit uConnectDatabase;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons, Db, ADODB;
type
TfrmConnectDatabase = class(TForm)
Panel1: TPanel;
cmbSQLServer: TComboBox;
Label1: TLabel;
GroupBox1: TGroupBox;
RB1: TRadioButton;
RB2: TRadioButton;
edtName: TEdit;
edtPwd: TEdit;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
cmbDatabase: TComboBox;
BtnTestConnect: TButton;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
btnRefresh: TButton;
ADOConn: TADOConnection;
cbEmptyPwd: TCheckBox;
cbSavePwd: TCheckBox;
BtnRefreshDatabase: TButton;
procedure btnRefreshClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure RB1Click(Sender: TObject);
procedure BtnTestConnectClick(Sender: TObject);
procedure cbEmptyPwdClick(Sender: TObject);
procedure BtnRefreshDatabaseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmConnectDatabase: TfrmConnectDatabase;
const
C_ConnectionString='Provider=SQLOLEDB.1;User ID=%S;Password=%S;Data Source=%S';
C_ConnectionStringWindows='Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Data Source=%S;Initial Catalog=%s;';
C_ConnectionStringUser='Provider=SQLOLEDB.1;Data Source=%s;Initial Catalog=%s;User ID=%s;Password=%s;Persist Security Info=';

implementation
uses uMain, uCommon;
{$R *.DFM}
procedure TfrmConnectDatabase.btnRefreshClick(Sender: TObject);
var
V_List:TStringList;
begin
cmbSQLServer.Items.Clear;
V_List:=TStringList.Create;
try
if NetGetSQLServerList(V_List) then
cmbSQLServer.Items.AddStrings(V_List);
finally
V_List.Free;
end;
end;

procedure TfrmConnectDatabase.FormShow(Sender: TObject);
begin
edtName.Text:='';
edtPwd.Text:='';
Self.Refresh;
end;

procedure TfrmConnectDatabase.RB1Click(Sender: TObject);
begin
edtName.Enabled:=RB2.Checked;
edtPwd.Enabled:=edtName.Enabled;
end;

procedure TfrmConnectDatabase.BtnTestConnectClick(Sender: TObject);
begin
ADOConn.Close;
try
try
ADOConn.ConnectionString:=Format(C_ConnectionString,[edtName.Text,edtPwd.Text,cmbSQLServer.Text]);
ADOConn.Open;
Messagedlg('测试连接成功!',mtinformation,[mbok],0);
except
Messagedlg('初始化提供者时发生错误。测试连接失败!用户'+edtName.Text+'登入失败!',mtWarning,[mbok],0);
end;
finally
ADOConn.Close;
end;
end;

procedure TfrmConnectDatabase.cbEmptyPwdClick(Sender: TObject);
begin
edtPwd.Enabled:=TCheckBox(Sender).Checked;
if Not edtPwd.Enabled then
edtPwd.Text:='';
end;

procedure TfrmConnectDatabase.BtnRefreshDatabaseClick(Sender: TObject);
var
V_SQLText:String;
Qry:TADOQuery;
begin
cmbDatabase.Items.Clear;
V_SQLText:='select * from sysdatabases';
Qry:=TADOQuery.Create(Self);
try
Qry.close;
Qry.ConnectionString:=Format(C_ConnectionString,[edtName.Text,edtPwd.Text,cmbSQLServer.Text]);
Qry.SQL.Text:=V_SQLText;
try
try
Qry.Open;
Qry.First;
while Not Qry.eofdo
begin
cmbDatabase.Items.Add(Qry['Name']);
Qry.next;
end;
except
end;
finally
Qry.Close;
end;
finally
Qry.free;
end;

end;

end.
=======================================================================
4、数据集定义单元:
=========================================================================
unit uDataSetDefine;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, Grids, DBGrids, Db, ADODB;
type
TfrmDataSetDefine = class(TForm)
Panel1: TPanel;
Splitter1: TSplitter;
GroupBox1: TGroupBox;
lbFields: TListBox;
GroupBox2: TGroupBox;
lbTables: TListBox;
Splitter2: TSplitter;
Panel2: TPanel;
GroupBox3: TGroupBox;
Memo1: TMemo;
Splitter3: TSplitter;
DBGrid: TDBGrid;
Panel3: TPanel;
btnExec: TSpeedButton;
btnOk: TBitBtn;
btnCancel: TBitBtn;
DataSource: TDataSource;
ADOQuery: TADOQuery;
procedure FormShow(Sender: TObject);
procedure lbTablesClick(Sender: TObject);
procedure btnExecClick(Sender: TObject);
procedure Memo1DragOver(Sender, Source: TObject;
X, Y: Integer;
State: TDragState;
var Accept: Boolean);
procedure Memo1DragDrop(Sender, Source: TObject;
X, Y: Integer);
private
{ Private declarations }
function GetTables:Boolean;
public
{ Public declarations }
end;

var
frmDataSetDefine: TfrmDataSetDefine;
implementation
uses uMain, uCommon;
{$R *.DFM}
{ TfrmDataSetDefine }
function TfrmDataSetDefine.GetTables: Boolean;
begin
Result:=false;
CheckConnected;
if Not frmMain.ADOConnection.Connected then
exit;
lbTables.Clear;
frmMain.ADOConnection.GetTableNames(lbTables.Items);
Result:=True;
end;

procedure TfrmDataSetDefine.FormShow(Sender: TObject);
begin
GetTables;

end;

procedure TfrmDataSetDefine.lbTablesClick(Sender: TObject);
begin
CheckConnected;
if Not frmMain.ADOConnection.Connected then
exit;
lbFields.Clear;
frmMain.ADOConnection.GetFieldNames(lbTables.Items[lbTables.itemindex],lbFields.Items);
end;

procedure TfrmDataSetDefine.btnExecClick(Sender: TObject);
begin
ADOQuery.Close;
ADOQuery.SQL.Text:=Memo1.Lines.Text;
try
ADOQuery.Open;
except
Messagedlg('查询失败!',mtwarning,[mbok],0);
end;

end;

procedure TfrmDataSetDefine.Memo1DragOver(Sender, Source: TObject;
X,
Y: Integer;
State: TDragState;
var Accept: Boolean);
begin
Accept:=(Source is TListBox);
end;

procedure TfrmDataSetDefine.Memo1DragDrop(Sender, Source: TObject;
X,
Y: Integer);
var
Str:String;
i:integer;
begin
if TListBox(Source).Name='lbTables' then
begin
Str:='SELECT * FROM '+TListBox(Source).Items[TListBox(Source).ItemIndex];
end
else
if TListBox(Source).Name='lbFields' then
begin
Str:='SELECT ';
for i:=0 to TListBox(Source).Items.Count-1do
if TListBox(Source).Selected then
Str:=Str+TListBox(Source).Items+',';
delete(str,length(str),1);
str:=Str+' FROM '+lbTables.Items[lbTables.ItemIndex];
end;

Memo1.Lines.Text:=str;
end;

end.





 
接受答案了.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
顶部