frxpreview.pas

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

      FTick := 50
    else if FTick < 10 then
      FTick := 20
    else
      FTick := 5;
    PageNo := 1;
    if Report.Engine.FinalPass then
      UpdatePages;
  end
  else if Progress mod Integer(FTick) = 0 then
  begin
    UpdatePageNumbers;
    if Report.Engine.FinalPass then
      FWorkspace.UpdateScrollBars;
  end;

  Application.ProcessMessages;
end;

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

  FRunning := False;
  UpdatePageNumbers;
  FWorkspace.UpdateScrollBars;
  FThumbnail.UpdateScrollBars;
  UpdatePages;
  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;
      if FZoom < 0.3 then
        FZoom := 0.3;
      SetZoom(FZoom);
    end
    else
    begin
      with FWorkspace do
      begin
        if Horz then
          HorzPosition := HorzPosition + Round(-Delta / Abs(Delta)) * 20
        else
          VertPosition := VertPosition + Round(-Delta / Abs(Delta)) * 20;
      end;
    end;

end;




{ TfrxPreviewForm }

procedure TfrxPreviewForm.FormCreate(Sender: TObject);
begin

  FStatusBarOldWindowProc := StatusBar.WindowProc;
  StatusBar.WindowProc := StatusBarWndProc;
  Caption := frxGet(100);
  PrintB.Caption := frxGet(101);
  PrintB.Hint := frxGet(102);
  OpenB.Caption := frxGet(103);
  OpenB.Hint := frxGet(104);
  SaveB.Caption := frxGet(105);
  SaveB.Hint := frxGet(106);
  ExportB.Caption := frxGet(107);
  ExportB.Hint := frxGet(108);
  FindB.Caption := frxGet(109);
  FindB.Hint := frxGet(110);
  ZoomCB.Hint := frxGet(119);
  PageSettingsB.Caption := frxGet(120);
  PageSettingsB.Hint := frxGet(121);
  DesignerB.Caption := frxGet(132);
  DesignerB.Hint := frxGet(133);
  {$IFDEF FR_LITE}
    DesignerB.Hint := DesignerB.Hint + #13#10 + 'This feature is not available in FreeReport';
  {$ENDIF}
  FirstB.Caption := frxGet(134);
  FirstB.Hint := frxGet(135);
  PriorB.Caption := frxGet(136);
  PriorB.Hint := frxGet(137);
  NextB.Caption := frxGet(138);
  NextB.Hint := frxGet(139);
  LastB.Caption := frxGet(140);
  LastB.Hint := frxGet(141);
  CancelB.Caption := frxResources.Get('clClose');
  PageE.Hint := frxGet(142);
  FullScreenBtn.Hint := frxGet(150);
  PdfB.Hint := frxGet(151);
  EmailB.Hint := frxGet(152);
  ZoomPlusB.Caption := frxGet(124);
  ZoomPlusB.Hint := frxGet(125);
  ZoomMinusB.Caption := frxGet(126);
  ZoomMinusB.Hint := frxGet(127);
  OutlineB.Caption := frxGet(128);
  OutlineB.Hint := frxGet(129);
  ThumbB.Caption := frxGet(130);
  ThumbB.Hint := frxGet(131);
  ZoomCB.Items.Clear;
  ZoomCB.Items.Add('25%');
  ZoomCB.Items.Add('50%');
  ZoomCB.Items.Add('75%');
  ZoomCB.Items.Add('100%');
  ZoomCB.Items.Add('150%');
  ZoomCB.Items.Add('200%');
  ZoomCB.Items.Add(frxResources.Get('zmPageWidth'));
  ZoomCB.Items.Add(frxResources.Get('zmWholePage'));
  Toolbar.Images := frxResources.PreviewButtonImages;
  ExpandMI.Caption := frxGet(600);
  CollapseMI.Caption := frxGet(601);

  FPreview := TfrxPreview.Create(Self);
  FPreview.Parent := Self;
  FPreview.Align := alClient;
  FPreview.BorderStyle := bsNone;
  FPreview.BevelKind := bkNone;
  FPreview.OnPageChanged := OnPageChanged;
  FPreview.OnDblClick := OnPreviewDblClick;
  ActiveControl := FPreview;
  SetWindowLong(PageE.Handle, GWL_STYLE, GetWindowLong(PageE.Handle, GWL_STYLE) or ES_NUMBER);
{$IFDEF Delphi10}
  frTBPanel1.ParentBackground := False;
  Sep3.ParentBackground := False;
  Sep4.ParentBackground := False;
{$ENDIF}

  if Screen.PixelsPerInch > 96 then
    StatusBar.Height := 24;

  FFullScreen := False;
  FPDFExport := nil;
  FEmailExport := nil;
