FastReport 打印模版页(TFrxReportpage)复制

遇到一个奇葩的需求。通常状况下咱们打印单据，用FastReport设置打印格式，也就是就设一个模版页而己，就是一种单据格式。若是打印的单据数据多了就自动打印多页了，他们的格式是同样的。也就是读同一个模版页。spa

现的需求是，若是打印N页内容。每一页的格式除了表体外是同样的(也可能部份不一样)。而表体取自不一样的数据集(也就是读取不一样的FDQuery)，须要设置不一样的表体格式(表体列的数量，列的名称)。code

在各大论坛中找不到现成解决方案。经网友提示，FastReport的打印模版设置好了其实就是一个XML文件。因此咱们只须要读取这个XML，而后取出Page部份，复制成N份，根据需求修改不一样部份的内容，而后再写入这个打印模版就能够了。开发中发现Delphi里读取XML文件的控件是很多，可是都有或多或少的问题，导制不适用于这个方案，最终我选择了FastReport里自带的FrxXML。功能虽少，可是够用了。orm

如下分享的是Page页的复制的实现代码，修改内容部份根据实际需求自行编写。至于如何修改，能够参照如下代码。blog

与网友的交流中，有网友不明白个人需求，最终说我语文小学没毕业，表达不清楚。其实我虽然语文小学有毕业，但也是离毕业的不远开发

unit frxHelp; interface

 uses frxClass,frxXML,System.SysUtils,Vcl.Dialogs; type TChangeProp=reference to  procedure (aXML:TfrxXMLItem); ///*******************根据FastReport设置好的打印模版（ReportPage）生成多页 /// //procedure TForm1.FormCreate(Sender: TObject); // //const // frxFile='G:\delphi\delphi\企业通ERP\DOERP\BIN\fr3\销售明细打印.fr3'; //var // cStream:TStream; // I:integer; // frXML:TfrxXMLDocument; // frXItem:TfrxXMLItem; // fdoprop:TChangeProp; //begin // I:=0; // fdoprop:= procedure (aXML:TfrxXMLItem) // begin // if aXML.PropExists('DataSet') then // ShowMessage(aXML.Prop['DataSet']); // end; // IF GetFrxpageTemple(frxFile,frXML,frXItem) then // IF CopyfrxPage(frXML,frXItem,I,'Page3',fdoProp) then // begin // cStream:=TMemoryStream.Create; // frXML.SaveToStream(cStream); // cStream.Position:=0; // frxReport1.LoadFromStream(cStream); // frxReport1.DesignReport(); // end; //end;
  procedure changeProp(aXML:TfrxXMLItem;iXML:Integer;Prop:TChangeProp=nil); procedure CopyXML(S,D:TfrxXMLItem); function CopyfrxPage(fXMLDoc:TfrxXMLDocument;sPageItem:TfrxXMLItem;ID:integer;cPname:String;Prop:TChangeProp=nil):Boolean; function GetFrxpageTemple(cFile:String;out fXMLDoc:TfrxXMLDocument;out PageItem:TfrxXMLItem):Boolean; implementation
 procedure CopyXML(S,D:TfrxXMLItem); var I:Integer; a,b:TfrxXMLItem; begin
    for I := 0 to S.Count-1 do
      begin a:=s.Items[i]; b:=d.Add; b.Name:=a.Name; b.Text:=a.Text; if a.Count>0 then CopyXML(a,b); end; end; procedure changeProp(aXML:TfrxXMLItem;iXML:Integer;Prop:TChangeProp); var I:Integer; fXML:TfrxXMLItem; begin
    for I := 0 to aXML.Count-1 do
      begin fXML:=aXML.Items[I]; //Name属性是必须改的，为避免没有传入属性修改 方法(Prop:TChange)默认强制修改Name
        if fXML.PropExists('Name') then fXML.Prop['Name']:=fXML.Prop['Name']+'N'+iXML.toString; if Assigned(Prop) then Prop(aXML); if fXML.Count>0 then changeProp(fxML,iXML,Prop); Inc(iXml); end; end; function GetFrxpageTemple(cFile:String;out fXMLDoc:TfrxXMLDocument;out PageItem:TfrxXMLItem):Boolean; begin
 if Not FileExists(cFile) then
   begin ShowMessagefmt('打印模版[%s]不存在！！',[cFile]); Exit(False); end; try fXMLDoc:=TfrxXMLDocument.Create; fXMLDoc.LoadFromFile(cFile); PageItem:=TfrxXMLItem.Create; PageItem:=fXMLDoc.Root.FindItem('TfrxReportPage'); except on E:Exception do
      begin ShowMessage(E.Message); Exit(false); end; end; Result:=True; end; function CopyfrxPage(fXMLDoc:TfrxXMLDocument;sPageItem:TfrxXMLItem;ID:integer;cPname:String;Prop:TChangeProp):Boolean; var fFrxItem:TfrxXMLItem; begin
  try fFrXItem:=fXMLDoc.Root.Add; fFrxItem.Name:='TfrxReportPage'; fFrxItem.Text:=sPageItem.Text; fFrxItem.Prop['Name']:=cPname; CopyXML(spageItem,fFrxItem); ChangeProp(fFrxItem,ID,Prop); except on E:Exception do
      begin ShowMessage(E.Message); Exit(false); end; end; result:=True; end; end.