unit ReportClass;
interface
uses CommonForm, SysUtils, Classes, Forms, Dialogs, DB, Controls, Grids, ComCtrls,
FR_DBSet, FR_Class, Printers, FR_Utils, FR_Pars, DBGrids, IniFiles, Variants,
TypInfo;
type
TReport = class
private
FDatasetArray: array of TDataset;
FRDataset: array of TfrDBDataset;
FrmCommon: TfrmCommon; //设置窗体
FReport: TfrReport; //报表对象
FPage: TfrPage; //页面对象
FVariants: TfrVariables; //报表的数据字典变量
FVariantList: TStrings; //变量列表
FGridFields: TStrings; //表格的字段=标签
FGridWidths: TStrings; //表格的字段=宽度
FGridRowHeight: integer; //表格行高
FGrid: TCustomGrid; //表格名称
FTitleMemo: TfrMemoView; //标题头文本框
FTitleDate: TfrmemoView; //标题日期文本框
FPrintReportDate: Boolean; //是否打印页头日期
FOrientation: Boolean; //报表打印方向
FPrintPageNumber: Boolean; //是否打印页码
FHeaderFields: TStrings; //页头字段列表
FDetailFields: TStrings; //明细字段列表
FFooterFields: Tstrings; //页脚字段列表
INIFile: TINIFile;
FFileName: string; //报表的文件名
FDetailSourceType: string; //报表数据源类型（'TDBGrid'或'TDataset'）
FReportName: string; //在INI文件中小节的报表的名称
procedure ShowData;
function GetVariant: TStrings;
procedure SetVariants(const Value: TStrings);
protected
function GetReportTitle: string;
procedure SetReportTitle(value: string);
function GetOrientation: Boolean;
procedure SetOrientation(value: Boolean);
function GetPrintReportDate: Boolean;
procedure SetPrintReportDate(value: Boolean);
function GetPrintPageNumber: Boolean;
procedure SetPrintPageNumber(value: Boolean);
function GetHeaderFields: TStrings;
procedure SetHeaderFields(const Value: TStrings);
function GetFooterFields: TStrings;
procedure SetFooterFields(const Value: TStrings);
function GetDetailFields: TStrings;
procedure SetDetailFields(const Value: TStrings);
function GetFileName: string;
procedure SetFileName(const Value: string);
function GetGrid: TCustomGrid;
procedure SetGrid(const Grid: TCustomGrid);
public
constructor Create;
destructor Destroy; override;
procedure Preview; overload;
procedure Preview(FileName: string); overload;
procedure Design; overload;
procedure Design(FileName: string); overload;
procedure SetMemoView(MemoView: TfrMemoView; //设置文本框属性
Alignment: integer; //Alignment：文本对齐方式，frtaCenter表示居中对齐
FrameTyp: word); //FrameTyp：边框样式，0：无边框；15：有边框
function FindBandView(BandType: TfrBandType): TfrBandView; //根据BandView类型返回TfrBandview
function FindMemoView(Text: string; var CompNo: integer): TfrMemoView; //根据MemoView的文本返回TfrMemoView和序号
function ShowFieldListForm: Boolean;
procedure SaveFieldList(ReportName: string); //存储字段列表到报表配置文件中
procedure LoadFieldList(ReportName: string); //从配置文件中调用字段列表
procedure SetDataset(Datasets: array of TDataset);
published
property Title: string read GetReportTitle write SetReportTitle; //报表标题
property PrintPageNumber: Boolean read GetPrintPageNumber write SetPrintpageNumber default false; //是否打印报表页码
property PrintReportDate: Boolean read GetPrintReportDate write SetPrintReportDate default true; //是否打印报表日期
property Orientation: Boolean read GetOrientation write SetOrientation default true; //页面默认为纵向
property HeaderFields: TStrings read GetHeaderFields write SetHeaderFields; //页头上要打印的字段列表
property DetailFields: TStrings read GetDetailFields write SetDetailFields; //明细字体列表
property FooterFields: TStrings read GetFooterFields write SetFooterFields; //页脚上要打印的字段列表
property FileName: string read GetFileName write SetFileName;
property DetailSourceType: string read FDetailSourceType write FDetailSourceType; //明细数据源是'TDBGrid'还是'TDataset'
property Grid: TCustomGrid read GetGrid write SetGrid;
property Variants: TStrings read GetVariant write SetVariants; //报表数据字典中的变量
end;
implementation
{ TReport }
constructor ;
var
band: TfrBandView;
AppPath: string;
begin
inherited;
FHeaderFields := ; //标题字段列表
FDetailFields := ; //明细字段列表
FFooterFields := ; //页脚字段列表
FGridFields := ; //表格字段列表
FGridWidths := ; //表格字段宽度列表
FPrintReportDate := true; //默认打印报表日期
FOrientation := true;
FReport := (nil); //建立报表
//建立页面
;
;
FPage := [0];
FVariants := ;
FVariantList := ;
Band := ; //建立标题条
(tbbLeft, tbbTop, tbbWidth, tbbHeight); //条位置
:= btReportTitle; //条类型
(Band);
FTitleMemo := ; //建立标题文本
(tmbLeft, tmbTop, tmbWidth, tmbHeight);
:= baCenter; //文本框居中
['Alignment'] := frtaCenter or frtaMiddle; //文本的对齐方式(垂直居中)
[''] := 2;
[''] := mvFontName;
[''] := 14;
(FTitleMemo);
FPrintReportDate := true;
SetPrintReportDate(FPrintReportDate);
frmCommon := (nil);
AppPath := ExtractFilePath() + 'Reports/';
if not DirectoryExists(AppPath) then CreateDir(AppPath);
INIFile := (AppPath + '');
end;
destructor ;
begin
FreeAndNil(INIFile);
FreeAndNil(FHeaderFields);
FreeAndNil(FFooterFields);
FreeAndNil(FDetailFields);
FreeAndNil(FGridWidths);
FreeAndNil(FGridFields);
FreeAndNil(frmCommon);
FreeAndNil(FVariantList);
FreeAndNil(FVariants);
FreeAndNil(FReport);
FDatasetArray := nil;
inherited;
end;
function : string;
begin
result :=
end;
procedure (value: string);
begin
:= value;
:= value;
end;
function : Boolean;
begin
result := FOrientation;
end;
procedure (value: Boolean);
begin
FOrientation := value;
if FOrientation then
(, , , , poPortrait) //页面横向
else
(, , , , poLandscape); //页面纵向
(['Width'] - 70, tdbTop, tdbWidth, tdbHeight);
end;
procedure ;
begin
ShowData;
if then
;
end;
procedure (FileName: string);
var
s: string;
begin
s := FileName;
if s = '' then s := FFileName;
if s = '' then exit;
(s);
if then
;
end;
procedure (FileName: string);
var
s: string;
begin
s := FileName;
if s = '' then s := FFileName;
if s = '' then exit;
(s);
if then
;
end;
procedure ;
begin
ShowData;
if then
;
end;
function : Boolean;
begin
result := FPrintReportDate;
end;
procedure (value: Boolean);
var
Blank: integer;
begin
FPrintReportDate := value;
if FPrintReportDate then
begin
FTitleDate := ;
if FOrientation then //如果是纵向打印
Blank := 1480
else
Blank := 1200;
( - Blank, tdbTop, tdbWidth, tdbHeight);
('[Date]');
(FTitleDate);
end;
end;
function : Boolean;
begin
result := FPrintPageNumber;
end;
procedure (value: Boolean);
const
PageNumber = '[PAGE#]/[TOTALPAGES]';
var
mv: TfrMemoView;
Band: TfrBandView;
CompNo: integer;
begin
FPrintPageNumber := value;
Band := FindBandView(btPageFooter);
if band = nil then //如果没有FooterBand，那么新建一个
begin
Band := ;
:= btPageFooter;
(fbbLeft, fbbTop, fbbWidth, fbbHeight);
(Band);
end;
if FPrintPageNumber then //如果打印页码
begin
:= true; //报表只有显示两次才能显示页码
mv := ;
:= PageNumber;
(0, fbbTop, 100, mvHeight);
:= baCenter;
['Alignment'] := frtaMiddle or frtaCenter;
[''] := mvFontName;
[''] := mvFontSize;
(mv);
end
else //如果不打印页码，那么删除已存在的页码文本框
begin
mv := FindMemoView(PageNumber, CompNo);
if mv <> nil then
begin
(CompNo);
;
end;
end;
end;
function (BandType: TfrBandType): TfrBandView;
var
v: TfrBandView;
i: integer;
begin
result := nil;
for i:=0 to -1 do //查找是否有FooterBand
begin
v := [i];
if (('TfrBandView') and (TfrBandView(v).BandType = BandType)) then
begin
result := v;
exit;
end;
end;
end;
function (Text: string; var CompNo: integer): TfrMemoView;
var
i: integer;
v: TfrMemoView;
begin
result := nil;
for i:=0 to -1 do
begin
v := [i];
if (('TfrMemoView') and (TfrMemoView(v). = Text)) then
begin
CompNo := i;
result := v;
exit;
end;
end;
end;
procedure (MemoView: TfrMemoView; Alignment: integer; FrameTyp: word);
begin
if MemoView = nil then exit;
['Alignment'] := frtaMiddle or Alignment; //文本对齐方式(默认为垂直居中)
[''] := mvFontName; //字体名称
[''] := mvFontSize; //字体尺寸
if then
:= FrameTyp; //边框
end;
给打印字段列表赋值/
function : TStrings;
begin
result := FHeaderFields;
end;
procedure (const Value: TStrings);
begin
(value);
end;
function : TStrings;
begin
result := FFooterFields;
end;
procedure (const Value: TStrings);
begin
(value);
end;
/
function : Boolean;
begin
:= HeaderFields;
:= DetailFields;
:= FooterFields;
; //显示报表设置窗体
result := ;
if not then exit; //如果窗体是Cancel方式关闭的
:= ; //返回报表标题
//获得打印字段列表
HeaderFields := ;
DetailFields := ;
FooterFields := ;
if and (FReportName <> '') then //如果保存打印字段列表
SaveFieldList(FReportName);
end;
procedure ;
function AnalyseText(str: string): string;
var
n: integer;
begin
result := '';
n := AnsiPos('.', str);
if n = 0 then exit;
insert('"', str, n+1);
result := str + '"';
end;
function GetDisLabelWidth(FieldName: string): integer; //根据字段名得到字段标签的长度
var
n, i, j: integer;
s: string;
begin
result := 0;
s := Fieldname;
n := AnsiPos('.', s);
if n > 0 then //如果字段名带有表名前缀
begin
Delete(s, 1, n);
end;
if s = '' then exit;
for i:=0 to High(FDatasetArray) do //这个函数没考虑到前缀对应的问题，以后有空改吧
begin
for j:=0 to FDatasetArray[i].FieldCount-1 do
begin
if FDatasetArray[i].Fields[j].FieldName = s then
begin
result := FDatasetArray[i].Fields[j].DisplayWidth * 5; //宽度增加5倍
exit;
end;
end;
end;
end;
var
iCol, iLeft, i, w, h: integer;
mv: TfrMemoView;
Band: TfrBandView;
begin
if > 0 then
begin
iLeft := tmbLeft; //其它字段的位置在打印日期之下
iCol := 1; //第一行
for i:=0 to -1 do
begin
if (i mod 3 = 0) and (i > 0) then //一行只显示三列字段
begin
inc(iCol, 1);
iLeft := tmbLeft;
end;
mv := ;
SetMemoView(mv, frtaLeft, 0);
(iLeft, tdbTop + (tdbHeight + 4) * iCol, 200, mvHeight); //4是上下Memo行之间的间隔
:= [i] + '：['
+ FDatasetArray[0]. + '.' + AnalyseText([i]) + ']';
(mv);
inc(iLeft, 200);
end;
end
else //否则不打印页头上的字段列表
begin
band := FindBandView(btReportTitle);
(tbbLeft, tbbTop, tbbWidth, 60); //缩小条高度
end;
/ 明细 ///
if then
h :=
else
h := ; //得到文本框高度
//页头
Band := ;
(0, PageBandTop, 0, h);
:= btPageHeader;
['OnFirstPage'] := true;
(Band);
Band := ; //主数据条
(0, PageBandTop + DataBandHeight * 2, 0, h);
:= btMasterData;
:= 'frmCommon.' + ; //明细数据条需要一个数据源
(Band);
w := 0;
for i:=0 to -1 do //求出明细文本框居中时的左起点
begin
if then //如果使用表格的字段列表的宽度
w := w + StrToInt([i])
else
w := w + GetDisLabelWidth([i]); //得到数据字段的显示长度
end;
iLeft := (['Width'] - w) div 2;
if iLeft < 32 then iLeft := 32;
for i:=0 to -1 do
begin
mv := ; //标签
SetMemoView(mv, frtaCenter, 15);
if then //如果使用表格的字段列表的宽度
w := StrToInt([i])
else
w := GetDisLabelWidth([i]); //得到数据字段的显示长度
(iLeft, PageBandTop, w, h);
([i]);
(mv);
mv := ; //记录
(iLeft, PageBandTop + DataBandHeight * 2, w, h);
if then //文本框是否有边框
SetMemoView(mv, frtaLeft, 15) //设置文本框属性
else
SetMemoView(mv, frtaLeft, 0);
:= '[' + FDatasetArray[0]. + '.'
+ AnalyseText([i]) + ']';
(mv);
inc(iLeft, w);
end;
if iLeft > ['width'] then //如果文本框超过了页面的长度，
begin
SetOrientation(false); //那么页面自动转为横向打印
(['width'] - tdbWidth - 70, tdbTop, tdbWidth, tdbHeight);
end;
// 页脚
if > 0 then
begin
Band := FindBandView(btReportSummary);
if band = nil then //如果没有FooterBand，那么新建一个
begin
Band := ;
:= btReportSummary;
(rfbLeft, rfbTop, rfbWidth, rfbHeight);
(Band);
end;
iLeft := tmbLeft; //其它字段的位置在打印日期之下
iCol := 0;
for i:=0 to -1 do
begin
if (i mod 3 = 0) and (i > 0) then //一行只显示三列字段
begin
inc(iCol, 1);
iLeft := tmbLeft;
end;
mv := ;
SetMemoView(mv, frtaLeft, 0);
(iLeft, rfbTop + (tdbHeight + 4) * iCol, 200, mvHeight);
:= [i] + '：['
+ FDatasetArray[0]. + '.' + AnalyseText([i]) + ']';
(mv);
inc(iLeft, 200);
end;
end
else //否则不打印页脚上的字段列表
begin
end;
end;
function : string;
begin
result := FFileName;
end;
procedure (const Value: string);
begin
FFileName := value;
(FFileName);
end;
procedure (ReportName: string);
var
i: integer;
s: string;
begin
if ReportName = '' then exit;
s := '';
for i:=0 to -1 do
s := s + [i] + ',';
delete(s, length(s), 1); //删除最后一个','号
(ReportName, 'Title', s);
s := '';
for i:=0 to -1 do
s := s + [i] + ',' ;
delete(s, length(s), 1);
(ReportName, 'Detail', s);
s := '';
for i:=0 to -1 do
s := s + [i] + ',' ;
delete(s, length(s), 1);
(ReportName, 'Footer', s);
end;
//从配置文件中得到要打印的字段，然后加入Listview中
procedure (ReportName: string);
var
s: string;
begin
FReportName := ReportName;
:= (ReportName, 'Title', '');
//注意：当调用了LoadFieldList之后，再执行SetGrid，那么DetailFields的字段列表会被FGridFields的字段列表覆盖
:= (ReportName, 'Detail', '');
:= (ReportName, 'Footer', '');
if > 0 then
begin
s := [-1]; ;//最后一个字段的前缀就是明细数据条的数据源
:= Copy(s, 1, AnsiPos('.', s)-1);
end;
end;
function : TStrings;
begin
result := FDetailFields;
end;
procedure (const Value: TStrings);
begin
(value);
end;
procedure (Datasets: array of TDataset);
var
i, j, iLen: integer;
Dataset: TDataset;
TvFields: TTreeView;
MainNode: TTreeNode;
b: Boolean;
begin
for i:=0 to high(Datasets) do //把数据集逐一赋给FDatasetArray
begin
b := false;
for j:=0 to high(FDatasetArray) do //先判断数组中是否已存在要加入的数据集
begin
b := false;
if FDatasetArray[j].Name = Datasets[i].Name then
begin
b := true;
break;
end;
end;
if not b then
begin
iLen := high(FDatasetArray) + 2; //得到数组的上标(动态数组作为参数，其下标总是从0开始)，长度加2才是数量
SetLength(FDatasetArray, iLen);
SetLength(FRDataset, iLen);
dec(iLen);
FDatasetArray[iLen] := Datasets[i]; //数量减去1才是维数
FRDataset[iLen] := (frmCommon);
FRDataset[iLen].DataSet := FDatasetArray[iLen];
frDataset[iLen].Name := FDatasetArray[iLen].Name;
end;
end;
tvFields := (nil); //因为打算用一个树形结构来表示所有字段，为便于赋值，干脆把整棵树赋值给frmCommon（有时间改为Stream比较好）
try
:= frmCommon;
for i:=0 to high(FDatasetArray) do
begin
Dataset := FDatasetArray[i];
MainNode := (nil, );
for j:=0 to -1 do
(MainNode, [j].FieldName
+ '[' + [j].DisplayLabel + ']');
end;
(); //把树赋给frmCommon
finally
;
end;
end;
function : TCustomGrid;
begin
result := FGrid;
end;
procedure (const Grid: TCustomGrid);
var
PropInfo:PPropInfo;
DBGrid: TDBGrid;
i: integer;
Dataset: TDataset;
begin
FGrid := Grid;
if not assigned(Grid) then exit;
PropInfo := GetPropInfo(Grid,'DataSource'); //查找Grid是否有DataSource属性
if PropInfo <> nil then //如果有
begin
DBGrid := (nil);
try
//得到表格数据源的数据集的名称
//为了不引用也能得到，所以使用了RTTI
//这样的好处不仅在TDBGridEh中体现，以后使用了别的DBGrid，只要它有DataSource，也能得到其数据集的名称
SetObjectProp(DBGrid, 'DataSource', GetObjectProp(Grid, 'DataSource'));
if not assigned() then exit;
Dataset := ;
if Dataset = nil then exit;
SetDataset(DataSet);
PropInfo := GetPropInfo(Grid, 'Columns'); //查找Grid是否有Columns属性
if PropInfo <> nil then
begin
SetObjectProp(DBGrid, 'Columns', GetObjectProp(Grid, 'Columns'));
if not assigned() then exit;
for i:=0 to -1 do
begin
if [i].Visible then //只挑选可视的字段
begin
( + '.' + [i].FieldName + '=' + [i].DisplayName);
( + '.' + [i].FieldName + '=' + IntToStr([i].Width));
end;
end;
end;
PropInfo := GetPropInfo(Grid, 'RowHeight'); //查找Grid是否有RowHeight属性
if PropInfo <> nil then
begin
FGridRowHeight := GetPropValue(Grid, 'RowHeight', false);
:= FGridRowHeight;
end;
//把DetailFields的字段列表清空，并把Grid的字段加入DetailFields中
//这样处理有个问题：当调用了LoadFieldList后，DetailFields从FGridFields中得到的字段列表会被配置文件中的字段列表覆盖
;
for i:=0 to -1 do
([i]);
finally
FreeAndNil(DBGrid);
end;
end;
end;
function : TStrings;
begin
result := FVariantList;
end;
procedure (const Value: TStrings);
var
i: integer;
begin
//注意：如果要传字符串变量，那么格式为'Name=''Value'''；如果要传数值变量，那么格式为'Name=1'
(value);
[' VariantList'] := ''; //变量root
for i:=0 to -1 do //把变量列表加入数据字典
[[i]] := [i];
end;
end.