end;

procedure TfrxPreviewForm.Init;
var
  i, j, k: Integer;
  m, e: TMenuItem;
begin
  FPreview.Init;
  with Report.PreviewOptions do
  begin
    if Maximized then
      WindowState := wsMaximized;
    if MDIChild then
      FormStyle := fsMDIChild;
    FPreview.Zoom := Zoom;
    FPreview.ZoomMode := ZoomMode;

    {$IFDEF FR_LITE}
      DesignerB.Enabled := False;
    {$ELSE}
      DesignerB.Enabled := AllowEdit;
    {$ENDIF}
    Preview.Workspace.RTLLanguage := RTLPreview;
    PrintB.Visible := pbPrint in Buttons;
    OpenB.Visible := pbLoad in Buttons;
    SaveB.Visible := pbSave in Buttons;
    ExportB.Visible := pbExport in Buttons;
    FindB.Visible := pbFind in Buttons;
    PdfB.Visible := False;
    EmailB.Visible := False;

    ZoomPlusB.Visible := pbZoom in Buttons;
    ZoomMinusB.Visible := pbZoom in Buttons;
    Sep3.Visible := pbZoom in Buttons;
    FullScreenBtn.Visible := (pbZoom in Buttons) and not (pbNoFullScreen in Buttons);
    if not (pbZoom in Buttons) then
      Sep1.Visible := False;

    OutlineB.Visible := pbOutline in Buttons;
    ThumbB.Visible := pbOutline in Buttons;
    PageSettingsB.Visible := pbPageSetup in Buttons;
    DesignerB.Visible := pbEdit in Buttons;
    if not (PageSettingsB.Visible or DesignerB.Visible) then
      Sep2.Visible := False;

    FirstB.Visible := pbNavigator in Buttons;
    PriorB.Visible := pbNavigator in Buttons;
    NextB.Visible := pbNavigator in Buttons;
    LastB.Visible := pbNavigator in Buttons;
    Sep4.Visible := pbNavigator in Buttons;
    if not (pbNavigator in Buttons) then
      Sep5.Visible := False;

    CancelB.Visible := not (pbNoClose in Buttons);

    Toolbar.ShowCaptions := ShowCaptions;
  end;

  if (frxExportFilters.Count = 0) or
     ((frxExportFilters.Count = 1) and (frxExportFilters[0].Filter = frxDotMatrixExport)) then
    ExportB.Visible := False;

  for i := 0 to frxExportFilters.Count - 1 do
  begin
    if frxExportFilters[i].Filter = frxDotMatrixExport then
      continue;
    m := TMenuItem.Create(ExportPopup);
    ExportPopup.Items.Add(m);
    m.Caption := TfrxCustomExportFilter(frxExportFilters[i].Filter).GetDescription + '...';
    m.Tag := i;
    m.OnClick := ExportMIClick;
    if TfrxCustomExportFilter(frxExportFilters[i].Filter).ClassName = 'TfrxPDFExport' then
    begin
      FPDFExport := TfrxCustomExportFilter(frxExportFilters[i].Filter);
      PdfB.Visible := pbExportQuick in Report.PreviewOptions.Buttons;
    end;
    if not (pbNoEmail in Report.PreviewOptions.Buttons) then
    begin
      if TfrxCustomExportFilter(frxExportFilters[i].Filter).ClassName = 'TfrxMailExport' then
      begin
        FEmailExport := TfrxCustomExportFilter(frxExportFilters[i].Filter);
        EmailB.Visible := pbExportQuick in Report.PreviewOptions.Buttons;
      end;
    end
    else EmailB.Visible := False; 
  end;

  if Report.ReportOptions.Name <> '' then
    Caption := Report.ReportOptions.Name;

  k := 0;

  RightMenu.Images := ToolBar.Images;
  for i := 0 to ToolBar.ButtonCount - 1 do
  begin
    if (ToolBar.Buttons[i].Style <> tbsCheck) and
       (ToolBar.Buttons[i].Visible) and
       (ToolBar.Buttons[i].Hint <> '') then
    begin
      m := TMenuItem.Create(RightMenu);
      RightMenu.Items.Add(m);
      ToolBar.Buttons[i].Tag := Integer(m);
      m.Caption := ToolBar.Buttons[i].Hint;
      m.OnClick := ToolBar.Buttons[i].OnClick;
      m.ImageIndex := ToolBar.Buttons[i].ImageIndex;
      if Assigned(ToolBar.Buttons[i].DropdownMenu) then
        for j := 0 to ToolBar.Buttons[i].DropdownMenu.Items.Count - 1 do
        begin
          e := TMenuItem.Create(m);
          e.Caption := ToolBar.Buttons[i].DropdownMenu.Items[j].Caption;
          e.Tag := ToolBar.Buttons[i].DropdownMenu.Items[j].Tag;
          e.OnClick := ToolBar.Buttons[i].DropdownMenu.Items[j].OnClick;
          m.Add(e);
        end;
    end;
    if ToolBar.Buttons[i].Style = tbsSeparator then
    begin
      if k = 1 then
        break;
      m := TMenuItem.Create(RightMenu);
      RightMenu.Items.Add(m);
      m.Caption := '-';
      Inc(k);
    end;
  end;

  if UseRightToLeftAlignment then
    FlipChildren(True);
    
  UpdateControls;
  PopupMenu := RightMenu;
