frxpreview.pas

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

  finally
    Unlock;
  end;
end;

function TfrxPreview.FindText(SearchString: String; FromTop, IsCaseSensitive: Boolean): Boolean;
begin
  TextToFind := SearchString;
  CaseSensitive := IsCaseSensitive;
  if FromTop then
    FWorkspace.FLastFoundPage := 0 
  else
    FWorkspace.FLastFoundPage := PageNo - 1;
  LastFoundRecord := -1;

  FWorkspace.FindText;

  FAllowF3 := True;
  Result := TextFound;
end;

function TfrxPreview.FindTextFound: Boolean;
begin
  Result := TextFound;
end;

procedure TfrxPreview.FindTextClear;
begin
  LastFoundRecord := -1;
  FWorkspace.FLastFoundPage := 0; 
  TextFound := False;
  Invalidate;
end;


procedure TfrxPreview.PageSetupDlg;

var
  APage: TfrxReportPage;

  procedure UpdateReport;
  var
    i: Integer;
  begin
    for i := 0 to Report.PagesCount - 1 do
      if Report.Pages[i] is TfrxReportPage then
        with TfrxReportPage(Report.Pages[i]) do
        begin
          Orientation := APage.Orientation;
          PaperWidth := APage.PaperWidth;
          PaperHeight := APage.PaperHeight;
          PaperSize := APage.PaperSize;

          LeftMargin := APage.LeftMargin;
          RightMargin := APage.RightMargin;
          TopMargin := APage.TopMargin;
          BottomMargin := APage.BottomMargin;
        end;
  end;

begin

  if FRunning then Exit;

  APage := PreviewPages.Page[PageNo - 1];

  if Assigned(APage) then with TfrxPageSettingsForm.Create(Application) do
  begin
    Page := APage;
    Report := Self.Report;
    if ShowModal = mrOk then
    begin
      if NeedRebuild then
      begin
        UpdateReport;
        Self.Report.PrepareReport;
      end
      else
      begin
        try
          Lock;
          PreviewPages.ModifyPage(PageNo - 1, Page);
        finally
          Unlock;
        end;
      end;
    end;
    Free;
  end;

end;


procedure TfrxPreview.Find;

begin
  with TfrxSearchDialog.Create(Application) do
  begin
    if ShowModal = mrOk then
    begin
      TextToFind := TextE.Text;
      CaseSensitive := CaseCB.Checked;
      if TopCB.Checked then
        FWorkspace.FLastFoundPage := 0
      else
        FWorkspace.FLastFoundPage := PageNo - 1;
      LastFoundRecord := -1;
      FWorkspace.FindText;
    end;
    Free;
  end;

  FAllowF3 := True;

end;


procedure TfrxPreview.FindNext;

begin
  if FAllowF3 then
    FWorkspace.FindText;

end;


procedure TfrxPreview.Edit;

var
  r: TfrxReport;
  p: TfrxReportPage;
  SourcePage: TfrxPage;

  procedure RemoveBands;
  var
    i: Integer;
    l: TList;
    c: TfrxComponent;
  begin
    l := p.AllObjects;

    for i := 0 to l.Count - 1 do
    begin
      c := l[i];
      if c is TfrxView then
      begin
        TfrxView(c).DataField := '';
        TfrxView(c).DataSet := nil;
        TfrxView(c).Restrictions := [];
      end;

      if c.Parent <> p then
      begin
        c.Left := c.AbsLeft;
        c.Top := c.AbsTop;
        c.ParentFont := False;
        c.Parent := p;
        if (c is TfrxView) and (TfrxView(c).Align in [baBottom, baClient]) then
          TfrxView(c).Align := baNone;
      end;
    end;

    for i := 0 to l.Count - 1 do
    begin
      c := l[i];
      if c is TfrxBand then
        c.Free;
    end;
  end;

begin
  SourcePage := PreviewPages.Page[PageNo - 1];
  r := nil;
  if Assigned(SourcePage) then
  try

    if SourcePage is TfrxDMPPage then
      p := TfrxDMPPage.Create(nil) else
      p := TfrxReportPage.Create(nil);
    r := TfrxReport.Create(nil);
    p.AssignAll(SourcePage);
    p.Parent := r;
    RemoveBands;
    if r.DesignPreviewPage then
      try
        Lock;
        PreviewPages.ModifyPage(PageNo - 1, TfrxReportPage(r.Pages[0]));
      finally
        Unlock;
      end;
  except
  end;
  if r <> nil then
    r.Free;

