Browse Source

* Rename component on read without exceptions. Several fixes for copy&paste in designer

git-svn-id: trunk@38654 -
michael 7 years ago
parent
commit
ab606d3c8d
2 changed files with 219 additions and 19 deletions
  1. 201 19
      packages/fcl-report/src/fpreport.pp
  2. 18 0
      packages/fcl-report/src/fpreportstreamer.pp

+ 201 - 19
packages/fcl-report/src/fpreport.pp

@@ -118,10 +118,13 @@ type
   TFPReportBandPosition   = (bpNormal, bpStackAtBottom);
   TFPReportBandPosition   = (bpNormal, bpStackAtBottom);
   TFPReportSection        = (rsNone, rsPage, rsColumn);
   TFPReportSection        = (rsNone, rsPage, rsColumn);
   TFPReportVisibleOnPage  = (vpAll, vpFirstOnly, vpLastOnly, vpFirstAndLastOnly, vpNotOnFirst, vpNotOnLast, vpNotOnFirstAndLast);
   TFPReportVisibleOnPage  = (vpAll, vpFirstOnly, vpLastOnly, vpFirstAndLastOnly, vpNotOnFirst, vpNotOnLast, vpNotOnFirstAndLast);
-  // For color coding
   TFPReportBandType       = (btUnknown,btPageHeader,btReportTitle,btColumnHeader,btDataHeader,btGroupHeader,btDataband,btGroupFooter,
   TFPReportBandType       = (btUnknown,btPageHeader,btReportTitle,btColumnHeader,btDataHeader,btGroupHeader,btDataband,btGroupFooter,
                              btDataFooter,btColumnFooter,btReportSummary,btPageFooter,btChild);
                              btDataFooter,btColumnFooter,btReportSummary,btPageFooter,btChild);
   TFPReportBandTypes = Set of TFPReportBandType;
   TFPReportBandTypes = Set of TFPReportBandType;
+
+  TFPReportBandMultiplicity = (bmUnrestricted,bmOncePerPage,bmOncePerDataloop);
+  TFPReportBandMultiplicities = Set of TFPReportBandMultiplicity;
+
   TFPReportMemoOption     = (
   TFPReportMemoOption     = (
             moSuppressRepeated,
             moSuppressRepeated,
             moHideZeros,
             moHideZeros,
@@ -218,6 +221,17 @@ const
     clDkGray             // Child
     clDkGray             // Child
   );
   );
 
 
+     {btUnknown,btPageHeader,btReportTitle,btColumnHeader,
+      btDataHeader,btGroupHeader,btDataband,btGroupFooter,
+      btDataFooter,btColumnFooter,btReportSummary,btPageFooter,
+      btChild}
+
+  FPReportBandMultiplicity : Array[TFPReportBandType] of TFPReportBandMultiplicity
+    = (bmUnrestricted,bmOncePerPage,bmOncePerPage,bmOncePerPage,
+       bmOncePerDataloop,bmUnrestricted,bmOncePerDataloop,bmUnrestricted,
+       bmOncePerDataloop,bmOncePerPage,bmOncePerPage,bmOncePerPage,
+       bmUnrestricted);
+
 const
 const
   cMMperInch = 25.4;
   cMMperInch = 25.4;
   cCMperInch = 2.54;
   cCMperInch = 2.54;
@@ -849,12 +863,17 @@ type
     procedure PrepareObjects(aRTParent: TFPReportElement); override;
     procedure PrepareObjects(aRTParent: TFPReportElement); override;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure DoWriteLocalProperties(AWriter: TFPReportStreamer; AOriginal: TFPReportElement = nil); override;
     procedure DoWriteLocalProperties(AWriter: TFPReportStreamer; AOriginal: TFPReportElement = nil); override;
+    Function GetPageIndex : Integer; Virtual;
+    Procedure SetPageIndex(aIndex : Integer);
   public
   public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
     destructor  Destroy; override;
     destructor  Destroy; override;
-    Function    PageIndex : Integer;
     procedure   Assign(Source: TPersistent); override;
     procedure   Assign(Source: TPersistent); override;
     procedure   ReadElement(AReader: TFPReportStreamer); override;
     procedure   ReadElement(AReader: TFPReportStreamer); override;
