frxpreviewpages.pas

这个是功能强大的报表软件

//    if AnsiCompareText(Item.Prop['text'], Text) = 0 then
//    if AnsiStrIComp(PAnsiChar(Item.Prop['text']), Text) = 0 then
    if AnsiCompareText(Item.Prop['text'], Text) = 0 then
{$ELSE}
    if AnsiCompareText(Item.Prop['text'], Text) = 0 then
{$ENDIF}
    begin
      Result := Item;
      Exit;
    end;
  end;
end;

function TfrxPreviewPages.GetAnchorPage(const Text: String): Integer;
var
  Item: TfrxXMLItem;
begin
  Item := FindAnchor(Text);
  if Item <> nil then
    Result := StrToInt(String(Item.Prop['page'])) + 1 else
    Result := 1;
end;

function TfrxPreviewPages.GetAnchorCurPosition: Integer;
begin
  Result := FXMLDoc.Root.FindItem('anchors').Count - 1;
end;

procedure TfrxPreviewPages.ShiftAnchors(From, NewTop: Integer);
var
  i, CorrY: Integer;
  AnchorRoot, Item: TfrxXMLItem;
begin
  AnchorRoot := FXMLDoc.Root.FindItem('anchors');
  if (From + 1 < 0) or (From + 1 >= AnchorRoot.Count) then Exit;

  Item := AnchorRoot[From + 1];
  CorrY := NewTop - StrToInt(String(Item.Prop['top']));

  for i := From + 1 to AnchorRoot.Count - 1 do
  begin
    Item := AnchorRoot[i];
    Item.Prop['page'] := IntToStr(StrToInt(Item.Prop['page']) + 1);
    Item.Prop['top'] := IntToStr(StrToInt(Item.Prop['top']) + CorrY);
  end;
end;

procedure TfrxPreviewPages.IncLogicalPageNumber;
var
  xi: TfrxXMLItem;
begin
  if Engine.FinalPass and Engine.DoublePass then Exit;

  Inc(FLogicalPageN);
  xi := FXMLDoc.Root.FindItem('logicalpagenumbers').Add;
  xi.Name := 'page';
  xi.Prop['n'] := IntToStr(FLogicalPageN);
end;

procedure TfrxPreviewPages.ResetLogicalPageNumber;
var
  i: Integer;
  xi, pageItem: TfrxXMLItem;
begin
  if Engine.FinalPass and Engine.DoublePass then Exit;

  pageItem := FXMLDoc.Root.FindItem('logicalpagenumbers');
  for i := CurPage downto FFirstPageIndex + 1 do
  begin
    if (i < 0) or (i >= pageItem.Count) then continue;
    xi := pageItem[i];
    xi.Prop['t'] := IntToStr(FLogicalPageN);
    if xi.Prop['n'] = '1' then
      break;
  end;
  FLogicalPageN := 0;
end;

function TfrxPreviewPages.GetLogicalPageNo: Integer;
var
  xi: TfrxXMLItem;
begin
  xi := FXMLDoc.Root.FindItem('logicalpagenumbers');
  if (CurPage < 0) or (CurPage >= xi.Count) then
    Result := CurPage - FirstPage + 1
  else
  begin
    xi := xi[CurPage];
    Result := StrToInt(String(xi.Prop['n']));
  end;
end;

function TfrxPreviewPages.GetLogicalTotalPages: Integer;
var
  xi: TfrxXMLItem;
begin
  xi := FXMLDoc.Root.FindItem('logicalpagenumbers');
  if (CurPage < 0) or (CurPage >= xi.Count) then
    Result := Engine.TotalPages - FirstPage
  else
  begin
    xi := xi[CurPage];
    if xi.Prop['t'] <> '' then
      Result := StrToInt(String(xi.Prop['t']))
    else
      Result := 0;
  end;
end;

