frxpreviewpages.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

    c:TfrxComponent;
  begin
    Result:= nil;
    if (CompareText(Parent.ClassName, 'TfrxCrossView') = 0) or
      (CompareText(Parent.ClassName, 'TfrxDBCrossView') = 0) or
      (Parent is TfrxDialogComponent) then Exit;

    c:= TfrxComponent(Parent.NewInstance);
    c.Create(Parent1);
    c.Assign(Parent);
    c.Name:= Parent.Name;
    originals.Add(Parent);
    copies.Add(c);

    for i:= 0 to Parent.Objects.Count-1 do
      EnumObjects(Parent.Objects[i], c);
    Result:= c;
  end;

begin
  xs:= TfrxXMLSerializer.Create(nil);
  originals:= TList.Create;
  copies:= TList.Create;

  try
    p:= TfrxReportPage(EnumObjects(Page, nil));
    THackComponent(p).FOriginalComponent:= Page;
    FSourcePages.Add(p);

    for i:= 1 to copies.Count-1 do
    begin
      c1:= copies[i];
      c2:= originals[i];

      THackComponent(c2).FOriginalComponent:= c1;
      THackComponent(c1).FOriginalComponent:= c2;

      if c1 is TfrxBand then
        s:= 'b' else
        s:= LowerCase(c1.BaseName[1]);
      s:= FDictionary.AddUnique(s, 'Page'+IntToStr(FSourcePages.Count-1)+
        '.'+c1.Name, c1);
      if c1.DefaultDiff then
        THackComponent(c1).FBaseName:= c1.ClassName else
        THackComponent(c1).FBaseName:= xs.WriteComponentStr(c1);

      THackComponent(c1).FAliasName:= s;
      THackComponent(c2).FAliasName:= s;
    end;

  finally
    originals.Free;
    copies.Free;
    xs.Free;
  end;
end;

procedure TfrxPreviewPages.AddToSourcePage(Obj:TfrxComponent);
var
  NewObj:TfrxComponent;
  Page:TfrxReportPage;
  s:String;
  xs:TfrxXMLSerializer;
begin
  xs:= TfrxXMLSerializer.Create(nil);
  Page:= FSourcePages[FSourcePages.Count-1];
  NewObj:= TfrxComponent(Obj.NewInstance);
  NewObj.Create(Page);
  NewObj.Assign(Obj);
  NewObj.CreateUniqueName;

  s:= FDictionary.AddUnique(LowerCase(NewObj.BaseName[1]),
    'Page'+IntToStr(FSourcePages.Count-1)+'.'+NewObj.Name, NewObj);
  if NewObj.DefaultDiff then
    THackComponent(NewObj).FBaseName:= NewObj.ClassName else
    THackComponent(NewObj).FBaseName:= xs.WriteComponentStr(NewObj);

  THackComponent(Obj).FOriginalComponent:= NewObj;
  THackComponent(Obj).FAliasName:= s;
  THackComponent(NewObj).FAliasName:= s;
  xs.Free;
end;

procedure TfrxPreviewPages.Finish;
var
  i:Integer;
begin
  ClearPageCache;
  { avoid bug with multiple PrepareReport(False) }
  for i:= 0 to FSourcePages.Count-1 do
    THackComponent(FSourcePages[i]).FOriginalComponent:= nil;
  Report.InternalOnProgressStop(ptRunning);
end;

function TfrxPreviewPages.BandExists(Band:TfrxBand):Boolean;
var
  i:Integer;
  c:TfrxComponent;
begin
  Result:= False;
  for i:= 0 to CurXMLPage.Count-1 do
  begin
    c:= GetObject(CurXMLPage[i].Name);
    if c<>nil then
      if (THackComponent(c).FOriginalComponent = Band) or
         ((Band is TfrxPageFooter) and (c is TfrxPageFooter)) or
         ((Band is TfrxColumnFooter) and (c is TfrxColumnFooter)) then
      begin
        Result:= True;
        break;
      end;
  end;
end;

function TfrxPreviewPages.GetLastY:Extended;
var
  i:Integer;
  c:TfrxComponent;
  s:String;
  y:Extended;
