From 117f9f2c64be6c269146cb1a73e16c647a190c65 Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 6 May 2018 09:08:32 +0000 Subject: [PATCH] * Some improvements to lazreport converter, add diagnostic output, sample conversion program git-svn-id: trunk@38927 - --- .gitattributes | 2 + packages/fcl-report/demos/laz2fpreport.lpi | 57 ++++++ packages/fcl-report/demos/laz2fpreport.pp | 125 ++++++++++++ packages/fcl-report/src/fplazreport.pp | 216 +++++++++++++++------ 4 files changed, 343 insertions(+), 57 deletions(-) create mode 100644 packages/fcl-report/demos/laz2fpreport.lpi create mode 100644 packages/fcl-report/demos/laz2fpreport.pp diff --git a/.gitattributes b/.gitattributes index 8022b9822c..a899d2f78a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2662,6 +2662,8 @@ packages/fcl-report/demos/fonts/LiberationSerif-Bold.ttf -text packages/fcl-report/demos/fonts/LiberationSerif-BoldItalic.ttf -text packages/fcl-report/demos/fonts/LiberationSerif-Italic.ttf -text packages/fcl-report/demos/fonts/LiberationSerif-Regular.ttf -text +packages/fcl-report/demos/laz2fpreport.lpi svneol=native#text/plain +packages/fcl-report/demos/laz2fpreport.pp svneol=native#text/plain packages/fcl-report/demos/pictures/man01.png -text svneol=unset#image/png packages/fcl-report/demos/pictures/man02.png -text svneol=unset#image/png packages/fcl-report/demos/pictures/man03.png -text svneol=unset#image/png diff --git a/packages/fcl-report/demos/laz2fpreport.lpi b/packages/fcl-report/demos/laz2fpreport.lpi new file mode 100644 index 0000000000..46aa909124 --- /dev/null +++ b/packages/fcl-report/demos/laz2fpreport.lpi @@ -0,0 +1,57 @@ + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <Units Count="1"> + <Unit0> + <Filename Value="laz2fpreport.pp"/> + <IsPartOfProject Value="True"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="laz2fpreport"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="../src"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/packages/fcl-report/demos/laz2fpreport.pp b/packages/fcl-report/demos/laz2fpreport.pp new file mode 100644 index 0000000000..7dddd214dc --- /dev/null +++ b/packages/fcl-report/demos/laz2fpreport.pp @@ -0,0 +1,125 @@ +program laz2fpreport; + +{$mode objfpc}{$H+} + +uses + Classes, SysUtils, CustApp, fpjson, fpreport, fplazreport, fpreportstreamer; + +type + + { TLazToFPReport } + + TLazToFPReport = class(TCustomApplication) + Private + FLazReport : TFPLazReport; + FInputFile, + FOutputFile : String; + FFormatOutput : Boolean; + FVerbose : Boolean; + procedure Convert; + procedure DoVerbose(Sender: TOBject; const Msg: String); + protected + procedure DoRun; override; + public + constructor Create(TheOwner: TComponent); override; + destructor Destroy; override; + procedure WriteHelp(Const aMsg :String); virtual; + end; + +{ TLazToFPReport } + +procedure TLazToFPReport.DoRun; + +var + ErrorMsg: String; + +begin + // quick check parameters + ErrorMsg:=CheckOptions('hi:o:vf', ['help','input:','output:','verbose','format']); + if (ErrorMsg<>'') or HasOption('h','help') then + WriteHelp(ErrorMsg); + FInputFile:=GetOptionValue('i','input'); + if FInputFile='' then + WriteHelp('No input file specified.'); + FOutputFile:=GetOptionValue('o','output'); + If FOutputFile='' then + FOutputFile:=ChangeFileExt(FinputFile,'.json'); + FFormatOutput:=HasOption('f','format'); + FVerbose:=HasOption('v','verbose'); + if FVerbose then + FLazReport.OnLog:=@DoVerbose; + Convert; + Terminate; +end; + +procedure TLazToFPReport.Convert; + +Var + S : TFPReportJSONStreamer; + F : TFileStream; + J : TJSONStringType; + +begin + + FLazReport.LoadFromFile(FInputFile); + F:=Nil; + S:=TFPReportJSONStreamer.Create(Self); + try + FLazReport.WriteElement(S); + if FFormatOutput then + J:=S.JSON.FormatJSON() + else + J:=S.JSON.AsJSON; + F:=TFileStream.Create(FOutputFile,fmCreate); + F.Write(J[1],Length(J)); // Single byte type. + finally + F.Free; + S.Free; + end; +end; + +procedure TLazToFPReport.DoVerbose(Sender: TOBject; const Msg: String); +begin + if FVerbose then + Writeln(StdErr,Msg); +end; + +constructor TLazToFPReport.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + StopOnException:=True; + FLazReport:=TFPLazReport.Create(Self); +end; + +destructor TLazToFPReport.Destroy; +begin + FreeAndNil(FLazReport); + inherited Destroy; +end; + +procedure TLazToFPReport.WriteHelp(const aMsg: String); + +begin + if (aMsg<>'') then + Writeln('Error : ',aMsg); + writeln('Usage: ', ExeName, ' [options] -i filename'); + Writeln('Where options are: '); + Writeln('-f --format Write formatted JSON to output file'); + Writeln('-h --help This help message'); + Writeln('-i --input=filename input file name, must be a .lrf file, in XML format.'); + Writeln('-o --output=filename output file name.'); + Writeln(' If not specified, input file with extension changed to .json is used.'); + Writeln('-v --verbose Print some diagnostic information'); + Halt(Ord(aMsg<>'')); +end; + +var + Application: TLazToFPReport; + +begin + Application:=TLazToFPReport.Create(nil); + Application.Title:='LazReport to FPReport Converter'; + Application.Run; + Application.Free; +end. + diff --git a/packages/fcl-report/src/fplazreport.pp b/packages/fcl-report/src/fplazreport.pp index 0ddd9d30d4..ff192829e4 100644 --- a/packages/fcl-report/src/fplazreport.pp +++ b/packages/fcl-report/src/fplazreport.pp @@ -20,14 +20,15 @@ unit fplazreport; interface uses - Classes, SysUtils, fpreport, fpjsonreport, DOM, XMLRead, - FPReadPNG,FPimage,FPCanvas,fpreportdb; + Classes, SysUtils, fpreport, DOM, FPCanvas, fpTTF, fpreportdb; Type TCustomPropEvent = procedure(Sender: TObject;Data : TDOMNode) of object; + TConvertLogEvent = Procedure(Sender: TOBject;Const Msg : String) of Object; + TNameConvertEvent = Procedure(Sender: TOBject;Const aName : UnicodeString; Var aNewName : String) of Object; + TFontSubstitutionEvent = Procedure(Sender: TOBject;Const aFontName : String; Const aBold,aItalic: Boolean; var aFont : TFPFontCacheItem) of Object; { TFPLazReport } - TFPLazReport = class(TFPReport) private FData: TComponent; @@ -36,24 +37,32 @@ Type FDetailFooter : TFPReportDataFooterBand; FDetailBand: TFPReportDataBand; FMemoClass: TFPReportElementClass; + FOnConvertName: TNameConvertEvent; + FOnLog: TConvertLogEvent; FOnSetCustomProps: TCustomPropEvent; + FOnSubstituteFont: TFontSubstitutionEvent; + FCounter : Integer; Protected class function Red(rgb: Integer): BYTE; virtual; class function Green(rgb: Integer): BYTE; virtual; class function Blue(rgb: Integer): BYTE; virtual; class function FindBand(aPage: TFPReportCustomPage; aTop: double): TFPReportCustomBand; virtual; - class function GetProperty(aNode: TDOMNode; aName: string; aValue: string='Value'): string; virtual; + class function GetProperty(aNode: TDOMNode; const aName: String; const aValue: string='Value'): UTF8String; virtual; function ApplyFrame(aDataNode: TDOMNode; aFrame: TFPReportFrame): Boolean; virtual; procedure ApplyObjectProperties(ObjNode: TDOMNode; aObj: TFPReportElement); virtual; procedure ConvertPageProperties(aPage: TFPReportPage; aPageNode: TDOMNode); virtual; procedure SetData(AValue: TComponent);virtual; procedure SizeToLayout(aDataNode: TDOMNode; aObj: TFPReportElement);virtual; + Function ConvertComponentName(Const aName : UnicodeString;Const AClassName : String) : String; virtual; + function ConvertFont(aDataNode: TDomNode): TFPFontCacheItem; virtual; function ConvertBand(aBandNode: TDomNode;aPage: TFPReportCustomPage): TFPReportCustomBand; virtual; function ConvertMemo(ObjNode: TDOMNode; aPage: TFPReportCustomPage): TFPReportMemo; virtual; function ConvertPage(aPageNode: TDOMNode): TFPReportPage; virtual; function ConvertLine(ObjNode: TDOMNode; APage: TFPReportCustomPage): TFPReportShape; virtual; function ConvertImage(ObjNode: TDOMNode; APage: TFPReportCustomPage): TFPReportImage; virtual; Procedure Notification(AComponent: TComponent; Operation: TOperation); override; + Procedure DoLog(Const Msg : String); + Procedure DoLog(Const Fmt : String; Const Args : Array of const); Public constructor Create(AOwner: TComponent); override; function FixDataFields(aFieldName : string) : string; @@ -63,6 +72,9 @@ Type Published property DataContainer : TComponent read FData write SetData; property OnSetCustomproperties : TCustomPropEvent read FOnSetCustomProps write FOnSetCustomProps; + Property OnLog : TConvertLogEvent Read FOnLog Write FOnLog; + Property OnSubstituteFont : TFontSubstitutionEvent Read FOnSubstituteFont Write FOnSubstituteFont; + Property OnConvertName : TNameConvertEvent Read FOnConvertName Write FOnConvertName; end; function MMToPixels(Const Dist: double) : Integer; @@ -70,7 +82,15 @@ Type implementation -uses fpTTF,dateutils,base64,FPReadGif,FPReadJPEG; +uses dateutils, XMLRead,FPReadPNG,FPimage,FPReadGif,FPReadJPEG; + +Resourcestring + SLogUnknownClass = 'Ignoring unknown lazreport class type for object "%s": "%s".'; + SErrUnknownBandType = 'Unknown band type: "%s", substituting child band'; + SErrWrongEncoding = 'Unknown image encoding at pos %d : %s'; + SFontSubstitution = 'FontSubstitution'; + SErrUnknownImageType = 'Unknown image type encountered: "%s"'; + SWarnConvertName = 'Name conversion: "%s" to "%s"'; function PixelsToMM(Const Dist: double) : TFPReportUnits; begin @@ -106,6 +126,27 @@ begin FData:=Nil; end; +procedure TFPLazReport.DoLog(const Msg: String); +begin + If Assigned(FOnLog) then + FOnLog(Self,Msg); +end; + +procedure TFPLazReport.DoLog(const Fmt: String; const Args: array of const); + +Var + S : String; + +begin + try + S:=Format(Fmt,Args); + except + on E : Exception do + S:=Format('Failed to format error message "%s" with %d arguments',[Fmt,Length(Args)]); + end; + DoLog(S); +end; + constructor TFPLazReport.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -114,9 +155,10 @@ begin end; function TFPLazReport.FixDataFields(aFieldName: string): string; + var k : Integer = 0; - atmp : string; + begin Result := aFieldName; if Assigned(FData) then @@ -149,7 +191,6 @@ procedure TFPLazReport.LoadFromXML(LazReport: TXMLDocument); var i: Integer; - j: Integer; BaseNode,lPages : TDOMNode; aPage: TFPReportPage; @@ -170,15 +211,17 @@ begin end; end; -Class function TFPLazReport.GetProperty(aNode : TDOMNode;aName : string;aValue : string = 'Value') : string; +Class function TFPLazReport.GetProperty(aNode : TDOMNode;Const aName : String; Const aValue : string = 'Value') : UTF8String; + var bNode: TDOMNode; + begin Result := ''; bNode := aNode.FindNode(aName); if Assigned(bNode) then if Assigned(bNode.Attributes.GetNamedItem(aValue)) then - Result := bNode.Attributes.GetNamedItem(aValue).NodeValue; + Result := UTF8Encode(bNode.Attributes.GetNamedItem(aValue).NodeValue); end; Class function TFPLazReport.FindBand(aPage : TFPReportCustomPage;aTop : double) : TFPReportCustomBand; @@ -259,7 +302,7 @@ begin if Assigned(FDetailBand) then TFPReportDataHeaderBand(aBand).Data := FDetailBand.Data else - FDetailHeader := TFPReportDataHeaderBand(Self); + FDetailHeader:=TFPReportDataHeaderBand(aBand); end; 'btDetailFooter': begin @@ -285,7 +328,10 @@ begin 'btGroupFooter': aBand := TFPReportGroupFooterBand.Create(Self); else - aBand := TFPReportCustomBand.Create(Self); + begin + DoLog(SErrUnknownBandType,[Tmp]); + aBand := TFPReportChildBand.Create(Self); + end; end; if Assigned(aBand) then begin @@ -295,13 +341,66 @@ begin Result:=aBand; end; +Function TFPLazReport.ConvertFont(aDataNode : TDomNode) : TFPFontCacheItem; + +Var + i : Integer; + FontFound, aBold, aItalic : Boolean; + aFont : TFPFontCacheItem; + RealFont,FontName : String; + +begin + aBold := pos('fsBold',GetProperty(aDataNode,'Style'))>0; + aItalic := pos('fsItalic',GetProperty(aDataNode,'Style'))>0; + FontName:=GetProperty(aDataNode,'Name'); + aFont := gTTFontCache.Find(FontName,aBold,aItalic); + FontFound := not Assigned(aFont); + if not Assigned(aFont) then + aFont := gTTFontCache.Find('LiberationSans',aBold,aItalic); + if not Assigned(aFont) then + aFont := gTTFontCache.Find('Arial',aBold,aItalic); + if not Assigned(aFont) then + aFont := gTTFontCache.Find('DejaVu',aBold,aItalic); + with gTTFontCache do + begin + i:=0; + While (aFont=Nil) and (i<Count) do + begin + aFont := Items[i]; + if Not ((pos('sans',lowercase(aFont.FamilyName)) > 0) and (aFont.IsItalic = AItalic) + and (aFont.IsBold = ABold)) then + aFont:=nil; + Inc(i); + end; + end; + if Not FontFound then + begin + // Allow user to override + If Assigned(FOnSubstituteFont) then + FOnSubstituteFont(Self,FontName,aBold,aItalic,aFont); + // Log it + if Assigned(FOnLog) then + begin + if Assigned(aFont) then + RealFont:=aFont.FamilyName + else + RealFont:='<nil>'; + if aBold then + RealFont:=RealFont+'[Bold]'; + if aItalic then + RealFont:=RealFont+'[Italic]'; + DoLog(SFontSubstitution,[FOntName,RealFont]); + end; + end; + Result:=aFont; +end; + Function TFPLazReport.ConvertMemo(ObjNode : TDOMNode;aPage : TFPReportCustomPage) : TFPReportMemo; Var aDataNode: TDOMNode; aBand: TFPReportCustomBand; - i,aColor,aSize,aFlag : Integer; - FontFound, aBold, aItalic : Boolean; + aColor,aSize,aFlag : Integer; aFont: TFPFontCacheItem; begin @@ -331,32 +430,8 @@ begin Result.Text:=FixDataFields(GetProperty(aDataNode,'Memo')); Result.UseParentFont := False; aDataNode := ObjNode.FindNode('Font'); - aBold := pos('fsBold',GetProperty(aDataNode,'Style'))>0; - aItalic := pos('fsItalic',GetProperty(aDataNode,'Style'))>0; - aFont := gTTFontCache.Find(GetProperty(aDataNode,'Name'),aBold,aItalic); - FontFound := not Assigned(aFont); - if not Assigned(aFont) then - aFont := gTTFontCache.Find('LiberationSans',aBold,aItalic); - if not Assigned(aFont) then - aFont := gTTFontCache.Find('Arial',aBold,aItalic); - if not Assigned(aFont) then - aFont := gTTFontCache.Find('DejaVu',aBold,aItalic); - with gTTFontCache do - begin - i:=0; - While (aFont=Nil) and (i<Count) do - begin - aFont := Items[i]; - if Not ((pos('sans',lowercase(aFont.FamilyName)) > 0) and (aFont.IsItalic = AItalic) - and (aFont.IsBold = ABold)) then - aFont:=nil; - Inc(i); - end; - end; - {$ifdef UNIX} - if (not FontFound) and Assigned(aFont) then - writeln('using Font "'+aFont.FamilyName+'" instead "'+GetProperty(aDataNode,'Name')+'"'); - {$endif} + if Assigned(aDataNode) then + aFont:=ConvertFont(aDataNode); if Assigned(aFont) then Result.Font.Name:=aFont.PostScriptName else @@ -389,7 +464,7 @@ Function TFPLazReport.ConvertImage(ObjNode : TDOMNode; APage : TFPReportCustomPa Var aDataNode: TDOMNode; aBand: TFPReportCustomBand; - tmp : String; + tmp,e : String; SS: TStream; aReaderClass : TFPCustomImageReaderClass; B : Byte; @@ -401,13 +476,17 @@ begin Result := TFPReportImage.Create(aBand); aDataNode := ObjNode.FindNode('Picture'); aReaderClass:=nil; - case lowercase(GetProperty(aDataNode,'Type','Ext')) of + tmp:=lowercase(GetProperty(aDataNode,'Type','Ext')); + case tmp of 'jpeg','jpg': aReaderClass := TFPReaderJPEG; 'png': aReaderClass := TFPReaderPNG; 'gif': aReaderClass := TFPReaderGif; end; if Not Assigned(aReaderClass) then + begin + DoLog(SErrUnknownImageType,[tmp]); exit; + end; tmp:=GetProperty(aDataNode,'Data'); if Tmp='' then Exit; @@ -415,7 +494,10 @@ begin try for i:=1 to (system.length(tmp) div 2) do begin - Val('$'+tmp[i*2-1]+tmp[i*2], B, cd); + e:=tmp[i*2-1]+tmp[i*2]; + Val('$'+E, B, cd); + if cd<>0 then + DoLog(SErrWrongEncoding,[i*2-1,E]); ss.Write(B, 1); end; ss.Position:=0; @@ -449,6 +531,24 @@ begin end; end; +function TFPLazReport.ConvertComponentName(const aName: UnicodeString; const AClassName: String): String; +begin + if IsValidIdent(aName) then + Result:=aName + else + begin + Repeat + Inc(FCounter); + Result:=aClassName+IntToStr(FCounter); + Until FindComponent(Result)=Nil; + if Assigned(FOnConvertName) then + FOnConvertName(Self,aName,Result); + DoLog(SWarnConvertName,[aName,Result]); + end; + + +end; + Function TFPLazReport.ApplyFrame(aDataNode : TDOMNode; aFrame: TFPReportFrame) : Boolean; Var @@ -489,7 +589,7 @@ Var aColor : Integer; begin - aObj.Name:=GetProperty(ObjNode,'Name'); + aObj.Name:=ConvertComponentName(GetProperty(ObjNode,'Name'),aObj.ClassName); aDataNode := ObjNode.FindNode('Size'); if Assigned(aDataNode) then SizeToLayout(aDataNode,aObj); @@ -514,7 +614,7 @@ begin end; end; -Procedure TFPLazReport.ConvertPageProperties(aPage : TFPReportPage; aPageNode : TDOMNode) ; +procedure TFPLazReport.ConvertPageProperties(aPage: TFPReportPage; aPageNode: TDOMNode); Var aDataNode: TDOMNode; @@ -540,9 +640,10 @@ Function TFPLazReport.ConvertPage(aPageNode : TDOMNode) : TFPReportPage; var aPage: TFPReportPage; - nPage, lPages,ObjNode,BaseNode, aDataNode: TDOMNode; + ObjNode : TDOMNode; aObj: TFPReportElement; J : Integer; + NodeName,CT : String; begin FMasterData := nil; @@ -555,9 +656,11 @@ begin for j := 0 to aPageNode.ChildNodes.Count-1 do begin ObjNode:=aPageNode.ChildNodes.Item[j]; - if copy(ObjNode.NodeName,0,6)='Object' then + NodeName:=ObjNode.NodeName; + if (copy(NodeName,0,6)='Object') and (NodeName<>'ObjectCount') then begin - case GetProperty(ObjNode,'ClassName') of + CT:=GetProperty(ObjNode,'ClassName'); + case CT of 'TfrBandView': aObj:=ConvertBand(ObjNode,aPage); 'TfrMemoView': @@ -567,6 +670,7 @@ begin 'TfrPictureView': aObj:=ConvertImage(ObjNode,aPage); else + DoLog(SLogUnknownClass,[NodeName,CT]); aObj:=Nil; end; if Assigned(aObj) then @@ -577,19 +681,17 @@ end; procedure TFPLazReport.LoadFromFile(const aFileName: String); + var LazReport: TXMLDocument; + begin - if lowercase(ExtractFileExt(aFileName)) = '.lrf' then - begin - ReadXMLFile(LazReport, aFileName); - try - LoadFromXML(LazReport); - finally - LazReport.Free; - end; - end - else inherited; + ReadXMLFile(LazReport, aFileName); + try + LoadFromXML(LazReport); + finally + LazReport.Free; + end; end; end.