+    function    FindBandWithType(ABandType: TFPReportBandType): TFPReportCustomBand;
+    function    FindBandWithTypeAndData(ABandType: TFPReportBandType; aData: TFPReportData): TFPReportCustomBand;
+    Function    CheckBandMultiplicity(aBand : TFPReportCustomBand) : Boolean;
+    function CheckBandMultiplicity(aBandType: TFPReportBandType; aData: TFPReportData): Boolean;
     function    FindBand(ABand: TFPReportBandClass): TFPReportCustomBand;
     function    FindBand(ABand: TFPReportBandClass): TFPReportCustomBand;
     property    PageSize: TFPReportPageSize read FPageSize write SetPageSize;
     property    PageSize: TFPReportPageSize read FPageSize write SetPageSize;
     property    Margins: TFPReportMargins read FMargins write SetMargins;
     property    Margins: TFPReportMargins read FMargins write SetMargins;
@@ -868,7 +887,8 @@ type
     property    ColumnGap: TFPReportUnits read FColumnGap write SetColumnGap default 0;
     property    ColumnGap: TFPReportUnits read FColumnGap write SetColumnGap default 0;
     property    ColumnLayout: TFPReportColumnLayout read FColumnLayout write SetColumnLayout default clVertical;
     property    ColumnLayout: TFPReportColumnLayout read FColumnLayout write SetColumnLayout default clVertical;
     property    Font: TFPReportFont read FFont write SetFont;
     property    Font: TFPReportFont read FFont write SetFont;
-    Property OnPageSizeChange : TNotifyEvent Read FOnPageSizeChange Write FOnPageSizeChange;
+    Property    OnPageSizeChange : TNotifyEvent Read FOnPageSizeChange Write FOnPageSizeChange;
+    property    PageIndex : Integer Read GetPageIndex Write SetPageIndex;
   end;
   end;
   TFPReportCustomPageClass = Class of TFPReportCustomPage;
   TFPReportCustomPageClass = Class of TFPReportCustomPage;
 
 
@@ -883,6 +903,7 @@ type
     property Margins;
     property Margins;
     property PageSize;
     property PageSize;
     property Orientation;
     property Orientation;
+    Property PageIndex;
   end;
   end;
 
 
 
 
@@ -907,6 +928,7 @@ type
     procedure   SetChildBand(AValue: TFPReportCustomChildBand);
     procedure   SetChildBand(AValue: TFPReportCustomChildBand);
     procedure   SetFont(AValue: TFPReportFont);
     procedure   SetFont(AValue: TFPReportFont);
     procedure   SetKeepTogetherWithChildren(pKeepTogetherWithChildren: Boolean); virtual;
     procedure   SetKeepTogetherWithChildren(pKeepTogetherWithChildren: Boolean); virtual;
+    procedure SetMainBand(AValue: TFPReportCustomBand);
     procedure   SetUseParentFont(AValue: boolean);
     procedure   SetUseParentFont(AValue: boolean);
     procedure   SetVisibleOnPage(AValue: TFPReportVisibleOnPage);
     procedure   SetVisibleOnPage(AValue: TFPReportVisibleOnPage);
   protected
   protected
@@ -917,7 +939,7 @@ type
     procedure   SetDataFromName(AName : String); virtual;
     procedure   SetDataFromName(AName : String); virtual;
     procedure   SetParent(const AValue: TFPReportElement); override;
     procedure   SetParent(const AValue: TFPReportElement); override;
     procedure   CreateRTLayout; override;
     procedure   CreateRTLayout; override;
-    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    Procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
     function    PrepareObject(aRTParent: TFPReportElement): TFPReportElement; override;
     function    PrepareObject(aRTParent: TFPReportElement): TFPReportElement; override;
     { this is normally run against the runtime version of the Band instance. }
     { this is normally run against the runtime version of the Band instance. }
     procedure   RecalcLayout; override;
     procedure   RecalcLayout; override;
@@ -951,7 +973,7 @@ type
     function    EvaluateVisibility: boolean; override;
     function    EvaluateVisibility: boolean; override;
     property    ChildBand: TFPReportCustomChildBand read FChildBand write SetChildBand;
     property    ChildBand: TFPReportCustomChildBand read FChildBand write SetChildBand;
     property    ParentBand: TFPReportCustomBand read FParentBand;
     property    ParentBand: TFPReportCustomBand read FParentBand;
-    property    MainBand: TFPReportCustomBand read FMainBand;
+    property    MainBand: TFPReportCustomBand read FMainBand Write SetMainBand;
     property    Page : TFPReportCustomPage read GetReportPage;
     property    Page : TFPReportCustomPage read GetReportPage;
   end;
   end;
   TFPReportCustomBandClass = Class of TFPReportCustomBand;
   TFPReportCustomBandClass = Class of TFPReportCustomBand;