begin
  Result:= 0;
  for i:= 0 to CurXMLPage.Count-1 do
  begin
    c:= GetObject(CurXMLPage[i].Name);
    if c is TfrxBand then
      if not (c is TfrxPageFooter) then
      begin
        s:= CurXMLPage[i].Prop['t'];
        if s<>'' then
          y:= frxStrToFloat(s) else
          y:= c.Top;
        s:= CurXMLPage[i].Prop['h'];
        if s<>'' then
          y:= y+frxStrToFloat(s) else
          y:= y+c.Height;
        if y > Result then
          Result:= y;
      end;
  end;
end;

procedure TfrxPreviewPages.CutObjects(APosition:Integer);
var
  xi:TfrxXMLItem;
begin
  xi:= FXMLDoc.Root.FindItem('cutted');
  while APosition < CurXMLPage.Count do
    xi.AddItem(CurXMLPage[APosition]);
end;

procedure TfrxPreviewPages.PasteObjects(X, Y:Extended);
var
  xi:TfrxXMLItem;
  LeftX, TopY, CorrX, CorrY:Extended;

  procedure CorrectX(xi:TfrxXMLItem);
  var
    X:Extended;
  begin
    if xi.Prop['l']<>'' then
      X:= frxStrToFloat(xi.Prop['l']) else
      X:= 0;
    X:= X+CorrX;
    xi.Prop['l']:= FloatToStr(X);
  end;

  procedure CorrectY(xi:TfrxXMLItem);
  var
    Y:Extended;
  begin
    if xi.Prop['t']<>'' then
      Y:= frxStrToFloat(xi.Prop['t']) else
      Y:= 0;
    Y:= Y+CorrY;
    xi.Prop['t']:= FloatToStr(Y);
  end;

begin
  xi:= FXMLDoc.Root.FindItem('cutted');

  if xi.Count > 0 then
  begin
    if xi[0].Prop['l']<>'' then
      LeftX:= frxStrToFloat(xi[0].Prop['l']) else
      LeftX:= 0;
    CorrX:= X-LeftX;

    if xi[0].Prop['t']<>'' then
      TopY:= frxStrToFloat(xi[0].Prop['t']) else
      TopY:= 0;
    CorrY:= Y-TopY;

    while xi.Count > 0 do
    begin
      CorrectX(xi[0]);
      CorrectY(xi[0]);
      CurXMLPage.AddItem(xi[0]);
    end;
  end;

  xi.Free;
end;

procedure TfrxPreviewPages.DoLoadFromStream;
var
  Compressor:TfrxCustomCompressor;
