FastReport 打印模版页(TFrxReportpage)复制

遇到一个奇葩的需求。一般情况下我们打印单据，用FastReport设置打印格式，也就是就设一个模版页而己，就是一种单据格式。如果打印的单据数据多了就自动打印多页了，他们的格式是一样的。也就是读同一个模版页。

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

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

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

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

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:delphidelphi企业通ERPDOERPBINfr3销售明细打印.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.