FastReport 列印模版頁(TFrxReportpage)複製

遇到一個奇葩的需求。一般情況下我們列印單據，用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.