@@ -1585,6 +1607,7 @@ type
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
     destructor  Destroy; override;
     destructor  Destroy; override;
     class function ReportKindToResultType(const AType: TFPReportFieldKind): TResultType;
     class function ReportKindToResultType(const AType: TFPReportFieldKind): TResultType;
+    Function StreamToReportElements(aStream : TStream) : TFPObjectList;
     Procedure Clear;
     Procedure Clear;
     Procedure SaveDataToNames;
     Procedure SaveDataToNames;
     Procedure RestoreDataFromNames;
     Procedure RestoreDataFromNames;
@@ -1592,6 +1615,7 @@ type
     procedure ReadElement(AReader: TFPReportStreamer); override;
     procedure ReadElement(AReader: TFPReportStreamer); override;
     procedure AddPage(APage: TFPReportCustomPage);
     procedure AddPage(APage: TFPReportCustomPage);
     procedure RemovePage(APage: TFPReportCustomPage);
     procedure RemovePage(APage: TFPReportCustomPage);
+    function  IndexOfPage(aPage: TFPReportCustomPage): Integer;
     function  FindRecursive(const AName: string): TFPReportElement;
     function  FindRecursive(const AName: string): TFPReportElement;
     procedure Validate;
     procedure Validate;
     procedure Validate(aErrors: TStrings);
     procedure Validate(aErrors: TStrings);
@@ -6047,12 +6071,27 @@ begin
 end;
 end;
 
 
 procedure TFPReportComponent.ReadElement(AReader: TFPReportStreamer);
 procedure TFPReportComponent.ReadElement(AReader: TFPReportStreamer);
+
+Var
+  N : String;
+  C : TComponent;
 begin
 begin
   try
   try
-    Name := AReader.ReadString('Name', 'UnknownName');
+    N := AReader.ReadString('Name', 'UnknownName');
+    if Assigned(Owner) and (N<>'') then
+      begin
+      C:=Owner.FindComponent(N);
+      if (C<>Self) and (C<>Nil) then
+        begin
+        N:=AllocateName;
+        AReader.Modified;
+        end;
+      end;
+    Name:=N;
   except
   except
     On E : EComponentError do
     On E : EComponentError do
       begin
       begin
+      // This should never happen, but we leave it in place just in case.
       Name:=AllocateName;
       Name:=AllocateName;
       AReader.Modified;
       AReader.Modified;
       end;
       end;
@@ -7097,20 +7136,24 @@ var
   i: integer;
   i: integer;
   c: TFPReportElement;
   c: TFPReportElement;
   lName: string;
   lName: string;
+  o : TComponent;
+
 begin
 begin
   inherited ReadElement(AReader);
   inherited ReadElement(AReader);
   E := AReader.FindChild('Children');
   E := AReader.FindChild('Children');
+  O:=Report;
+  if (O=Nil) then
+    O:=Self.Owner;
   if Assigned(E) then
   if Assigned(E) then
   begin
   begin
     AReader.PushElement(E);
     AReader.PushElement(E);
     for i := 0 to AReader.ChildCount-1 do
     for i := 0 to AReader.ChildCount-1 do
     begin
     begin
       E := AReader.GetChild(i);
       E := AReader.GetChild(i);
-
       AReader.PushElement(E); // child index is the identifier
       AReader.PushElement(E); // child index is the identifier
       try
       try
         lName := AReader.CurrentElementName;
         lName := AReader.CurrentElementName;
-        c := gElementFactory.CreateInstance(lName, Report);
+        c := gElementFactory.CreateInstance(lName,O);
         c.Parent:=Self;
         c.Parent:=Self;
         c.ReadElement(AReader);
         c.ReadElement(AReader);
       finally
       finally
@@ -7393,19 +7436,85 @@ begin
   inherited ReadElement(AReader);
   inherited ReadElement(AReader);
 end;
 end;
 
 