end;

procedure TfrxPreviewForm.UpdateControls;

  function HasDrillDown: Boolean;
  var
    l: TList;
    i: Integer;
    c: TfrxComponent;
  begin
    Result := False;
    l := Report.AllObjects;
    for i := 0 to l.Count - 1 do
    begin
      c := l[i];
      if (c is TfrxGroupHeader) and TfrxGroupHeader(c).DrillDown then
      begin
        Result := True;
        break;
      end;
    end;
  end;

  procedure EnableControls(cAr: array of TObject; Enabled: Boolean);
  var
    i: Integer;
  begin
    for i := 0 to High(cAr) do
    begin
      if cAr[i] is TMenuItem then
        TMenuItem(cAr[i]).Visible := Enabled
      else if cAr[i] is TToolButton then
      begin
        TToolButton(cAr[i]).Enabled := Enabled;
        TToolButton(cAr[i]).Down := False;
        if TToolButton(cAr[i]).Tag <> 0 then
          TMenuItem(TToolButton(cAr[i]).Tag).Enabled := Enabled;
      end;
    end;
  end;

begin
  EnableControls([PrintB, OpenB, SaveB, ExportB, PdfB, EmailB, FindB, PageSettingsB],
    (not FPreview.FRunning) and (FPreview.PageCount > 0));
  EnableControls([DesignerB],
    not FPreview.FRunning and Report.PreviewOptions.AllowEdit);
  EnableControls([ExpandMI, CollapseMI, N1],
    not FPreview.FRunning and HasDrillDown);
end;

procedure TfrxPreviewForm.PrintBClick(Sender: TObject);
begin
  FPreview.Print;
  Enabled := True;
end;

