frxpreview.pas

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

{$IFDEF UseTabset}
    BorderStyle := bsNone;
    BevelKind := bkFlat;
{$ELSE}
    BorderStyle := bsSingle;
{$ENDIF}
    OnClick := OnOutlineClick;
    PopupMenu := FOutlinePopup;
  end;

  FThumbnail := TfrxPreviewWorkspace.Create(Self);
  FThumbnail.Parent := Self;
  FThumbnail.Align := alLeft;
  FThumbnail.Visible := False;
  FThumbnail.Zoom := 0.1;
  FThumbnail.IsThumbnail := True;
  FThumbnail.Preview := Self;

  FSplitter := TSplitter.Create(Self);
  FSplitter.Parent := Self;
  FSplitter.Align := alLeft;
  FSplitter.Width := 4;
  FSplitter.Left := FOutline.Width + 1;
  FSplitter.OnMoved := OnMoveSplitter;

  FWorkspace := TfrxPreviewWorkspace.Create(Self);
  FWorkspace.Parent := Self;
  FWorkspace.Align := alClient;
  FWorkspace.Preview := Self;

  FMessagePanel := TPanel.Create(Self);
  FMessagePanel.Parent := Self;
  FMessagePanel.Visible := False;
  FMessagePanel.SetBounds(0, 0, 0, 0);

  FMessageLabel := TLabel.Create(FMessagePanel);
  FMessageLabel.Parent := FMessagePanel;
  FMessageLabel.AutoSize := False;
  FMessageLabel.Alignment := taCenter;
  FMessageLabel.SetBounds(4, 20, 255, 20);

  FCancelButton := TButton.Create(FMessagePanel);
  FCancelButton.Parent := FMessagePanel;
  FCancelButton.SetBounds(92, 44, 75, 25);
  FCancelButton.Caption := frxResources.Get('clCancel');
  FCancelButton.Visible := False;
  FCancelButton.OnClick := OnCancel;

  FBorderStyle := bsSingle;
  FPageNo := 1;
  FScrollBars := ssBoth;
  FZoom := 1;
  FZoomMode := zmDefault;
  FOutlineColor := clWindow;
  UseReportHints := True;

  Width := 100;
  Height := 100;
end;

destructor TfrxPreview.Destroy;
begin
  if Report <> nil then
    Report.Preview := nil;
  inherited;
end;

procedure TfrxPreview.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[FBorderStyle];
    if Ctl3D and NewStyleControls and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

procedure TfrxPreview.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);

  if Operation = opRemove then
    if AComponent = Report then
    begin
      Clear;
      Report := nil;
      PreviewPages := nil;
    end;
end;

procedure TfrxPreview.Init;
begin
  FWorkspace.PreviewPages := PreviewPages;
  FThumbnail.PreviewPages := PreviewPages;
  TextFound := False;
  FWorkspace.FLastFoundPage := 0;
  LastFoundRecord := -1;
  FAllowF3 := False;

  FWorkspace.DoubleBuffered := True;
  OutlineWidth := Report.PreviewOptions.OutlineWidth;
  OutlineVisible := Report.PreviewOptions.OutlineVisible;
  ThumbnailVisible := Report.PreviewOptions.ThumbnailVisible;
  FZoomMode := Report.PreviewOptions.ZoomMode;
  Fzoom := Report.PreviewOptions.Zoom;
 if not(Owner is TfrxPreviewForm) and UseRightToLeftAlignment then
    FlipChildren(True);
  UpdatePages;
  UpdateOutline;
  First;
end;

procedure TfrxPreview.WMEraseBackground(var Message: TMessage);
begin
end;

procedure TfrxPreview.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTARROWS;
end;

procedure TfrxPreview.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if Key = vk_Up then
    FWorkspace.VertPosition := FWorkspace.VertPosition - 8
  else if Key = vk_Down then
    FWorkspace.VertPosition := FWorkspace.VertPosition + 8
  else if Key = vk_Left then
    FWorkspace.HorzPosition := FWorkspace.HorzPosition - 8
  else if Key = vk_Right then
    FWorkspace.HorzPosition := FWorkspace.HorzPosition + 8
  else if Key = vk_Prior then
    if ssCtrl in Shift then
      PageNo := PageNo - 1
    else
      FWorkspace.VertPosition := FWorkspace.VertPosition - 300
  else if Key = vk_Next then
    if ssCtrl in Shift then
      PageNo := PageNo + 1
    else
      FWorkspace.VertPosition := FWorkspace.VertPosition + 300
  else if Key = vk_Home then
    PageNo := 1
  else if Key = vk_End then
    PageNo := PageCount
  else if (Key = vk_F3) and (pbFind in Report.PreviewOptions.Buttons) then
    FindNext
  else if ssCtrl in Shift then
  begin
    if (Key = Ord('P')) and (pbPrint in Report.PreviewOptions.Buttons) then
      Print
    else if (Key = Ord('S')) and (pbSave in Report.PreviewOptions.Buttons) then
      SaveToFile
    else if (Key = Ord('F')) and (pbFind in Report.PreviewOptions.Buttons) then
      Find
    else if (Key = Ord('O')) and (pbLoad in Report.PreviewOptions.Buttons) then
      LoadFromFile
  end;