end;

procedure TfrxPreview.EditTemplate;
var
  r: TfrxReport;
  i: Integer;
begin
  r := TfrxReport.Create(nil);
  try
    for i := 0 to TfrxPreviewPages(PreviewPages).SourcePages.Count - 1 do
      r.Objects.Add(TfrxPreviewPages(PreviewPages).SourcePages[i]);
    r.DesignReport;
  finally
    r.Objects.Clear;
    r.Free;
  end;
end;


procedure TfrxPreview.Clear;
begin
  if FRunning then Exit;

  Lock;
  try
    PreviewPages.Clear;
  finally
    Unlock;
  end;

  FWorkspace.ClearPageList;
  FThumbnail.ClearPageList;
  UpdateOutline;
  PageNo := 1;
  with FWorkspace do
  begin
    HorzRange := 0;
    VertRange := 0;
  end;
  if ThumbnailVisible then
  with FThumbnail do
  begin
    HorzRange := 0;
    VertRange := 0;
  end;

end;


procedure TfrxPreview.AddPage;
begin
  if FRunning then Exit;

  PreviewPages.AddEmptyPage(PageNo - 1);
  UpdatePages;
  PageNo := PageNo;

end;


procedure TfrxPreview.DeletePage;
begin
  if FRunning then Exit;

  PreviewPages.DeletePage(PageNo - 1);
  if PageNo >= PageCount then
    PageNo := PageNo - 1;
  UpdatePages;
  UpdatePageNumbers;

end;

procedure TfrxPreview.Lock;
begin
  FLocked := True;
  FWorkspace.Locked := True;
  FThumbnail.Locked := True;
end;

procedure TfrxPreview.Unlock;
begin
  HideMessage;
  FLocked := False;
  FWorkspace.Locked := False;
  FThumbnail.Locked := False;
  UpdatePages;
  FWorkspace.Repaint;
  FThumbnail.Repaint;
end;


procedure TfrxPreview.SetPosition(PageN, Top: Integer);

begin
  if PageN > PageCount then
    PageN := PageCount;
  if PageN <= 0 then
    PageN := 1;
  FWorkspace.SetPosition(PageN, Top);

end;

function  TfrxPreview.GetTopPosition: Integer;
begin
  Result := FWorkspace.GetTopPosition;
end;

procedure TfrxPreview.RefreshReport;
var
  hpos, vpos, pno: Integer;
begin
  hpos := FWorkspace.FOffset.X;
  vpos := FWorkspace.FOffset.Y;
  pno := FPageNo;

  Lock;
  FRefreshing := True;
  try
    Report.PrepareReport;
    FLocked := False;
    FThumbnail.Locked := False;
    if pno <= PageCount then
      FPageNo := pno
    else
      FPageNo := 1;
    UpdatePages;
    UpdateOutline;
  finally
    FRefreshing := False;
  end;

  FWorkspace.FOffset.X := hpos;
  FWorkspace.FOffset.Y := vpos;
  FWorkspace.Locked := False;
  FWorkspace.Repaint;
  FThumbnail.Repaint;
  if pno > PageCount then
    PageNo := 1;
end;

procedure TfrxPreview.UpdatePages;
var
  PageSize: TPoint;
  i: Integer;