procedure TfrxPreviewPages.AddObject(Obj: TfrxComponent);

  procedure DoAdd(c: TfrxComponent; Item: TfrxXMLItem);
  var
    i: Integer;
  begin
    if (not c.Visible) or not (csPreviewVisible in c.frComponentStyle) then Exit;

    with THackComponent(c) do
    begin
      Item := Item.Add;
      { the component that was created after report has been started }
      if FOriginalComponent = nil then
      begin
        Item.Name := ClassName;
        Item.Text := AllDiff(nil);
      end
      else
      begin
        { the component that exists in the report template }
        Item.Name := FAliasName;
        if Engine.FinalPass then
        begin
          if csDefaultDiff in frComponentStyle then
            Item.Text := AllDiff(FOriginalComponent) else
            Item.Text := Diff(FOriginalComponent);
        end
        else
          { we don't need to output all info on the first pass, only coordinates }
          Item.Text := InternalDiff(FOriginalComponent);
      end;
      Inc(FXMLSize, Length(Item.Name) + Length(Item.Text) + Item.InstanceSize + 16);
    end;

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

begin
  DoAdd(Obj, CurXMLPage);
end;

procedure TfrxPreviewPages.AddPage(Page: TfrxReportPage);
var
  xi: TfrxXMLItem;

  procedure UnloadPages;
  var
    i: Integer;
  begin
    if Report.EngineOptions.UseFileCache then
      if FXMLSize > Report.EngineOptions.MaxMemSize * 1024 * 1024 then
      begin
        for i := xi.Count - 2 downto 0 do
          if xi[i].Loaded then
            FXMLDoc.UnloadItem(xi[i]) else
            break;
        FXMLSize := 0;
      end;
  end;

  function GetSourceNo(Page: TfrxReportPage): Integer;
  var
    i: Integer;
  begin
    Result := -1;
    for i := 0 to FSourcePages.Count - 1 do
      if THackComponent(FSourcePages[i]).FOriginalComponent = Page then
      begin
        Result := i;
        break;
      end;
  end;

begin
  FPagesItem := FXMLDoc.Root.FindItem('previewpages');
  xi := FPagesItem;
  UnloadPages;

  CurPage := CurPage + 1;
  if (CurPage >= Count) or (AddPageAction = apAdd) then
  begin
    xi := xi.Add;
    xi.Name := 'page' + IntToStr(GetSourceNo(Page));
    if Count > 2 then
      xi.Unloadable := True;
    Report.InternalOnProgress(ptRunning, CurPage + 1);
    AddPageAction := apWriteOver;
    CurPage := Count - 1;
    IncLogicalPageNumber;
  end;
end;

procedure TfrxPreviewPages.AddSourcePage(Page: TfrxReportPage);
var
  p: TfrxReportPage;
  xs: TfrxXMLSerializer;
  xi: TfrxXMLItem;
  i: Integer;
  originals, copies: TList;
  c1, c2: TfrxComponent;
  s, s1: String;

  function EnumObjects(Parent, Parent1: TfrxComponent): TfrxComponent;
  var
    i: Integer;
    c: TfrxComponent;
  begin
    Result := nil;
    if not (csPreviewVisible in Parent.frComponentStyle) then Exit;

    c := TfrxComponent(Parent.NewInstance);
    c.Create(Parent1);
    if Parent is TfrxPictureView then
      TfrxPictureView(Parent).IsPictureStored := False;
    c.Assign(Parent);
    if Parent is TfrxPictureView then
      TfrxPictureView(Parent).IsPictureStored := True;
    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);
  xi := TfrxXMLItem.Create;
  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(String(s), 'Page' + IntToStr(FSourcePages.Count - 1) +
        '.' + c1.Name, c1);
      // speed optimization
      if c1 is TfrxCustomMemoView then
      begin
        TfrxCustomMemoView(c1).DataSet := nil;
        TfrxCustomMemoView(c1).DataField := '';
      end;
      if csDefaultDiff in c1.frComponentStyle then
        s1 := c1.ClassName
      else
        s1 := xs.WriteComponentStr(c1);
      THackComponent(c1).FBaseName := s1;
      THackComponent(c1).FAliasName := s;
      THackComponent(c2).FAliasName := s;
    end;

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

procedure TfrxPreviewPages.AddPicture(Picture: TfrxPictureView);
begin
  FPictureCache.AddPicture(Picture);
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(String(NewObj.BaseName[1])),
    'Page' + IntToStr(FSourcePages.Count - 1) + '.' + NewObj.Name, NewObj);
  if csDefaultDiff in NewObj.frComponentStyle 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.UpdatePageDimensions(Page: TfrxReportPage; Width, Height: Extended);
var
  SourcePage: TfrxReportPage;
  xi: TfrxXMLItem;
  i: Integer;
begin
  SourcePage := nil;
  for i := 0 to FSourcePages.Count - 1 do
  begin
    SourcePage := FSourcePages[i];
    if THackComponent(SourcePage).FOriginalComponent = Page then
      break;
  end;

  SourcePage.PaperSize := 256;
  SourcePage.PaperWidth := Width / fr01cm;
  SourcePage.PaperHeight := Height / fr01cm;
  xi := TfrxXMLItem.Create;
  xi.Text := THackComponent(SourcePage).FBaseName;
  xi.Prop['PaperSize'] := '256';
  xi.Prop['PaperWidth'] := frxFloatToStr(SourcePage.PaperWidth);
  xi.Prop['PaperHeight'] := frxFloatToStr(SourcePage.PaperHeight);
  THackComponent(SourcePage).FBaseName := xi.Text;
  xi.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) and not (c is TfrxOverlay) then
      begin
        s := String(CurXMLPage[i].Prop['t']);
        if s <> '' then
          y := frxStrToFloat(s) else
          y := c.Top;
        s := String(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;