procedure TfrxPreviewForm.OpenBClick(Sender: TObject);
begin
  FPreview.LoadFromFile;
  if Report.ReportOptions.Name <> '' then
    Caption := Report.ReportOptions.Name
  else
    Caption := frxGet(100);
end;

procedure TfrxPreviewForm.SaveBClick(Sender: TObject);
begin
  FPreview.SaveToFile;
end;

procedure TfrxPreviewForm.FindBClick(Sender: TObject);
begin
  FPreview.Find;
end;

procedure TfrxPreviewForm.ZoomPlusBClick(Sender: TObject);
begin
  FPreview.Zoom := FPreview.Zoom + 0.25;
end;

procedure TfrxPreviewForm.ZoomMinusBClick(Sender: TObject);
begin
  FPreview.Zoom := FPreview.Zoom - 0.25;
end;

function TfrxPreviewForm.GetReport: TfrxReport;
begin
  Result := Preview.Report;
end;

procedure TfrxPreviewForm.UpdateZoom;
begin
  ZoomCB.Text := IntToStr(Round(FPreview.Zoom * 100)) + '%';
end;

procedure TfrxPreviewForm.ZoomCBClick(Sender: TObject);
var
  s: String;
begin
  FPreview.SetFocus;

  if ZoomCB.ItemIndex = 6 then
    FPreview.ZoomMode := zmPageWidth
  else if ZoomCB.ItemIndex = 7 then
    FPreview.ZoomMode := zmWholePage
  else
  begin
    s := ZoomCB.Text;

    if Pos('%', s) <> 0 then
      s[Pos('%', s)] := ' ';
    while Pos(' ', s) <> 0 do
      Delete(s, Pos(' ', s), 1);

    if s <> '' then
      FPreview.Zoom := frxStrToFloat(s) / 100;
  end;

  PostMessage(Handle, WM_UPDATEZOOM, 0, 0);
end;

procedure TfrxPreviewForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
    CancelBClick(Self);
  if Key = VK_F11 then
    SwitchToFullScreen;
  if Key = VK_F1 then
    frxResources.Help(Self);
end;

procedure TfrxPreviewForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    if ActiveControl = ZoomCB then
      ZoomCBClick(nil);
    if ActiveControl = PageE then
      PageEClick(nil);
  end;
end;

procedure TfrxPreviewForm.WMUpdateZoom(var Message: TMessage);
begin
  UpdateZoom;
end;

procedure TfrxPreviewForm.PageSettingsBClick(Sender: TObject);
begin
  FPreview.PageSetupDlg;
end;

procedure TfrxPreviewForm.OnPageChanged(Sender: TfrxPreview; PageNo: Integer);
var
  FirstPass: Boolean;
begin
  FirstPass := False;
  if FPreview.PreviewPages <> nil then
    FirstPass := not FPreview.PreviewPages.Engine.FinalPass;

  if FirstPass and FPreview.FRunning then
    StatusBar.Panels[0].Text := frxResources.Get('clFirstPass') + ' ' +
      IntToStr(FPreview.PageCount)
  else
    StatusBar.Panels[0].Text := Format(frxResources.Get('clPageOf'),
      [PageNo, FPreview.PageCount]);
  PageE.Text := IntToStr(PageNo);
end;

procedure TfrxPreviewForm.PageEClick(Sender: TObject);
begin
  FPreview.PageNo := StrToInt(PageE.Text);
  FPreview.SetFocus;
end;

procedure TfrxPreviewForm.FirstBClick(Sender: TObject);
begin
  FPreview.First;
end;

procedure TfrxPreviewForm.PriorBClick(Sender: TObject);
begin
  FPreview.Prior;
end;

procedure TfrxPreviewForm.NextBClick(Sender: TObject);
begin
  FPreview.Next;
end;

procedure TfrxPreviewForm.LastBClick(Sender: TObject);
begin
  FPreview.Last;
end;

procedure TfrxPreviewForm.FormMouseWheel(Sender: TObject;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  var Handled: Boolean);
begin
  FPreview.