+function TFPReportCustomPage.CheckBandMultiplicity(aBand: TFPReportCustomBand): Boolean;
+
+Var
+  D : TFPReportData;
+
+begin
+  if aBand is TFPReportCustomBandWithData then
+    D:=TFPReportCustomBandWithData(aBand).GetData
+  else
+    D:=Nil;
+  Result:=CheckBandMultiplicity(aBand.ReportBandType,D);
+end;
+
+function TFPReportCustomPage.CheckBandMultiplicity(aBandType: TFPReportBandType; aData: TFPReportData): Boolean;
+
+Var
+  M: TFPReportBandMultiplicity;
+
+begin
+  M:=FPReportBandMultiplicity[aBandType];
+  Case M of
+    bmUnrestricted : Result:=True;
+    bmOncePerPage : Result:=FindBandWithType(aBandType)=Nil;
+    bmOncePerDataLoop :
+      begin
+      Result:=aData=Nil;
+      if not Result then
+        Result:=FindBandWithTypeAndData(aBandType,aData)=Nil;
+      end;
+  end;
+end;
+
+function TFPReportCustomPage.FindBandWithType(ABandType: TFPReportBandType): TFPReportCustomBand;
+
+var
+  i: integer;
+
+begin
+  Result := nil;
+  I:=0;
+  While (Result=Nil) and (I<BandCount) do
+    begin
+    if Bands[i].ReportBandType=ABandType then
+      Result := Bands[i];
+    Inc(I);
+    end;
+end;
+
+function TFPReportCustomPage.FindBandWithTypeAndData(ABandType: TFPReportBandType; aData: TFPReportData): TFPReportCustomBand;
+var
+  i: integer;
+
+begin
+  Result := nil;
+  I:=0;
+  While (Result=Nil) and (I<BandCount) do
+    begin
+    if (Bands[i].ReportBandType=ABandType) then
+      if Bands[i] is TFPReportCustomBandWithData then
+        if TFPReportCustomBandWithData(Bands[i]).GetData=aData then
+          Result := Bands[i];
+    Inc(I);
+    end;
+end;
+
 function TFPReportCustomPage.FindBand(ABand: TFPReportBandClass): TFPReportCustomBand;
 function TFPReportCustomPage.FindBand(ABand: TFPReportBandClass): TFPReportCustomBand;
+
 var
 var
   i: integer;
   i: integer;
+
 begin
 begin
   Result := nil;
   Result := nil;
-  for i := 0 to BandCount-1 do
-  begin
-    if Bands[i] is ABand then
+  I:=0;
+  While (Result=Nil) and (I<BandCount) do
     begin
     begin
+    if Bands[i] is ABand then
       Result := Bands[i];
       Result := Bands[i];
-      Break;
+    Inc(I);
     end;
     end;
-  end;
 end;
 end;
 
 
 procedure TFPReportCustomPage.Notification(AComponent: TComponent; Operation: TOperation);
 procedure TFPReportCustomPage.Notification(AComponent: TComponent; Operation: TOperation);
@@ -7438,11 +7547,22 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TFPReportCustomPage.PageIndex: Integer;
+function TFPReportCustomPage.GetPageIndex: Integer;
 begin
 begin
   Result:=-1;
   Result:=-1;
-  If (Owner<>Nil) then
-    Result:=ComponentIndex;
+  If (Report<>Nil) then
+    Result:=Report.IndexOfPage(Self);
+end;
+
+procedure TFPReportCustomPage.SetPageIndex(aIndex: Integer);
+
+Var
+  I : Integer;
+
+begin
+  I:=PageIndex;
+  if Assigned(Report) then
+    Report.FPages.Move(I,aIndex);
 end;
 end;
 
 
 function TFPReportCustomPage.GetBandCount: integer;
 function TFPReportCustomPage.GetBandCount: integer;
@@ -7530,6 +7650,15 @@ end;
 
 
 { TFPCustomReport }
 { TFPCustomReport }
 
 
+function TFPCustomReport.IndexOfPage(aPage : TFPReportCustomPage) : Integer;
+
+begin
+  if Assigned(FPages) then
+    Result:=FPages.IndexOf(aPage)
+  else
+    Result:=-1;
+end;
+
 function TFPCustomReport.GetPage(AIndex: integer): TFPReportCustomPage;
 function TFPCustomReport.GetPage(AIndex: integer): TFPReportCustomPage;
 begin
 begin
   if Assigned(FPages) then
   if Assigned(FPages) then
@@ -7944,6 +8073,47 @@ begin
   end;
   end;
 end;
 end;
 
 
+Function TFPCustomReport.StreamToReportElements(aStream: TStream): TFPObjectList;
+
+Var
+  I,aCount : Integer;
+  S : TFPReportJSONStreamer;
+  aName : String;
+  E : TObject;
+  C : TFPReportElement;
+
+begin
+  Result:=TFPObjectList.Create(True);
+  try
+    S:=TFPReportJSONStreamer.Create(Nil);
+    try
+      S.InitFromStream(aStream);
+      for i := 0 to S.ChildCount-1 do
+        begin
+        E:=S.GetChild(i);
+        S.PushElement(E); // child index is the identifier
+        try
+          aName := S.CurrentElementName;
+          if aName='Page' then
+            C:=TFPReportCustomPage.Create(Self)
+          else
+            c:=gElementFactory.CreateInstance(aName, Self);
+          c.Parent:=Nil;
+          c.ReadElement(S);
+          Result.Add(C);
+        finally
+          S.PopElement;
+        end;
+        end;
+    finally
+      S.Free;
+    end;
+  except
+     FreeAndNil(Result);
+     Raise;
+  end;
+end;
+
 procedure TFPCustomReport.InitializeExpressionVariables;
 procedure TFPCustomReport.InitializeExpressionVariables;
 
 
 var
 var
