frxpreview.pas

报表控件。FastReport 是非常强大的报表控件

  FWorkspace.SetToPageNo(FPageNo);
  UpdatePageNumbers;
end;

procedure TfrxPreview.UpdatePageNumbers;
begin
  if Assigned(FOnPageChanged) then
    FOnPageChanged(Self, FPageNo);
end;

function TfrxPreview.GetPageCount: Integer;
begin
  if PreviewPages <> nil then
    Result := PreviewPages.Count else
    Result := 0;
end;

procedure TfrxPreview.ShowMessage(const s: String);
begin
  FMessagePanel.SetBounds((Width - 260) div 2, (Height - 75) div 3, 260, 75);
  FMessageLabel.Caption := s;
  FMessagePanel.Show;
  FMessagePanel.Update;
end;

procedure TfrxPreview.HideMessage;
begin
  FMessagePanel.Hide;
  FCancelButton.Hide;
end;

procedure TfrxPreview.First;
begin
  PageNo := 1;
end;

procedure TfrxPreview.Next;
begin
  PageNo := PageNo + 1;
end;

procedure TfrxPreview.Prior;
begin
  PageNo := PageNo - 1;
end;

procedure TfrxPreview.Last;
begin
  PageNo := PageCount;
end;

procedure TfrxPreview.Print;
begin
  if FRunning then Exit;
  try
    PreviewPages.CurPreviewPage := PageNo;
    PreviewPages.Print;
  finally
    Unlock;
  end;
end;

procedure TfrxPreview.SaveToFile;
var
  SaveDlg: TSaveDialog;
begin
  if FRunning then Exit;
  SaveDlg := TSaveDialog.Create(Application);
  try
    SaveDlg.Filter := frxResources.Get('clFP3files') + ' (*.fp3)|*.fp3';
    if SaveDlg.Execute then
    begin
      FWorkspace.Repaint;
      SaveToFile(ChangeFileExt(SaveDlg.FileName, '.fp3'));
    end;
  finally
    SaveDlg.Free;
  end;
end;

procedure TfrxPreview.SaveToFile(FileName: String);
begin
  if FRunning then Exit;
  try
    Lock;
    ShowMessage(frxResources.Get('clSaving'));
    PreviewPages.SaveToFile(FileName);
  finally
    Unlock;
  end;
end;

procedure TfrxPreview.LoadFromFile;
var
  OpenDlg: TOpenDialog;
begin
  if FRunning then Exit;
  OpenDlg := TOpenDialog.Create(nil);
  try
    OpenDlg.Options := [ofHideReadOnly];
    OpenDlg.Filter := frxResources.Get('clFP3files') + ' (*.fp3)|*.fp3';
    if OpenDlg.Execute then
    begin
      FWorkspace.Repaint;
      LoadFromFile(OpenDlg.FileName);
    end;
  finally
    OpenDlg.Free;
  end;
end;

procedure TfrxPreview.LoadFromFile(FileName: String);
begin
  if FRunning then Exit;
  try
    Lock;
    ShowMessage(frxResources.Get('clLoading'));
    PreviewPages.LoadFromFile(FileName);
    OutlineVisible := Report.PreviewOptions.OutlineVisible;
  finally
    UpdateOutline;
    UpdatePages;
    Unlock;
    PageNo := 1;
  end;
end;

procedure TfrxPreview.Export(Filter: TfrxCustomExportFilter);
begin
  if FRunning then Exit;
  try
    PreviewPages.CurPreviewPage := PageNo;
    if Report.DotMatrixReport and (frxDotMatrixExport <> nil) and
      (Filter.ClassName = 'TfrxTextExport') then
      Filter := frxDotMatrixExport;
    PreviewPages.Export(Filter);
  finally
    Unlock;
  end;
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];

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

  UpdateOutline;
  PageNo := 0;
  with FWorkspace do
  begin
    HorzRange := 0;
    VertRange := 0;
  end;
end;

procedure TfrxPreview.AddPage;
begin
  if FRunning then Exit;
  PreviewPages.AddEmptyPage(PageNo - 1);
  UpdatePages;
  UpdateZoom;
  PageNo := PageNo;
end;

procedure TfrxPreview.DeletePage;
begin
  if FRunning then Exit;
  PreviewPages.DeletePage(PageNo - 1);
  if PageNo >= PageCount then
    PageNo := PageNo - 1;
  UpdatePages;
  UpdatePageNumbers;
  UpdateZoom;
end;

procedure TfrxPreview.Lock;
begin
  FLocked := True;
end;

procedure TfrxPreview.Unlock;
begin
  HideMessage;
  FLocked := False;
  FPageNo := 1;
  UpdateZoom;
  FWorkspace.Repaint;
