借花献佛
http://www.delphibbs.com/delphibbs/dispq.asp?LID=1899782
－－－－－－－－－－－－－－－－－－－－－－－－－－以下转自网络
报表动态生成的源代码如下：
1、报表动态生成的类单元：
==================================================================
unit UdmFrAdapter;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
FR_Pars, Db, FR_Class, FR_DSet, FR_DBSet, DbClient, FR_Desgn, FR_RRect,
FR_ChBox, FR_Chart, FR_BarC, FR_Shape, FR_OLE, FR_Rich, FR_E_RTF,
FR_E_HTM, FR_E_CSV, FR_E_TXT, UGrdAdapter, DbGrids, FR_View;
type
TfrDBInfo=class;
TdmFrAdapter=class;
TfrFuncEvent = procedure(const Name: String; p1, p2, p3: Variant;
var Val: String; Adapter: TdmFrAdapter);
TdmFrAdapter = class(TDataModule)
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
function GetfrReport: TfrReport;
function GetfrDBList: TStringList;
function GetfrPValueList: TStringList;
function GetfrFuncList: TStringList;
procedure SetModified(const Value: boolean);
function GetModified: boolean;
function GetTitle: string;
procedure SetTitle(const Value: string);
function GetPreview: TfrPreview;
procedure SetPreview(const Value: TfrPreview);
private { Private declarations }
FOnFunction: TFunctionEvent;
FOnGetValue: TGetPValueEvent;
//free report components
FfrReport : TfrReport;
FfrDBList: TStringList;
FfrPValueList: TStringList;
FfrFuncList: TStringList;
procedure Init;
procedure ClearMem;
procedure InitfrReport;
property frReport: TfrReport read GetfrReport;
property frDBList: TStringList read GetfrDBList;
property frPValueList: TStringList read GetfrPValueList;
property frFuncList: TStringList read GetfrFuncList;
protected
FfrRichObject: TfrRichObject;
FfrShapeObject: TfrShapeObject;
FfrChartObject: TfrChartObject;
FfrOLEObject: TfrOLEObject;
FfrBarCodeObject: TfrBarCodeObject;
FfrCheckBoxObject: TfrCheckBoxObject;
FfrTextExport: TfrTextExport;
FfrRTFExport: TfrRTFExport;
FfrCSVExport: TfrCSVExport ;
FfrHTMExport: TfrHTMExport;
FfrRoundRectObject: TfrRoundRectObject;
FfrCompositeReport: TfrCompositeReport;
FfrDesigner: TfrDesigner;
procedure GetValue(const s: String; var v: Variant);
procedure Func(const Name: String; p1, p2, p3: Variant; var Val: String);
function GetDBByName(aName: string): TDataSet;
public { Public declarations }
//about dataset and datasource
function RegDB(DBName: string; DataSet: TDataSet): boolean; overload;
function RegDB(DBName: string; DataSource: TDataSource): boolean; overload;
function UnregDB(DBName: string): boolean;
function HasDB(DBName: string): boolean;
//about parameters
procedure RegPValue(PName: String; v: Variant);
function UnregPValue(PName: String): boolean;
//about function
procedure RegFunc(Name:string;aFunc: TfrFuncEvent);
function UnregFunc(Name:string): boolean;
procedure LoadFromStream(Stream: TStream);
procedure SaveToStream(Stream: TStream);
procedure LoadFromFile(FName: String);
procedure SaveToFile(FName: String);
procedure LoadDefaultFormat(DBName: array of string);
procedure LoadDBGridFormat(DBGrid: TDBGrid;aGrdInfo: TGrdInfo;
List: TStringList; Const aReportAlignment: TAlignment=taLeftJustify);
procedure DesignReport;
procedure ShowReport;
property OnGetValue: TGetPValueEvent read FOnGetValue write FOnGetValue;
property OnFunction: TFunctionEvent read FOnFunction write FOnFunction;
property Modified: boolean read GetModified write SetModified;
property Title: string read GetTitle write SetTitle;
property Preview: TfrPreview read GetPreview write SetPreview;
end;
TfrDBInfo=class
private { Private declarations }
FOwner: TComponent;
FDBName: string;
FDataSet: TDataSet;
FfrDataSet: TClientDataSet;
FfrDBDataSet: TfrDBDataSet;
FfrUserDataset: TfrUserDataset;
procedure Init;
procedure ClearMem;
procedure SetfrDataSet(const Value: TClientDataSet);
protected
procedure _CopyData(Src: TDataSet; Des: TClientDataSet);
public { Public declarations }
constructor Create(Owner: TComponent;DBName: string; DataSet: TDataSet);
destructor Destroy;reintroduce; override;
property frDataSet: TClientDataSet read FfrDataSet write SetfrDataSet;
end;
//var
// dmFrAdapter: TdmFrAdapter;
implementation
const
cnFmtValue='%s=%s';
cnFmtfrDBDataSet='fr_%s';
cnFmtParam='[%s]';
cnFmtField='[%s."%s"]';
cnFmtEmployeeName='制表人：[%s]';
cnPName_Title='ReportTitle';
cnPName_CoName='CoName';
cnPName_StruName='StruName';
cnPName_EmployeeName='EmployeeName';
cnPName_UserName='UserName';
cnFontName_Default='宋体';
cnFontSize_DefaultTitle=9;
cnFontColor_Default=clBlack;
cnValue_PageInfo='第[PAGE#]页/共[TOTALPAGES]页';
cnValue_ReportTitle='[ReportTitle]';
{$R *.DFM}
{ TdmFrAdapter }
procedure TdmFrAdapter.ClearMem;
var
i: integer;
aObj: TObject;
begin
if Assigned(FfrReport) then begin
FfrReport.Free;
FfrReport := nil;
end;
if Assigned(FfrDBList) then begin
for i:= 0 to FfrDBList.Count-1 do begin
aObj := FfrDBList.Objects
;
if Assigned(aObj) then
aObj.Free;
end;
FfrDBList.Free;
FfrDBList := nil;
end;
if Assigned(FfrPValueList) then begin
FfrPValueList.Free;
FfrPValueList := nil;
end;
if Assigned(FfrFuncList) then begin
FfrFuncList.Free;
FfrFuncList := nil;
end;
if Assigned(FfrRichObject) then begin
FfrRichObject.Free;
FfrRichObject := nil;
end;
if Assigned(FfrShapeObject) then begin
FfrShapeObject.Free;
FfrShapeObject := nil;
end;
if Assigned(FfrChartObject) then begin
FfrChartObject.Free;
FfrChartObject := nil;
end;
if Assigned(FfrOLEObject) then begin
FfrOLEObject.Free;
FfrOLEObject := nil;
end;
if Assigned(FfrBarCodeObject) then begin
FfrBarCodeObject.Free;
FfrBarCodeObject := nil;
end;
if Assigned(FfrCheckBoxObject) then begin
FfrCheckBoxObject.Free;
FfrCheckBoxObject := nil;
end;
if Assigned(FfrTextExport) then begin
FfrTextExport.Free;
FfrTextExport := nil;
end;
if Assigned(FfrRTFExport) then begin
FfrRTFExport.Free;
FfrRTFExport := nil;
end;
if Assigned(FfrCSVExport) then begin
FfrCSVExport.Free;
FfrCSVExport := nil;
end;
if Assigned(FfrHTMExport) then begin
FfrHTMExport.Free;
FfrHTMExport := nil;
end;
if Assigned(FfrRoundRectObject) then begin
FfrRoundRectObject.Free;
FfrRoundRectObject := nil;
end;
if Assigned(FfrCompositeReport) then begin
FfrCompositeReport.Free;
FfrCompositeReport := nil;
end;
if Assigned(FfrDesigner) then begin
FfrDesigner.Free;
FfrDesigner := nil;
end;
end;
procedure TdmFrAdapter.Init;
begin
FOnFunction := nil;
FOnGetValue := nil;
FfrReport := nil;
FfrDBList := nil;
FfrPValueList := nil;
FfrFuncList := nil;
FfrRichObject := nil;
FfrShapeObject := nil;
FfrChartObject := nil;
FfrOLEObject := nil;
FfrBarCodeObject := nil;
FfrCheckBoxObject := nil;
FfrTextExport := nil;
FfrRTFExport := nil;
FfrCSVExport := nil;
FfrHTMExport := nil;
FfrHTMExport := nil;
FfrRoundRectObject := nil;
FfrCompositeReport := nil;
FfrDesigner := nil;
end;
function TdmFrAdapter.RegDB(DBName: string; DataSet: TDataSet): boolean;
var
iIndex: integer;
afrDBInfo: TfrDBInfo;
begin
Result := False;
if not Assigned(DataSet) then
Exit;
if not DataSet.Active then
Exit;
DBName := Trim(DBName);
iIndex := frDBList.IndexOf(DBName);
if iIndex>=0 then begin
afrDBInfo := frDBList.Objects[iIndex] as TfrDBInfo;
if Assigned(afrDBInfo) then begin
afrDBInfo.Free;
end;
end;
afrDBInfo := TfrDBInfo.Create(Self, DBName, DataSet);
frDBList.AddObject(DBName, afrDBInfo);
Result := True;
end;
procedure TdmFrAdapter.RegFunc(Name: string; aFunc: TfrFuncEvent);
var
iIndex: integer;
begin
Name := Trim(Name);
iIndex := frFuncList.IndexOf(Name);
if iIndex<0 then
frFuncList.AddObject(Name, @aFunc)
else
frPValueList.Objects[iIndex] := @aFunc;
end;
procedure TdmFrAdapter.RegPValue(PName: String; v: Variant);
var
iIndex: integer;
begin
PName := Trim(PName);
iIndex := frPValueList.IndexOfName(PName);
if iIndex<0 then
frPValueList.Add(Format(cnFmtValue,[PName, v]))
else
frPValueList.Strings[iIndex] := Format(cnFmtValue,[PName, v]);
end;
function TdmFrAdapter.UnregDB(DBName: string): boolean;
var
iIndex: integer;
aObj: TObject;
begin
Result := False;
DBName := Trim(DBName);
iIndex := frDBList.IndexOf(DBName);
if iIndex<0 then
Exit;
aObj := frDBList.Objects[iIndex];
if Assigned(aObj) then
aObj.Free;
frDBList.Delete(iIndex);
end;
function TdmFrAdapter.UnregFunc(Name: string): boolean;
var
iIndex: integer;
begin
Result := False;
Name := Trim(Name);
iIndex := frFuncList.IndexOf(Name);
if iIndex<0 then
Exit;
frFuncList.Delete(iIndex);
Result := True;
end;
function TdmFrAdapter.UnregPValue(PName: String): boolean;
var
iIndex: integer;
begin
Result := False;
PName := Trim(PName);
iIndex := frPValueList.IndexOfName(PName);
if iIndex<0 then
Exit;
frPValueList.Delete(iIndex);
end;
procedure TdmFrAdapter.DataModuleCreate(Sender: TObject);
begin
Init;
end;
procedure TdmFrAdapter.DataModuleDestroy(Sender: TObject);
begin
ClearMem;
end;
function TdmFrAdapter.GetfrReport: TfrReport;
begin
if not Assigned(FfrReport) then begin
FfrReport := TfrReport.Create(Self);
FfrReport.OnGetValue := GetValue;
FfrReport.OnUserFunction := Func;
InitfrReport;
end;
Result := FfrReport;
end;
function TdmFrAdapter.RegDB(DBName: string;
DataSource: TDataSource): boolean;
var
iIndex: integer;
afrDBInfo: TfrDBInfo;
begin
Result := False;
if not Assigned(DataSource) then
Exit;
if not Assigned(DataSource.DataSet) then
Exit;
if not DataSource.DataSet.Active then
Exit;
DBName := Trim(DBName);
iIndex := frDBList.IndexOf(DBName);
if iIndex>=0 then begin
afrDBInfo := frDBList.Objects[iIndex] as TfrDBInfo;
if Assigned(afrDBInfo) then begin
afrDBInfo.Free;
end;
end;
afrDBInfo := TfrDBInfo.Create(Self, DBName, DataSource.DataSet);
frDBList.AddObject(DBName, afrDBInfo);
Result := True;
end;
function TdmFrAdapter.GetfrDBList: TStringList;
begin
if not Assigned(FfrDBList) then
FfrDBList := TStringList.Create;
Result := FfrDBList;
end;
function TdmFrAdapter.HasDB(DBName: string): boolean;
begin
Result := frDBList.IndexOf(Trim(DBName))>=0;
end;
function TdmFrAdapter.GetfrPValueList: TStringList;
begin
if not Assigned(FfrPValueList) then
FfrPValueList := TStringList.Create;
Result := FfrPValueList;
end;
procedure TdmFrAdapter.DesignReport;
begin
frReport.DesignReport;
end;
procedure TdmFrAdapter.LoadFromFile(FName: String);
begin
frReport.LoadFromFile(FName);
end;
procedure TdmFrAdapter.LoadFromStream(Stream: TStream);
begin
frReport.LoadFromStream(Stream);
end;
procedure TdmFrAdapter.SaveToFile(FName: String);
begin
frReport.SaveToFile(FName);
end;
procedure TdmFrAdapter.SaveToStream(Stream: TStream);
begin
frReport.SaveToStream(Stream);
end;
procedure TdmFrAdapter.ShowReport;
begin
frReport.ShowReport;
end;
function TdmFrAdapter.GetfrFuncList: TStringList;
begin
if not Assigned(FfrFuncList) then
FfrFuncList := TStringList.Create;
Result := FfrFuncList;
end;
procedure TdmFrAdapter.GetValue(const s: String; var v: Variant);
var
iIndex: integer;
begin
if Assigned(FfrPValueList) then begin
iIndex := frPValueList.IndexOfName(s);
if iIndex>=0 then
v := frPValueList.Values;
end;
if Assigned(FOnGetValue) then
FOnGetValue(s, v);
end;
procedure TdmFrAdapter.Func(const Name: String; p1, p2, p3: Variant;
var Val: String);
var
iIndex: integer;
aFunction : TFunctionEvent;
begin
if Assigned(FfrFuncList) then begin
iIndex := frFuncList.IndexOf(Name);
if iIndex>=0 then begin
aFunction := nil;
@aFunction := frFuncList.Objects[iIndex];
if Assigned(aFunction) then begin
aFunction(Name, p1, p2, p3, Val);
Exit;
end;
end;
end;
if Assigned(FOnFunction) then
FOnFunction(Name, p1, p2, p3, Val);
end;
procedure TdmFrAdapter.InitfrReport;
begin
if not Assigned(FfrRichObject) then
FfrRichObject := TfrRichObject.Create(Self);
if not Assigned(FfrShapeObject) then
FfrShapeObject := TfrShapeObject.Create(Self);
if not Assigned(FfrChartObject) then
FfrChartObject := TfrChartObject.Create(Self);
if not Assigned(FfrOLEObject) then
FfrOLEObject := TfrOLEObject.Create(Self);
if not Assigned(FfrBarCodeObject) then
FfrBarCodeObject := TfrBarCodeObject.Create(Self);
if not Assigned(FfrCheckBoxObject) then
FfrCheckBoxObject := TfrCheckBoxObject.Create(Self);
if not Assigned(FfrTextExport) then
FfrTextExport := TfrTextExport.Create(Self);
if not Assigned(FfrRTFExport) then
FfrRTFExport := TfrRTFExport.Create(Self);
if not Assigned(FfrCSVExport) then
FfrCSVExport := TfrCSVExport.Create(Self);
if not Assigned(FfrHTMExport) then
FfrHTMExport := TfrHTMExport.Create(Self);
if not Assigned(FfrRoundRectObject) then
FfrRoundRectObject := TfrRoundRectObject.Create(Self);
if not Assigned(FfrCompositeReport) then
FfrCompositeReport := TfrCompositeReport.Create(Self);
if not Assigned(FfrDesigner) then
FfrDesigner := TfrDesigner.Create(Self);
end;
procedure TdmFrAdapter.SetModified(const Value: boolean);
begin
if Assigned(frDesigner) then
frDesigner.Modified := Value;
end;
function TdmFrAdapter.GetModified: boolean;
begin
if Assigned(frDesigner) then
Result := frDesigner.Modified
else
Result := False;
end;
procedure TdmFrAdapter.LoadDefaultFormat(DBName: array of string);
const
cnDefaultTitleFontStyle=fsBold;
var
aPage: TfrPage;
aBand: TfrBandView;
aView: TfrView;
i, j, iBandPos, iMemoPos: integer;
sDBName: string;
aDB: TDataSet;
aField: TField;
begin
// create page
with frReport do begin
Pages.Clear;
Pages.Add;
aPage := Pages[0];
end;
//report title
aBand := TfrBandView(frCreateObject(gtBand, ''));
aBand.SetBounds(0, 48, 752, 28);
aBand.BandType := btReportTitle;
aPage.Objects.Add(aBand);
aView :=frCreateObject(gtMemo, '');
aView.SetBounds(28, 52, 712, 20);
aView.Memo.Add(Format(cnFmtParam,[cnPName_Title]));
aPage.Objects.Add(aView);
TfrMemoView(aView).Font.Name := cnFontName_Default;
TfrMemoView(aView).Font.Size := cnFontSize_DefaultTitle;
TfrMemoView(aView).Font.Color := cnFontColor_Default;
TfrMemoView(aView).Font.Style := [cnDefaultTitleFontStyle];
iBandPos := 0;
for i := Low(DBName) to High(DBName) do begin
sDBName := DBName;
if i = Low(DBName) then begin //page header
aBand := TfrBandView(frCreateObject(gtBand, ''));
aBand.SetBounds(0,116, 752, 32);
aBand.BandType := btPageHeader;
aPage.Objects.Add(aBand);
aDB := GetDBByName(sDBName);
if not Assigned(aDB) then
Continue;
iMemoPos := 25;
for j:= 0 to aDB.FieldCount-1 do begin
aField := aDB.Fields[j];
if not Assigned(aField) then
Continue;
if not aField.Visible then
Continue;
aView :=frCreateObject(gtMemo, '');
aView.SetBounds(iMemoPos, 120, 50, 20);
aView.Memo.Add(aField.DisplayLabel);
aPage.Objects.Add(aView);
iMemoPos := iMemoPos + 55;
if iMemoPos>700 then
iMemoPos := 700;
end;
iBandPos := 116;
end;
iBandPos := iBandPos + 80;
aBand := TfrBandView(frCreateObject(gtBand, ''));
aBand.SetBounds(0,iBandPos, 752, 32);
aBand.BandType := btMasterData;
aPage.Objects.Add(aBand);
aBand.DataSet := Format(cnFmtfrDBDataSet,[sDBName]);
aDB := GetDBByName(sDBName);
if not Assigned(aDB) then
Continue;
iMemoPos := 25;
for j:= 0 to aDB.FieldCount-1 do begin
aField := aDB.Fields[j];
if not Assigned(aField) then
Continue;
if not aField.Visible then
Continue;
aView :=frCreateObject(gtMemo, '');
aView.SetBounds(iMemoPos, iBandPos+4, 50, 20);
aView.Memo.Add(Format(cnFmtField,[sDBName, aField.FieldName]));
aPage.Objects.Add(aView);
iMemoPos := iMemoPos + 55;
if iMemoPos>700 then
iMemoPos := 700;
end;
end;
end;
function TdmFrAdapter.GetDBByName(aName: string): TDataSet;
var
iIndex: integer;
afrDBInfo: TfrDBInfo;
begin
Result := nil;
aName := Trim(aName);
if aName='' then
Exit;
iIndex := frDBList.IndexOf(aName);
if iIndex<0 then
Exit;
afrDBInfo := frDBList.Objects[iIndex] as TfrDBInfo;
if Assigned(afrDBInfo) then
Result := afrDBInfo.frDataSet;
end;
function TdmFrAdapter.GetTitle: string;
begin
Result := frReport.Title;
end;
procedure TdmFrAdapter.SetTitle(const Value: string);
begin
frReport.Title := Value;
end;
procedure TdmFrAdapter.LoadDBGridFormat(DBGrid: TDBGrid; aGrdInfo: TGrdInfo;
List: TStringList; Const aReportAlignment: TAlignment=taLeftJustify);
procedure SetBit(var w: Word; e: Boolean; m: Integer);
begin
if e then w := w or m
else w := w and not m;
end;
const
cnAlias_DBGridDB='GridDB';
CNLeftOffSet=12;
CNPageWidth=752;
var
iIndex, i, iLen, iTotWidth: integer;
iLeftOffset: integer;
iPageCount, iPageIndex: Integer;
aPage: TfrPage;
aBand: TfrBandView;
aView: TfrView;
begin
if not UGrdAdapter.ChkDBGrid(DBGrid) then
Exit;
if not Assigned(List) then
Exit;
//registe db
Self.RegDB(cnAlias_DBGridDB, DBGrid.DataSource);
//modified report title
iIndex := frPValueList.IndexOfName(cnPName_Title);
if iIndex<0 then
Self.RegPValue(cnPName_Title, aGrdInfo.Title)
else
frPValueList.Strings[iIndex] := Format(cnFmtValue,
[cnPName_Title, aGrdInfo.Title]);
// create page
with frReport do begin
Pages.Clear;
Pages.Add;
aPage := Pages[0];
end;
//calculate left offset
iLen:=0;
for i:=0 to dbgrid.Columns.Count-1 do
begin
iLen:=iLen+dbgrid.Columns.Width;
end;
iTotWidth:=iLen;
if iTotWidth>=CNPageWidth then
begin
//多页就只用左对奇
iLeftOffset:=CNLeftOffSet;
iPageCount:=(iTotWidth div CNPageWidth)+1;
while frReport.Pages.Count<iPageCount do
frReport.Pages.Add;
end
else
begin
case aReportAlignment of
taLeftJustify:
begin
iLeftOffset:=CNLeftOffSet;
end;
taRightJustify:
begin
iLeftOffset:=CNPageWidth-iTotWidth - CNLeftOffSet * 2;
end;
taCenter:
begin
iLeftOffset:=(CNPageWidth-iTotWidth) div 2 ;
end;
end;
end;
//create report format
iLen:=0;
iPageIndex:=0;
aPage:=frReport.Pages[iPageIndex];
//Master Header band
aBand := TfrBandView(frCreateObject(gtBand, ''));
aBand.SetBounds(0, 136, CNPageWidth, 18);
aBand.BandType := btMasterHeader;
aPage.Objects.Add(aBand);
for i:=0 to DBGrid.Columns.Count-1 do
begin
if DBGrid.Columns.Width>CNPageWidth then
begin
Messagedlg(DBGrid.Columns.Title.Caption+'列太宽了！无法在一页里打印出来，请拉小一点。
',mtwarning,[mbok],0);
Exit;
end;
iLen:=iLen+DBGrid.Columns.Width;
if iLen>CNPageWidth then
begin
//跳转到下 1 页
iPageIndex:=iPageIndex+1;
if iPageIndex>frReport.Pages.Count-1 then
frReport.Pages.Add;
aPage:=frReport.Pages[iPageIndex];
iLen:=DBGrid.Columns.Width;
//Master Header band
aBand := TfrBandView(frCreateObject(gtBand, ''));
aBand.SetBounds(0, 136, CNPageWidth, 18);
aBand.BandType := btMasterHeader;
aPage.Objects.Add(aBand);
end;
//ReportTitle information
aView :=frCreateObject(gtMemo, '');
aView.SetBounds(iLeftOffset+iLen-DBGrid.Columns.Width, 136, DBGrid.Columns.Width,
18);
aView.Memo.Add(DBGrid.Columns.Title.Caption);//='[%s."%s"]'
; //[GridDB."EmpNo"]
aPage.Objects.Add(aView);
//set font
TfrMemoView(aView).Font.Name := cnFontName_Default;
TfrMemoView(aView).Font.Size := cnFontSize_DefaultTitle;
TfrMemoView(aView).Font.Color := cnFontColor_Default;
TfrMemoView(aView).Font.Style := [];
//Set Bit
SetBit(TfrView(aView).FrameTyp, True, 8);
SetBit(TfrView(aView).FrameTyp, True, 4);
SetBit(TfrView(aView).FrameTyp, True, 2);
SetBit(TfrView(aView).FrameTyp, True, 1);
case DBGrid.Columns.Alignment of
taLeftJustify:
begin
end;
taRightJustify:
begin
TfrMemoView(aView).Adjust := (TfrMemoView(aView).Adjust and $FC) + 1;
end;
taCenter:
begin
TfrMemoView(aView).Adjust := (TfrMemoView(aView).Adjust and $FC) + 2;
end;
end;
end;
iLen:=0;
iPageIndex:=0;
aPage:=frReport.Pages[iPageIndex];
//Master Data band
aBand := TfrBandView(frCreateObject(gtBand, ''));
aBand.SetBounds(0, 180, CNPageWidth, 18);
aBand.BandType := btMasterData;
aBand.DataSet:= Format(cnFmtfrDBDataSet,[cnAlias_DBGridDB]);
aPage.Objects.Add(aBand);
for i:=0 to DBGrid.Columns.Count-1 do
begin
iLen:=iLen+DBGrid.Columns.Width;
if iLen>CNPageWidth then
begin
//跳转到下 1 页
iPageIndex:=iPageIndex+1;
if iPageIndex>frReport.Pages.Count-1 then
frReport.Pages.Add;
aPage:=frReport.Pages[iPageIndex];
iLen:=DBGrid.Columns.Width;
//Master Data band
aBand := TfrBandView(frCreateObject(gtBand, ''));
aBand.SetBounds(0, 180, CNPageWidth, 18);
aBand.BandType := btMasterData;
aBand.DataSet:= Format(cnFmtfrDBDataSet,[cnAlias_DBGridDB]);
aPage.Objects.Add(aBand);
end;
//ReportTitle information
aView :=frCreateObject(gtMemo, '');
aView.SetBounds(iLeftOffset+iLen-DBGrid.Columns.Width, 180, DBGrid.Columns.Width,
18);
aView.Memo.Add(Format(cnFmtField,[cnAlias_DBGridDB,DBGrid.Columns.FieldName]));//='[%s."%s"]
'; //[GridDB."EmpNo"]
aPage.Objects.Add(aView);
//set font
TfrMemoView(aView).Font.Name := cnFontName_Default;
TfrMemoView(aView).Font.Size := cnFontSize_DefaultTitle;
TfrMemoView(aView).Font.Color := cnFontColor_Default;
TfrMemoView(aView).Font.Style := [];
case DBGrid.Columns.Alignment of
taLeftJustify:
begin
end;
taRightJustify:
begin
TfrMemoView(aView).Adjust := (TfrMemoView(aView).Adjust and $FC) + 1;
end;
taCenter:
begin
TfrMemoView(aView).Adjust := (TfrMemoView(aView).Adjust and $FC) + 2;
end;
end;
//Set Bit
SetBit(TfrView(aView).FrameTyp, True, 8);
SetBit(TfrView(aView).FrameTyp, True, 4);
SetBit(TfrView(aView).FrameTyp, True, 2);
SetBit(TfrView(aView).FrameTyp, True, 1);
end;
iPageIndex:=0;
while iPageIndex<frReport.Pages.Count do
begin
aPage:=frReport.Pages[iPageIndex];
//report title band
aBand := TfrBandView(frCreateObject(gtBand, ''));
aBand.SetBounds(0, 28, CNPageWidth, 80);
aBand.BandType := btReportTitle;
aPage.Objects.Add(aBand);
//company name
//
aView :=frCreateObject(gtMemo, '');
aView.SetBounds(20, 40, 504, 15);
aView.Memo.Add(Format(cnFmtParam,[cnPName_CoName]));
aPage.Objects.Add(aView);
//set font
TfrMemoView(aView).Font.Name := cnFontName_Default;
TfrMemoView(aView).Font.Size := cnFontSize_DefaultTitle;
TfrMemoView(aView).Font.Color := cnFontColor_Default;
TfrMemoView(aView).Font.Style := [fsItalic];
//draw frame
SetBit(TfrView(aView).FrameTyp, True, $2);
//page information
//
aView :=frCreateObject(gtMemo, '');
aView.SetBounds(516, 40, 216, 15);
aView.Memo.Add(cnValue_PageInfo);
aPage.Objects.Add(aView);
//set font
TfrMemoView(aView).Font.Name := cnFontName_Default;
TfrMemoView(aView).Font.Size := cnFontSize_DefaultTitle;
TfrMemoView(aView).Font.Color := cnFontColor_Default;
TfrMemoView(aView).Font.Style := [fsItalic];
//draw frame & set Aliagnment
SetBit(TfrView(aView).FrameTyp, True, $2);
TfrMemoView(aView).Adjust := (TfrMemoView(aView).Adjust and $FC) + 1;
//ReportTitle information
//
aView :=frCreateObject(gtMemo, '');
aView.SetBounds(0, 72, CNPageWidth, 18);
aView.Memo.Add(cnValue_ReportTitle);
aPage.Objects.Add(aView);
//set font
TfrMemoView(aView).Font.Name := cnFontName_Default;
TfrMemoView(aView).Font.Size := cnFontSize_DefaultTitle;
TfrMemoView(aView).Font.Color := cnFontColor_Default;
TfrMemoView(aView).Font.Style := [];
//draw frame
//SetBit(TfrView(aView).FrameTyp, True, $3);
//set Aliagnment
TfrMemoView(aView).Adjust := (TfrMemoView(aView).Adjust and $FC) + 2;
//Builder date
aView :=frCreateObject(gtMemo, '');
aView.SetBounds(iLeftOffset, 88, CNPageWidth, 18);
aView.Memo.Add('[DATE]');
aPage.Objects.Add(aView);
//set font
TfrMemoView(aView).Font.Name := cnFontName_Default;
TfrMemoView(aView).Font.Size := cnFontSize_DefaultTitle;
TfrMemoView(aView).Font.Color := cnFontColor_Default;
TfrMemoView(aView).Font.Style := [];
//report Master footer band
aBand := TfrBandView(frCreateObject(gtBand, ''));
aBand.SetBounds(0, 224, CNPageWidth, 18);
aBand.BandType := btMasterFooter;
aPage.Objects.Add(aBand);
//User name
//
aView :=frCreateObject(gtMemo, '');
aView.SetBounds(iLeftOffset, 224, CNPageWidth, 18);
aView.Memo.Add(Format(cnFmtEmployeeName,[cnPName_EmployeeName]));
aPage.Objects.Add(aView);
//set font
TfrMemoView(aView).Font.Name := cnFontName_Default;
TfrMemoView(aView).Font.Size := cnFontSize_DefaultTitle;
TfrMemoView(aView).Font.Color := cnFontColor_Default;
TfrMemoView(aView).Font.Style := [];
iPageIndex:=iPageIndex+1;
end;
end;
function TdmFrAdapter.GetPreview: TfrPreview;
begin
Result := frReport.Preview;
end;
procedure TdmFrAdapter.SetPreview(const Value: TfrPreview);
begin
frReport.Preview := Value;
end;
{ TfrDBInfo }
procedure TfrDBInfo.ClearMem;
begin
if Assigned(FfrDataSet) then begin
FfrDataSet.Free;
FfrDataSet := nil;
end;
if Assigned(FfrDBDataSet) then begin
FfrDBDataSet.Free;
FfrDBDataSet := nil;
end;
if Assigned(FfrUserDataset) then begin
FfrUserDataset.Free;
FfrUserDataset := nil;
end;
end;
constructor TfrDBInfo.Create(Owner: TComponent; DBName: string;
DataSet: TDataSet);
// cnFmtfrUserDataset='frUser_%s';
begin
Init;
FOwner := Owner;
FDBName := DBName;
FDataSet := DataSet;
FfrDataSet := TClientDataSet.Create(FOwner);
FfrDataSet.Name := FDBName;
_CopyData(FDataSet, FfrDataSet);
// FfrDataSet.Assign(FDataSet);
FfrDBDataSet := TfrDBDataSet.Create(FOwner);
FfrDBDataSet.Name := Format(cnFmtfrDBDataSet, [FDBName]);
FfrDBDataSet.DataSet := FfrDataSet ;
// FfrUserDataset := TfrUserDataset.Create(FOwner);
// FfrUserDataset.Name := Format(cnFmtfrUserDataset, [FDBName]);
end;
destructor TfrDBInfo.Destroy;
begin
inherited;
ClearMem;
end;
procedure TfrDBInfo.Init;
begin
FOwner := nil;
FDBName := '';
FDataSet := nil;
FfrDataSet := nil;
FfrDBDataSet := nil;
FfrUserDataset := nil;
end;
procedure TfrDBInfo.SetfrDataSet(const Value: TClientDataSet);
begin
FfrDataSet := Value;
end;
procedure TfrDBInfo._CopyData(Src: TDataSet; Des: TClientDataSet);
var
i: integer;
aDefs: TFieldDef;
bmSrc : TBookmark;
FBeforeScroll, FAfterScroll: TDataSetNotifyEvent;
begin
Des.Close;
Des.FieldDefs.Assign(Src.FieldDefs);
for i := 0 to Des.FieldDefs.Count-1 do begin
aDefs := Des.FieldDefs;
aDefs.Attributes := aDefs.Attributes-[faReadonly];
if aDefs.DataType = ftAutoInc then
aDefs.DataType := ftInteger;
end;
Des.CreateDataSet;
//copy display label
for i := 0 to Des.FieldCount-1 do
// Des.Fields.DisplayLabel := Src.Fields.DisplayLabel;
//modified by gsh; date: 2003/05/28
Des.Fields.DisplayLabel :=
Src.FieldByName(Des.Fields.FieldName).DisplayLabel;
bmSrc := Src.GetBookmark;
FBeforeScroll := Src.BeforeScroll;
FAfterScroll := Src.AfterScroll;
Src.DisableControls;
try
with Src do begin
BeforeScroll := nil;
AfterScroll := nil;
First;
while not Eof do begin
Des.Append;
for i := 0 to FieldCount - 1 do
Des.FieldByName(Fields.FieldName).Assign(Fields);
Des.Post;
Next;
end;
end;
finally
Src.EnableControls;
Src.GotoBookmark(bmSrc);
System.FreeMem(bmSrc);
Src.BeforeScroll := FBeforeScroll;
Src.AfterScroll := FAfterScroll;
end;
Des.First;
end;
end.
===========================================================
2、调用示例：
var
aAdapter: TdmFrAdapter;
aGrdInfo: TGrdInfo;
aColList: TStringList;
begin
aAdapter := TdmFrAdapter.Create(nil);
aColList := TStringList.Create;
try
//initialize adapter parameter
aAdapter.RegPValue('CoName','上海XXXXXXXXXXXXXX公司'); //company name
aAdapter.RegPValue('StruName','软件研发部'); //department name
aAdapter.RegPValue('EmployeeName','大虾'); //employee name
aAdapter.RegPValue('UserName','Delphilai'); //user name
// set grid information
aGrdInfo.Title := '111';
aGrdInfo.Memo := 'ata';
aGrdInfo.HideZero := False;
aGrdInfo.Align := gaLeft;
aGrdInfo.Tag := 0;
//get grid column information
GetGrdColInfo(DBGrid1, aColList);
//load DBGrid report format 就是左右中对起格式拉
case StrToInt(Edit1.Text)of
1:aAdapter.LoadDBGridFormat(DBGrid1, aGrdInfo, aColList, taLeftJustify);
2:aAdapter.LoadDBGridFormat(DBGrid1, aGrdInfo, aColList, taRightJustify);
3:aAdapter.LoadDBGridFormat(DBGrid1, aGrdInfo, aColList, taCenter);
end;
aAdapter.DesignReport;
//或者用下面代码(TfrmDBGridPreview是你的自定义的预览窗体):
// aAdapter.Preview := TfrmDBGridPreview.Create(nil).frPreview;
// (aAdapter.Preview.Parent as TCustomForm).Show;
// aAdapter.ShowReport;
finally
//free resource
FreeGrdColInfo(aColList);
aAdapter.Free;
aColList.Free;
end;
end;