@@ -8620,6 +8790,16 @@ begin
   FKeepTogetherWithChildren := pKeepTogetherWithChildren;
   FKeepTogetherWithChildren := pKeepTogetherWithChildren;
 end;
 end;
 
 
+procedure TFPReportCustomBand.SetMainBand(AValue: TFPReportCustomBand);
+begin
+  if FMainBand=AValue then Exit;
+  if Assigned(FMainBand) then
+    FMainBand.RemoveFreeNotification(Self);
+  FMainBand:=AValue;
+  if Assigned(FMainBand) then
+    FMainBand.FreeNotification(Self);
+end;
+
 procedure TFPReportCustomBand.SetUseParentFont(AValue: boolean);
 procedure TFPReportCustomBand.SetUseParentFont(AValue: boolean);
 
 
 Var
 Var
@@ -8695,7 +8875,9 @@ begin
   if Operation=opRemove then
   if Operation=opRemove then
     begin
     begin
     if AComponent=FChildBand then
     if AComponent=FChildBand then
-      FChildBand:=Nil;
+      FChildBand:=Nil
+    else if AComponent=FMainband then
+      FMainBand:=nil;
     end;
     end;
 end;
 end;
 
 
@@ -8734,9 +8916,9 @@ begin
   if Source is TFPReportCustomBand then
   if Source is TFPReportCustomBand then
   begin
   begin
     E := TFPReportCustomBand(Source);
     E := TFPReportCustomBand(Source);
-    FMainBand := E.MainBand;
+    MainBand := E.MainBand;
     FIsColumnType := E.FIsColumnType;
     FIsColumnType := E.FIsColumnType;
-    FChildBand := E.ChildBand;
+    ChildBand := E.ChildBand;
     FStretchMode := E.StretchMode;
     FStretchMode := E.StretchMode;
     FVisibleOnPage := E.VisibleOnPage;
     FVisibleOnPage := E.VisibleOnPage;
     FBandPosition := E.BandPosition;
     FBandPosition := E.BandPosition;

+ 18 - 0
packages/fcl-report/src/fpreportstreamer.pp

@@ -129,6 +129,7 @@ type
   public
   public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
     destructor  Destroy; override;
     destructor  Destroy; override;
+    Procedure   InitFromStream(aStream : TStream);
     function    StreamToHex(S: TStream): String;
     function    StreamToHex(S: TStream): String;
     function    StreamsEqual(S1, S2: TStream): Boolean;
     function    StreamsEqual(S1, S2: TStream): Boolean;
     function    HexToStringStream(S: String): TStringStream;
     function    HexToStringStream(S: String): TStringStream;
@@ -147,6 +148,7 @@ resourcestring
   SErrStackEmpty = 'Element stack is empty';
   SErrStackEmpty = 'Element stack is empty';
   SErrNoCurrentElement = 'No current element to find node %s below';
   SErrNoCurrentElement = 'No current element to find node %s below';
   SErrNodeNotElement = 'Node %s is not an element node';
   SErrNodeNotElement = 'Node %s is not an element node';
+  SErrNotAValidJSONObject = 'Stream does not contain not a valid JSON object';
 
 
 const
 const
   { Summary of ISO 8601  http://www.cl.cam.ac.uk/~mgk25/iso-time.html }
   { Summary of ISO 8601  http://www.cl.cam.ac.uk/~mgk25/iso-time.html }
@@ -591,6 +593,22 @@ begin
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
+procedure TFPReportJSONStreamer.InitFromStream(aStream: TStream);
+
+var
+  D : TJSONData;
+
+begin
+  D:=GetJSON(aStream);
+  if not (D is TJSONObject) then
+    begin
+    D.Free;
+    Raise EReportDOM.Create(SErrNotAValidJSONObject);
+    end;
+  OwnsJSON:=True;
+  JSON:=D as TJSONObject;
+end;
+
 function TFPReportJSONStreamer.StreamToHex(S: TStream): String;
 function TFPReportJSONStreamer.StreamToHex(S: TStream): String;
 var
 var
   T: TMemoryStream;
   T: TMemoryStream;