end;

procedure TfrxPreview.SetPosition(PageN, Top: Integer);
var
  Pos: Integer;
  Page: TfrxReportPage;
begin
  if PageN > PageCount then
    PageN := PageCount;
  if PageN <= 0 then
    PageN := 1;

  Page := PreviewPages.Page[PageN - 1];
  if Top = 0 then
    Pos := 0 else
    Pos := Round((Top + Page.TopMargin * fr01cm) * Zoom);

  FWorkspace.VertPosition :=
    FWorkspace.FPageList.GetPageBounds(PageN - 1, FWorkspace.ClientWidth, FZoom).Top - 10 + Pos;
end;

procedure TfrxPreview.UpdateZoom;
var
  PageSize: TPoint;
begin
  if FLocked or (PageCount = 0) then Exit;
  PageSize := PreviewPages.PageSize[PageNo - 1];

  case FZoomMode of
    zmWholePage:
      begin
        FZoom := (FWorkspace.ClientHeight - 20) / PageSize.Y;
        SetPosition(PageNo, 0);
      end;
    zmPageWidth:
      FZoom := (FWorkspace.Width - 52) / PageSize.X;
    zmManyPages:
      begin
        FZoom := (FWorkspace.ClientWidth - 32) / (PageSize.X * 2);
        SetPosition(PageNo, 0);
      end;
  end;

  FWorkspace.UpdateScrollBars;
  FWorkspace.Repaint;
  if Owner is TfrxPreviewForm then
    TfrxPreviewForm(Owner).UpdateZoom;
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.Data := Pointer(Page + 1 + Top div 2 * $100000);

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

begin
  FOutline.Items.BeginUpdate;
  FOutline.Items.Clear;
  Outline := 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.UpdatePages;
var
  i: Integer;
  PageSize: TPoint;
begin
  { clear find settings }
  FAllowF3 := False;
  FWorkspace.FEMFImagePage := -1;

  FWorkspace.FPageList.Clear;
  if PreviewPages = nil then Exit;

  if FZoomMode = zmManyPages then
    FWorkspace.FPageList.ColumnCount := 2 else
    FWorkspace.FPageList.ColumnCount := 1;

  for i := 0 to PageCount - 1 do
  begin
    PageSize := PreviewPages.PageSize[i];
    FWorkspace.FPageList.AddPage(PageSize.X, PageSize.Y);
  end;
end;

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

  PageN := Integer(Node.Data) mod $100000;
  Top := Integer(Node.Data) div $100000 * 2;
  SetPosition(PageN, Top);
  SetFocus;
end;

procedure TfrxPreview.InternalOnProgressStart(Sender: TfrxReport;
  ProgressType: TfrxProgressType; Progress: Integer);
begin
  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 Report.Engine.FinalPass then
  begin
    PageSize := Report.PreviewPages.PageSize[Progress];
    FWorkspace.FPageList.AddPage(PageSize.X, PageSize.Y);
  end;

  if Progress = 0 then
  begin
    FOutline.Items.Clear;
    PageNo := 1;
    UpdateZoom;
    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
      FTick := 50
    else if FTick < 10 then
      FTick := 20
    else
      FTick := 5;
    PageNo := 1;
    UpdateZoom;
  end
  else if Progress mod Integer(FTick) = 0 then
  begin
    UpdatePageNumbers;
    FWorkspace.UpdateScrollBars;
  end;

  Application.ProcessMessages;
end;

procedure TfrxPreview.InternalOnProgressStop(Sender: TfrxReport;
  ProgressType: TfrxProgressType; Progress: Integer);
begin
  FRunning := False;
  UpdatePageNumbers;
  FWorkspace.UpdateScrollBars;
  UpdateZoom;
  UpdateOutline;
  if Owner is TfrxPreviewForm then
  begin
    TfrxPreviewForm(Owner).CancelB.Caption := frxResources.Get('clClose');
    TfrxPreviewForm(Owner).StatusBar.Panels[1].Text := '';
    TfrxPreviewForm(Owner).UpdateControls;
  end;
end;

procedure TfrxPreview.OnCancel(Sender: TObject);
begin
  Report.Terminated := True;
end;

procedure TfrxPreview.Cancel;
begin
  if FRunning then
    OnCancel(Self);
end;

procedure TfrxPreview.MouseWheelScroll(Delta: Integer; Horz: Boolean = False;
  Zoom: Boolean = False);
begin
  if Delta <> 0 then
    if Zoom then
    begin
      FZoom := FZoom + Round(Delta / Abs(Delta)) / 10;