begin
  if FLocked or (PageCount = 0) then Exit;

  { clear find settings }
  FAllowF3 := False;
  FWorkspace.FEMFImagePage := -1;

  { calc zoom if not zmDefault}
  PageSize := PreviewPages.PageSize[PageNo - 1];
  if PageSize.Y = 0 then Exit;
  case FZoomMode of
    zmWholePage:
      begin
        if PageSize.Y/ClientHeight < PageSize.X/ClientWidth then
          FZoom := (FWorkspace.Width - GetSystemMetrics(SM_CXVSCROLL) - 26) / PageSize.X
        else
          FZoom := (FWorkspace.Height - 26) / PageSize.Y;
        SetPosition(PageNo, 0);
      end;
    zmPageWidth:
      FZoom := (FWorkspace.Width - GetSystemMetrics(SM_CXVSCROLL) - 26) / PageSize.X
  end;

  FThumbnail.DoubleBuffered := True;
  { fill page list and calc bounds }
  FWorkspace.Zoom := FZoom;
  FThumbnail.Zoom := 0.1;
  FWorkspace.ClearPageList;
  FThumbnail.ClearPageList;
  for i := 0 to PageCount - 1 do
  begin
    PageSize := PreviewPages.PageSize[i];
    FWorkspace.AddPage(PageSize.X, PageSize.Y);
    if not FRunning then
      FThumbnail.AddPage(PageSize.X, PageSize.Y);
  end;

  FWorkspace.CalcPageBounds(FWorkspace.Width - GetSystemMetrics(SM_CXVSCROLL) - 26);
  if not FRunning then
    FThumbnail.CalcPageBounds(FThumbnail.Width - GetSystemMetrics(SM_CXVSCROLL) - 26);

  FWorkspace.UpdateScrollBars;
  FThumbnail.UpdateScrollBars;
  { avoid positioning errors when resizing }
  FWorkspace.HorzPosition := FWorkspace.HorzPosition;
  FWorkspace.VertPosition := FWorkspace.VertPosition;

  if not FRefreshing then
  begin
    FWorkspace.Repaint;
    FThumbnail.Repaint;
  end;

  if Owner is TfrxPreviewForm then
    TfrxPreviewForm(Owner).UpdateZoom;
  FThumbnail.DoubleBuffered := False;
end;

procedure TfrxPreview.UpdateOutline;
var
  Outline: TfrxCustomOutline;

  procedure DoUpdate(RootNode: TTreeNode);
  var
    i, n: Integer;
    Node: TTreeNode;
    Page, Top: Integer;
    Text: String;
  begin
    n := Outline.Count;
    for i := 0 to n - 1 do
    begin
      Outline.GetItem(i, Text, Page, Top);
      Node := FOutline.Items.AddChild(RootNode, Text);
      Node.ImageIndex := Page + 1;
      Node.StateIndex := Top;

      Outline.LevelDown(i);
      DoUpdate(Node);
      Outline.LevelUp;
    end;
  end;

begin
  FOutline.Items.BeginUpdate;
  FOutline.Items.Clear;
  Outline := Report.PreviewPages.Outline;
  Outline.LevelRoot;
  DoUpdate(nil);
  if Report.PreviewOptions.OutlineExpand then
    FOutline.FullExpand;
  if FOutline.Items.Count > 0 then
    FOutline.TopItem := FOutline.Items[0];
  FOutline.Items.EndUpdate;
end;

procedure TfrxPreview.OnOutlineClick(Sender: TObject);
var
  Node: TTreeNode;
  PageN, Top: Integer;
begin
  Node := FOutline.Selected;
  if Node = nil then Exit;

  PageN := Node.ImageIndex;
  Top := Node.StateIndex;

  SetPosition(PageN, Top);
  SetFocus;
end;

procedure TfrxPreview.InternalOnProgressStart(Sender: TfrxReport;
  ProgressType: TfrxProgressType; Progress: Integer);
begin
  if FRefreshing then Exit;

  Clear;
  Report.DrillState.Clear;
  FRunning := True;
  if Owner is TfrxPreviewForm then
    TfrxPreviewForm(Owner).UpdateControls;
end;

procedure TfrxPreview.InternalOnProgress(Sender: TfrxReport;
  ProgressType: TfrxProgressType; Progress: Integer);
var
  PageSize: TPoint;
begin
  if FRefreshing then
  begin
    UpdatePageNumbers;
    Exit;
  end;

  if Report.Engine.FinalPass then
  begin
    PageSize := Report.PreviewPages.PageSize[Progress];
    if Progress < 50 then
    begin
      FWorkspace.AddPage(PageSize.X, PageSize.Y);
      FWorkspace.CalcPageBounds(FWorkspace.Width - GetSystemMetrics(SM_CXVSCROLL) - 26);
    end;
  end;

  if Progress = 0 then
  begin
    PageNo := 1;
    if Report.Engine.FinalPass then
      UpdatePages;
    if Owner is TfrxPreviewForm then
      TfrxPreviewForm(Owner).CancelB.Caption := frxResources.Get('clCancel');
    FTick := GetTickCount;
  end
  else if Progress = 1 then
  begin
    FTick := GetTickCount - FTick;
    if FTick < 5 then