遇到一个奇葩的需求。一般情况下我们打印单据,用FastReport设置打印格式,也就是就设一个模版页而己,就是一种单据格式。如果打印的单据数据多了就自动打印多页了,他们的格式是一样的。也就是读同一个模版页。
现的需求是,如果打印N页内容。每一页的格式除了表体外是一样的(也可能部份不同)。而表体取自不同的数据集(也就是读取不同的FDQuery),需要设置不同的表体格式(表体列的数量,列的名称)。
在各大论坛中找不到现成解决方案。经网友提示,FastReport的打印模版设置好了其实就是一个XML文件。所以我们只需要读取这个XML,然后取出Page部份,复制成N份,根据需求修改不同部份的内容,然后再写入这个打印模版就可以了。开发中发现Delphi里读取XML文件的控件是不少,但是都有或多或少的问题,导制不适用于这个方案,最终我选择了FastReport里自带的FrxXML。功能虽少,但是够用了。
以下分享的是Page页的复制的实现代码,修改内容部份根据实际需求自行编写。至于如何修改,可以参照以下代码。
与网友的交流中,有网友不明白我的需求,最终说我语文小学没毕业,表达不清楚。其实我虽然语文小学有毕业,但也是离毕业的不远。
1 unit frxHelp;
2
3 interface
4
5 uses frxClass,frxXML,System.SysUtils,Vcl.Dialogs;
6 type
7 TChangeProp=reference to procedure (aXML:TfrxXMLItem);
8
9 ///*******************根据FastReport设置好的打印模版(ReportPage)生成多页
10 ///
11 //procedure TForm1.FormCreate(Sender: TObject);
12 //
13 //const
14 // frxFile='G:\delphi\delphi\企业通ERP\DOERP\BIN\fr3\销售明细打印.fr3';
15 //var
16 // cStream:TStream;
17 // I:integer;
18 // frXML:TfrxXMLDocument;
19 // frXItem:TfrxXMLItem;
20 // fdoprop:TChangeProp;
21 //begin
22 // I:=0;
23 // fdoprop:= procedure (aXML:TfrxXMLItem)
24 // begin
25 // if aXML.PropExists('DataSet') then
26 // ShowMessage(aXML.Prop['DataSet']);
27 // end;
28 // IF GetFrxpageTemple(frxFile,frXML,frXItem) then
29 // IF CopyfrxPage(frXML,frXItem,I,'Page3',fdoProp) then
30 // begin
31 // cStream:=TMemoryStream.Create;
32 // frXML.SaveToStream(cStream);
33 // cStream.Position:=0;
34 // frxReport1.LoadFromStream(cStream);
35 // frxReport1.DesignReport();
36 // end;
37 //end;
38 procedure changeProp(aXML:TfrxXMLItem;iXML:Integer;Prop:TChangeProp=nil);
39 procedure CopyXML(S,D:TfrxXMLItem);
40 function CopyfrxPage(fXMLDoc:TfrxXMLDocument;sPageItem:TfrxXMLItem;ID:integer;cPname:String;Prop:TChangeProp=nil):Boolean;
41 function GetFrxpageTemple(cFile:String;out fXMLDoc:TfrxXMLDocument;out PageItem:TfrxXMLItem):Boolean;
42 implementation
43 procedure CopyXML(S,D:TfrxXMLItem);
44 var
45 I:Integer;
46 a,b:TfrxXMLItem;
47 begin
48 for I := 0 to S.Count-1 do
49 begin
50 a:=s.Items[i];
51 b:=d.Add;
52 b.Name:=a.Name;
53 b.Text:=a.Text;
54 if a.Count>0 then
55 CopyXML(a,b);
56
57 end;
58 end;
59 procedure changeProp(aXML:TfrxXMLItem;iXML:Integer;Prop:TChangeProp);
60 var
61 I:Integer;
62 fXML:TfrxXMLItem;
63 begin
64 for I := 0 to aXML.Count-1 do
65 begin
66 fXML:=aXML.Items[I];
67 //Name属性是必须改的,为避免没有传入属性修改 方法(Prop:TChange)默认强制修改Name
68 if fXML.PropExists('Name') then
69 fXML.Prop['Name']:=fXML.Prop['Name']+'N'+iXML.toString;
70 if Assigned(Prop) then
71 Prop(aXML);
72 if fXML.Count>0 then
73 changeProp(fxML,iXML,Prop);
74 Inc(iXml);
75 end;
76 end;
77 function GetFrxpageTemple(cFile:String;out fXMLDoc:TfrxXMLDocument;out PageItem:TfrxXMLItem):Boolean;
78 begin
79 if Not FileExists(cFile) then
80 begin
81 ShowMessagefmt('打印模版[%s]不存在!!',[cFile]);
82 Exit(False);
83 end;
84 try
85 fXMLDoc:=TfrxXMLDocument.Create;
86 fXMLDoc.LoadFromFile(cFile);
87 PageItem:=TfrxXMLItem.Create;
88 PageItem:=fXMLDoc.Root.FindItem('TfrxReportPage');
89 except
90 on E:Exception do
91 begin
92 ShowMessage(E.Message);
93 Exit(false);
94 end;
95 end;
96 Result:=True;
97 end;
98 function CopyfrxPage(fXMLDoc:TfrxXMLDocument;sPageItem:TfrxXMLItem;ID:integer;cPname:String;Prop:TChangeProp):Boolean;
99 var
100 fFrxItem:TfrxXMLItem;
101 begin
102 try
103 fFrXItem:=fXMLDoc.Root.Add;
104 fFrxItem.Name:='TfrxReportPage';
105 fFrxItem.Text:=sPageItem.Text;
106 fFrxItem.Prop['Name']:=cPname;
107 CopyXML(spageItem,fFrxItem);
108 ChangeProp(fFrxItem,ID,Prop);
109 except
110 on E:Exception do
111 begin
112 ShowMessage(E.Message);
113 Exit(false);
114 end;
115 end;
116 result:=True;
117 end;
118
119 end.