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:\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.