begin
  Compressor:= nil;
  if frxCompressorClass<>nil then
  begin
    FAllowPartialLoading:= False;
    Compressor:= TfrxCustomCompressor(frxCompressorClass.NewInstance);
    Compressor.Create(nil);
    Compressor.Report:= Report;
    Compressor.IsFR3File:= False;
    try
      Compressor.CreateStream;
      Compressor.Decompress(FTempStream);
      FTempStream:= Compressor.Stream;
    except
      Compressor.Free;
      Report.Errors.Add(frxResources.Get('clDecompressError'));
      if not Report.EngineOptions.SilentMode then
        frxErrorMsg(frxResources.Get('clErrors')+#13#10+Report.Errors.Text);
      Exit;
    end;
  end;
  FXMLDoc.LoadFromStream(FTempStream, FAllowPartialLoading);
  AfterLoad;
  if Compressor<>nil then
    Compressor.Free;
end;

procedure TfrxPreviewPages.DoSaveToStream;
var
  Compressor:TfrxCustomCompressor;
  StreamTo:TStream;
begin
  StreamTo:= FTempStream;
  Compressor:= nil;
  if frxCompressorClass<>nil then
  begin
    Compressor:= TfrxCustomCompressor(frxCompressorClass.NewInstance);
    Compressor.Create(nil);
    Compressor.Report:= Report;
    Compressor.IsFR3File:= False;
    Compressor.CreateStream;
    StreamTo:= Compressor.Stream;
  end;
  try
    BeforeSave;
    FXMLDoc.SaveToStream(StreamTo);
  finally
    if Compressor<>nil then
    begin
      try
        Compressor.Compress(FTempStream);
      finally
        Compressor.Free;
      end;
    end;
  end;
end;

procedure TfrxPreviewPages.LoadFromStream(Stream:TStream;
  AllowPartialLoading:Boolean = False);
begin
  Clear;
  FTempStream:= Stream;
  FAllowPartialLoading:= AllowPartialLoading;
  if Report.EngineOptions.ReportThread<>nil then
    THackThread(Report.EngineOptions.ReportThread).Synchronize(DoLoadFromStream)
  else
    DoLoadFromStream;
end;

procedure TfrxPreviewPages.SaveToStream(Stream:TStream);
begin
  FTempStream:= Stream;
  if Report.EngineOptions.ReportThread<>nil then
    THackThread(Report.EngineOptions.ReportThread).Synchronize(DoSaveToStream)
  else
    DoSaveToStream;
end;

function TfrxPreviewPages.LoadFromFile(const FileName:String;
  ExceptionIfNotFound:Boolean):Boolean;
var
  Stream:TFileStream;
begin
  Result:= FileExists(FileName);
  if Result or ExceptionIfNotFound then
  begin
    Stream:= TFileStream.Create(FileName, fmOpenRead+fmShareDenyWrite);
    try
      LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
{ Clear;
    FXMLDoc.LoadFromFile(FileName);
    AfterLoad;}
  end;
end;

procedure TfrxPreviewPages.SaveToFile(const FileName:String);
var
  Stream:TFileStream;
begin
  Stream:= TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
{ BeforeSave;
  FXMLDoc.SaveToFile(FileName);
  ClearPageCache;
  AfterLoad;}
end;

procedure TfrxPreviewPages.AfterLoad;
var
  i:Integer;
  xs:TfrxXMLSerializer;
  xi:TfrxXMLItem;
  p:TfrxReportPage;

{ store source objects' properties in the FBaseName to get it later in the GetPage }
  procedure DoProps(p:TfrxReportPage);
  var
    i:Integer;
    l:TList;
    c:THackComponent;
  begin
    l:= p.AllObjects;
    for i:= 0 to l.Count-1 do
    begin
      c:= l[i];
      c.FBaseName:= xs.WriteComponentStr(c);
    end;
  end;

{ fill FDictionary.Objects }
  procedure FillDictionary;
  var
    i:Integer;
    Name, PageName, ObjName:String;
    PageN:Integer;
  begin
    xi:= FXMLDoc.Root.FindItem('dictionary');
    FDictionary.Clear;
    for i:= 0 to xi.Count-1 do
    begin
      Name:= Copy(xi[i].Text, 7, Length(xi[i].Text)-7);
      PageName:= Copy(Name, 1, Pos('.', Name)-1);
      ObjName:= Copy(Name, Pos('.', Name)+1, 255);

      PageN:= StrToInt(Copy(PageName, 5, 255));
      FDictionary.Add(xi[i].Name, Name,
        TfrxReportPage(FSourcePages[PageN]).FindObject(ObjName));
    end;
  end;

begin
  FPagesItem:= FXMLDoc.Root.FindItem('previewpages');
  xs:= TfrxXMLSerializer.Create(nil);

{ load the report settings }
  xi:= FXMLDoc.Root.FindItem('report');
  if xi.Count > 0 then
    xs.ReadRootComponent(Report, xi[0]);

{ build sourcepages }
  try
    xi:= FXMLDoc.Root.FindItem('sourcepages');
    ClearSourcePages;

    for i:= 0 to xi.Count-1 do
    begin
      if CompareText(xi[i].Name, 'TfrxDMPPage') = 0 then
        p:= TfrxDMPPage.Create(nil) else
        p:= TfrxReportPage.Create(nil);
      xs.ReadRootComponent(p, xi[i]);
      DoProps(p);
      FSourcePages.Add(p);
    end;
    xi.Clear;

  finally
    xs.Free;
  end;

{ build the dictionary }
  FillDictionary;
end;

procedure TfrxPreviewPages.BeforeSave;
var
  i:Integer;
  xs:TfrxXMLSerializer;
  xi:TfrxXMLItem;
begin
  FPagesItem:= FXMLDoc.Root.FindItem('previewpages');
  xs:= TfrxXMLSerializer.Create(nil);

{ upload the report settings }
  xi:= FXMLDoc.Root.FindItem('report');
  xi.Clear;
  xi:= xi.Add;
  xi.Name:= Report.ClassName;
  xi.Text:= 'DotMatrixReport="'+frxValueToXML(Report.DotMatrixReport)+
    '" PreviewOptions.OutlineVisible="'+frxValueToXML(Report.PreviewOptions.OutlineVisible)+
    '" PreviewOptions.OutlineWidth="'+frxValueToXML(Report.PreviewOptions.OutlineWidth)+'"';

{ upload the sourcepages }
  try
    xi:= FXMLDoc.Root.FindItem('sourcepages');
    xi.Clear;
    for i:= 0 to FSourcePages.Count-1 do
      xs.WriteRootComponent(FSourcePages[i], True, xi.Add);

  finally
    xs.Free;
  end;

{ upload the dictionary }
  xi:= FXMLDoc.Root.FindItem('dictionary');
  xi.Clear;
  for i:= 0 to FDictionary.Names.Count-1 do
    with xi.Add do
    begin
      Name:= FDictionary.Names[i];
      Text:= 'name="'+FDictionary.GetSourceName(Name)+'"';
    end;
end;

function TfrxPreviewPages.GetObject(const Name:String):TfrxComponent;
begin
  Result:= TfrxComponent(FDictionary.GetObject(Name));
end;

function TfrxPreviewPages.GetPage(Index:Integer):TfrxReportPage;
var
  xi:TfrxXMLItem;
  xs:TfrxXMLSerializer;
  i:Integer;
  Source:TfrxReportPage;

  procedure DoObjects(Item:TfrxXMLItem; Owner:TfrxComponent);
  var
    i:Integer;
    c, c0:TfrxComponent;
  begin
    for i:= 0 to Item.Count-1 do
    begin
      c0:= GetObject(Item[i].Name);
      { object not found in the dictionary }
      if c0 = nil then
        c:= xs.ReadComponentStr(Owner, Item[i].Name+' '+Item[i].Text)
      else
      begin
        c:= xs.ReadComponentStr(Owner, THackComponent(c0).FBaseName+' '+Item[i].Text);
        c.Name:= c0.Name;
      end;
      c.Parent:= Owner;

      DoObjects(Item[i], c);
    end;
  end;

begin
  Result:= nil;
  if Count = 0 then Exit;

  { check pagecache first }
  if not Engine.Running then
  begin
    i:= FPageCache.IndexOf(IntToStr(Index));
    if i<>-1 then
    begin
      Result:= TfrxReportPage(FPageCache.Objects[i]);
      FPageCache.Exchange(i, 0);
      Exit;
    end;
  end;

  xs:= TfrxXMLSerializer.Create(nil);
  try
    { load the page item }
    xi:= FPagesItem[Index];
    FXMLDoc.LoadItem(xi);

    if CompareText(xi.Name, 'TfrxReportPage') = 0 then
    begin
      { page item do not refer to the originalpages }
      Result:= TfrxReportPage.Create(nil);
      xs.ReadRootComponent(Result, xi);
    end
    else if CompareText(xi.Name, 'TfrxDMPPage') = 0 then
    begin
      { page item do not refer to the originalpages }
      Result:= TfrxDMPPage.Create(nil);
      xs.ReadRootComponent(Result, xi);
    end
    else
    begin
      Source:= FSourcePages[StrToInt(Copy(xi.Name, 5, 5))];
      { create reportpage and assign properties from original page }
      if Source is TfrxDMPPage then
        Result:= TfrxDMPPage.Create(nil) else
        Result:= TfrxReportPage.Create(nil);
      Result.Assign(Source);

      { create objects }
      DoObjects(xi, Result);
    end;
  finally
    xs.Free;
  end;

  { update aligned objects }
  Result.AlignChildren;

  { add this page to the pagecache }
  FPageCache.InsertObject(0, IntToStr(Index), Result);
  i:= FPageCache.Count;

  { remove the least used item from the pagecache }
  if i > 50 then
  begin
    xi:= FPagesItem[StrToInt(FPageCache[i-1])];
    if Report.EngineOptions.UseFileCache and xi.Unloadable then
    begin
      FXMLDoc.UnloadItem(xi);
      xi.Clear;
    end;

    TfrxReportPage(FPageCache.Objects[i-1]).Free;
    FPageCache.Delete(i-1);
  end;
end;

function TfrxPreviewPages.GetPageSize(Index:Integer):TPoint;
var