end;

procedure TfrxPreview.Resize;
begin
  inherited;
  if PreviewPages <> nil then
    UpdatePages;
end;

procedure TfrxPreview.OnMoveSplitter(Sender: TObject);
begin
  UpdatePages;
end;

procedure TfrxPreview.OnCollapseClick(Sender: TObject);
begin
  FOutline.FullCollapse;
end;

procedure TfrxPreview.OnExpandClick(Sender: TObject);
begin
  FOutline.FullExpand;
  if FOutline.Items.Count > 0 then
    FOutline.TopItem := FOutline.Items[0];
end;

procedure TfrxPreview.SetZoom(const Value: Extended);
begin
  FZoom := Value;
  if FZoom < 0.25 then
    FZoom := 0.25;

  FZoomMode := zmDefault;
  UpdatePages;
end;

procedure TfrxPreview.SetZoomMode(const Value: TfrxZoomMode);
begin
  FZoomMode := Value;
  UpdatePages;
end;

function TfrxPreview.GetOutlineVisible: Boolean;
begin
  Result := FOutline.Visible;
end;

procedure TfrxPreview.SetOutlineVisible(const Value: Boolean);
var
  NeedChange: Boolean;
begin
  NeedChange := Value <> FOutline.Visible;

  FSplitter.Visible := Value or ThumbnailVisible;
  FOutline.Visible := Value;

  if UseRightToLeftAlignment then
      FOutline.Left := Width;

  if Value then
    FThumbnail.Visible := False;

  if Owner is TfrxPreviewForm then
    TfrxPreviewForm(Owner).OutlineB.Down := Value;
  if NeedChange then
    UpdatePages;
end;

function TfrxPreview.GetThumbnailVisible: Boolean;
begin
  Result := FThumbnail.Visible;
end;

procedure TfrxPreview.SetThumbnailVisible(const Value: Boolean);
var
  NeedChange: Boolean;
begin
  NeedChange := Value <> FThumbnail.Visible;

  FSplitter.Visible := Value or OutlineVisible;
  FThumbnail.Visible := Value;
  
  if UseRightToLeftAlignment then
    FThumbnail.Left := Width;

  if Value then
    FOutline.Visible := False;

  if Value then
  begin
    FThumbnail.HorzPosition := FThumbnail.HorzPosition;
    FThumbnail.VertPosition := FThumbnail.VertPosition;
  end;
  if Owner is TfrxPreviewForm then
    TfrxPreviewForm(Owner).ThumbB.Down := Value;
  if NeedChange then
    UpdatePages;
end;

function TfrxPreview.GetOutlineWidth: Integer;
begin
  Result := FOutline.Width;
end;

procedure TfrxPreview.SetOutlineWidth(const Value: Integer);
begin
  FOutline.Width := Value;
  if not (csDesigning in ComponentState) then
    FThumbnail.Width := Value;
end;

procedure TfrxPreview.SetOutlineColor(const Value: TColor);
begin
  FOutlineColor := Value;
  FOutline.Color := Value;
end;

procedure TfrxPreview.SetPageNo(Value: Integer);
var
  ActivePageChanged: Boolean;
begin
  if Value < 1 then
    Value := 1;
  if Value > PageCount then
    Value := PageCount;
  ActivePageChanged := FPageNo <> Value;
  FPageNo := Value;
  FWorkspace.PageNo := Value;
  FThumbnail.PageNo := Value;

  if ActivePageChanged then
  begin
    FWorkspace.DrawPages(True);
    FThumbnail.DrawPages(True);
  end;
  FWorkspace.SetToPageNo(FPageNo);
  FThumbnail.SetToPageNo(FPageNo);
  UpdatePageNumbers;
end;

function TfrxPreview.GetActiveFrameColor: TColor;
begin
  Result := FWorkspace.ActiveFrameColor;
end;

function TfrxPreview.GetBackColor: TColor;
begin
  Result := FWorkspace.BackColor;
end;

function TfrxPreview.GetFrameColor: TColor;
begin
  Result := FWorkspace.FrameColor;
end;

procedure TfrxPreview.SetActiveFrameColor(const Value: TColor);
begin
  FWorkspace.ActiveFrameColor := Value;
end;

procedure TfrxPreview.SetBackColor(const Value: TColor);
begin
  FWorkspace.BackColor := Value;
end;

procedure TfrxPreview.SetFrameColor(const Value: TColor);
begin
  FWorkspace.FrameColor := Value;
end;

procedure TfrxPreview.SetBorderStyle(Value: TBorderStyle);
begin
  if BorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
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.Options := SaveDlg.Options + [ofNoChangeDir];
    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, ofNoChangeDir];
    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);
  finally
    PageNo := 1;
    UpdateOutline;
    Unlock;
  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);