frxpreview.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{ }
{ FastReport v3.0 }
{ Report preview }
{ }
{ Copyright (c) 1998-2005 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{******************************************}

unit frxPreview;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Buttons, StdCtrls, Menus, ComCtrls, ImgList, frxCtrls, frxDock,
  ToolWin, frxPreviewPages, frxClass
{$IFDEF Delphi6}
, Variants
{$ENDIF};

const
  WM_UPDATEZOOM = WM_USER+1;

type
  TfrxPreview = class;
  TfrxPreviewWorkspace = class;
  TfrxPageList = class;

  TfrxPreviewTool = (ptHand, ptZoom);
  TfrxPageChangedEvent = procedure(Sender:TfrxPreview; PageNo:Integer) of object;

  TfrxPreview = class(TfrxCustomPreview)
  private
    FAllowF3:Boolean;
    FCancelButton:TButton;
    FLocked:Boolean;
    FMessageLabel:TLabel;
    FMessagePanel:TPanel;
    FOnPageChanged:TfrxPageChangedEvent;
    FOutline:TTreeView;
    FPageNo:Integer;
    FRunning:Boolean;
    FScrollBars:TScrollStyle;
    FSplitter:TSplitter;
    FTick:Cardinal;
    FTool:TfrxPreviewTool;
    FWorkspace:TfrxPreviewWorkspace;
    FZoom:Extended;
    FZoomMode:TfrxZoomMode;
    function GetOutlineVisible:Boolean;
    function GetPageCount:Integer;
    procedure EditTemplate;
    procedure OnCancel(Sender:TObject);
    procedure SetOutlineVisible(const Value:Boolean);
    procedure SetPageNo(const Value:Integer);
    procedure SetTool(const Value:TfrxPreviewTool);
    procedure SetZoom(const Value:Extended);
    procedure SetZoomMode(const Value:TfrxZoomMode);
    procedure TreeClick(Sender:TObject);
    procedure UpdateZoom;
    procedure UpdateOutline;
    procedure UpdatePageNumbers;
    procedure UpdatePages;
    procedure WMEraseBackground(var Message:TMessage); message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Message:TWMGetDlgCode); message WM_GETDLGCODE;
  protected
    procedure Resize; override;
    procedure Notification(AComponent:TComponent; Operation:TOperation); override;
    procedure KeyDown(var Key:Word; Shift:TShiftState); override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Init; override;
    procedure Lock; override;
    procedure Unlock; override;
    procedure InternalOnProgressStart(Sender:TfrxReport;
      ProgressType:TfrxProgressType; Progress:Integer); override;
    procedure InternalOnProgress(Sender:TfrxReport;
      ProgressType:TfrxProgressType; Progress:Integer); override;
    procedure InternalOnProgressStop(Sender:TfrxReport;
      ProgressType:TfrxProgressType; Progress:Integer); override;

    procedure AddPage;
    procedure DeletePage;
    procedure Print;
    procedure LoadFromFile; overload;
    procedure LoadFromFile(FileName:String); overload;
    procedure SaveToFile; overload;
    procedure SaveToFile(FileName:String); overload;
    procedure Edit;
    procedure Export(Filter:TfrxCustomExportFilter);
    procedure First;
    procedure Next;
    procedure Prior;
    procedure Last;
    procedure PageSetupDlg;
    procedure Find;
    procedure FindNext;
    procedure Cancel;
    procedure Clear;
    procedure SetPosition(PageN, Top:Integer);
    procedure ShowMessage(const s:String);
    procedure HideMessage;
    procedure MouseWheelScroll(Delta:Integer; Horz:Boolean = False;
      Zoom:Boolean = False);
    property PageCount:Integer read GetPageCount;
    property PageNo:Integer read FPageNo write SetPageNo;
    property Tool:TfrxPreviewTool read FTool write SetTool;
    property Zoom:Extended read FZoom write SetZoom;
    property ZoomMode:TfrxZoomMode read FZoomMode write SetZoomMode;
  published
    property Align;
    property OutlineVisible:Boolean read GetOutlineVisible write SetOutlineVisible;
    property PopupMenu;
    property OnClick;
    property OnPageChanged:TfrxPageChangedEvent read FOnPageChanged write FOnPageChanged;
  end;

  TfrxPreviewForm = class(TForm)
    ToolBar:TToolBar;
    MainImages:TImageList;
    OpenB:TToolButton;
    SaveB:TToolButton;
    PrintB:TToolButton;
    ExportB:TToolButton;
    FindB:TToolButton;
    PageSettingsB:TToolButton;
    Sep3:TfrxTBPanel;
    ZoomCB:TfrxComboBox;
    Sep1:TToolButton;
    Sep2:TToolButton;
    FirstB:TToolButton;
    PriorB:TToolButton;
    Sep4:TfrxTBPanel;
    PageE:TEdit;
    NextB:TToolButton;
    LastB:TToolButton;
    StatusBar:TStatusBar;
    ZoomWholePageB:TToolButton;
    ZoomPageWidthB:TToolButton;
    Zoom100B:TToolButton;
    Zoom50B:TToolButton;
    Sep5:TToolButton;
    HandToolB:TToolButton;
    ZoomToolB:TToolButton;
    Sep6:TToolButton;
    OutlineB:TToolButton;
    Image1:TImage;
    NewPageB:TToolButton;
    DelPageB:TToolButton;
    DesignerB:TToolButton;
    Sep7:TToolButton;
    frTBPanel1:TfrxTBPanel;
    CancelB:TSpeedButton;
    ExportPopup:TPopupMenu;
    HiddenMenu:TPopupMenu;
    Showtemplate1:TMenuItem;
    procedure FormCreate(Sender:TObject);
    procedure OutlineBClick(Sender:TObject);
    procedure ZoomWholePageBClick(Sender:TObject);
    procedure ZoomPageWidthBClick(Sender:TObject);
    procedure Zoom100BClick(Sender:TObject);
    procedure Zoom50BClick(Sender:TObject);
    procedure ZoomCBClick(Sender:TObject);
    procedure FormKeyPress(Sender:TObject; var Key:Char);
    procedure SelectToolBClick(Sender:TObject);
    procedure FirstBClick(Sender:TObject);
    procedure PriorBClick(Sender:TObject);
    procedure NextBClick(Sender:TObject);
    procedure LastBClick(Sender:TObject);
    procedure PageEClick(Sender:TObject);
    procedure PrintBClick(Sender:TObject);
    procedure OpenBClick(Sender:TObject);
    procedure SaveBClick(Sender:TObject);
    procedure FindBClick(Sender:TObject);
    procedure FormClose(Sender:TObject; var Action:TCloseAction);
    procedure DesignerBClick(Sender:TObject);
    procedure NewPageBClick(Sender:TObject);
    procedure DelPageBClick(Sender:TObject);
    procedure CancelBClick(Sender:TObject);
    procedure FormKeyDown(Sender:TObject; var Key:Word;
      Shift:TShiftState);
    procedure PageSettingsBClick(Sender:TObject);
    procedure FormMouseWheel(Sender:TObject; Shift:TShiftState;
      WheelDelta:Integer; MousePos:TPoint; var Handled:Boolean);
    procedure DesignerBMouseUp(Sender:TObject; Button:TMouseButton;
      Shift:TShiftState; X, Y:Integer);
    procedure Showtemplate1Click(Sender:TObject);
    procedure FormCloseQuery(Sender:TObject; var CanClose:Boolean);
  private
    FFreeOnClose:Boolean;
    FPreview:TfrxPreview;
    procedure ExportMIClick(Sender:TObject);
    procedure OnPageChanged(Sender:TfrxPreview; PageNo:Integer);
    procedure UpdateControls;
    procedure UpdateZoom;
    procedure WMUpdateZoom(var Message:TMessage); message WM_UPDATEZOOM;
    function GetReport:TfrxReport;
  public
    procedure Init;
    procedure SetMessageText(const Value:String);
    property FreeOnClose:Boolean read FFreeOnClose write FFreeOnClose;
    property Preview:TfrxPreview read FPreview;
    property Report:TfrxReport read GetReport;
  end;

  TfrxPreviewWorkspace = class(TfrxScrollWin)
  private
    FDefaultCursor:TCursor;
    FDisableUpdate:Boolean;
    FDown:Boolean;
    FEMFImage:TMetafile;
    FEMFImagePage:Integer;
    FLastFoundPage:Integer;
    FLastPoint:TPoint;
    FOffset:TPoint;
    FPageList:TfrxPageList;
    FPreview:TfrxPreview;
    function PreviewPages:TfrxCustomPreviewPages;
    procedure FindText;
    procedure HandleKey(Key:Word; Shift:TShiftState);
    procedure SetToPageNo(PageNo:Integer);
    procedure UpdateScrollBars;
  protected
    procedure MouseDown(Button:TMouseButton;
      Shift:TShiftState; X, Y:Integer); override;
    procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState;
      X, Y:Integer); override;
    procedure OnHScrollChange(Sender:TObject); override;
    procedure Resize; override;
    procedure OnVScrollChange(Sender:TObject); override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  end;

  TfrxPageItem = class(TObject)
  public
    Column:Word;
    Height:Word;
    Width:Word;
    Offset:Integer;
  end;

  TfrxPageList = class(TObject)
  private
    FColumnCount:Integer;
    FList:TList;
    FMaxWidth:Integer;
    procedure SetColumnCount(Value:Integer);
    function GetCount:Integer;
    function GetItems(Index:Integer):TfrxPageItem;
    property Items[Index:Integer]:TfrxPageItem read GetItems;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure AddPage(AWidth, AHeight:Integer);
    function FindPage(Offset:Integer; Scale:Extended;
      Exact:Boolean = False):Integer;
    function GetPageBounds(Index, ClientWidth:Integer; Scale:Extended):TRect;
    function GetMaxBounds(ClientWidth:Integer; Scale:Extended):TPoint;
    property ColumnCount:Integer read FColumnCount write SetColumnCount;
    property Count:Integer read GetCount;
  end;

implementation

{$R *.DFM}

uses
  Printers, frxPrinter, frxSearchDialog, frxUtils, frxRes, frxDsgnIntf,
  frxPreviewPageSettings, frxDMPClass;

type
  THackControl = class(TWinControl);

{ search given string in a metafile }

var
  TextToFind:String;
  TextFound:Boolean;
  TextBounds:TRect;
  RecordNo:Integer;
  LastFoundRecord:Integer;
  CaseSensitive:Boolean;

function EnumEMFRecordsProc(DC:HDC; HandleTable:PHandleTable;
  EMFRecord:PEnhMetaRecord; nObj:Integer; OptData:Pointer):Bool; stdcall;
var
  Typ:Byte;
  s:String;
  t:TEMRExtTextOut;
  Found:Boolean;
begin
  Result:= True;
  Typ:= EMFRecord^.iType;
  if Typ in [83, 84] then
  begin
    t:= PEMRExtTextOut(EMFRecord)^;
    s:= WideCharLenToString(PWideChar(PChar(EMFRecord)+t.EMRText.offString),
      t.EMRText.nChars);
    if CaseSensitive then
      Found:= Pos(TextToFind, s)<>0 else
      Found:= Pos(AnsiUpperCase(TextToFind), AnsiUpperCase(s))<>0;
    if Found and (RecordNo > LastFoundRecord) then
    begin
      TextFound:= True;
      TextBounds:= t.rclBounds;
      LastFoundRecord:= RecordNo;
      Result:= False;
    end;
  end;
  Inc(RecordNo);
end;

{ TfrxPageList }

constructor TfrxPageList.Create;
begin
  FList:= TList.Create;
  FColumnCount:= 1;
end;

destructor TfrxPageList.Destroy;
begin
  Clear;
  FList.Free;
  inherited;
end;

procedure TfrxPageList.Clear;
var
  i:Integer;
begin
  for i:= 0 to FList.Count-1 do
    TObject(FList[i]).Free;
  FList.Clear;
  FMaxWidth:= 0;
end;

function TfrxPageList.GetCount:Integer;
begin
  Result:= FList.Count;
end;

function TfrxPageList.GetItems(Index:Integer):TfrxPageItem;
begin
  Result:= FList[Index];
end;

procedure TfrxPageList.SetColumnCount(Value:Integer);
begin
  FColumnCount:= Value;
  Clear;
end;

procedure TfrxPageList.AddPage(AWidth, AHeight:Integer);
var
  i, FirstColumnIndex, ColumnWidth, MaxHeight:Integer;
  Item, LastItem:TfrxPageItem;
begin
  Item:= TfrxPageItem.Create;
  Item.Width:= AWidth;
  Item.Height:= AHeight;

  if Count > 0 then
  begin
    LastItem:= Items[Count-1];

    if LastItem.Column >= ColumnCount-1 then
    begin
      FirstColumnIndex:= Count-1;
      while Items[FirstColumnIndex].Column > 0 do
        Dec(FirstColumnIndex);

      MaxHeight:= 0;
      for i:= FirstColumnIndex to Count-1 do
        if Items[i].Height > MaxHeight then
          MaxHeight:= Items[i].Height;

      Item.Column:= 0;
      Item.Offset:= LastItem.Offset+MaxHeight+10;
    end
    else
    begin
      Item.Column:= LastItem.Column+1;
      Item.Offset:= LastItem.Offset;
    end;
  end
  else
  begin
    Item.Column:= 0;
    Item.Offset:= 10;
  end;

  FList.Add(Item);

  FirstColumnIndex:= Count-1;
  while Items[FirstColumnIndex].Column > 0 do
    Dec(FirstColumnIndex);

  ColumnWidth:= 0;
  for i:= FirstColumnIndex to Count-1 do
    Inc(ColumnWidth, Items[i].Width+10);

  if FMaxWidth < ColumnWidth then
    FMaxWidth:= ColumnWidth;
end;

function TfrxPageList.FindPage(Offset:Integer; Scale:Extended;
  Exact:Boolean = False):Integer;
var
  i, i0, i1, c, add:Integer;
begin
  i0:= 0;
  i1:= Count-1;

  while i0 <= i1 do
  begin
    i:= (i0+i1) div 2;
    if Exact then
      add:= 0 else
      add:= Round(Scale * Items[i].Height / 5);
    if Items[i].Offset * Scale <= Offset+add then
      c:=-1 else
      c:= 1;

    if c < 0 then
      i0:= i+1 else
      i1:= i-1;
  end;

  Result:= i1;
end;

function TfrxPageList.GetPageBounds(Index, ClientWidth:Integer;
  Scale:Extended):TRect;
var
  i, FirstColumnIndex, ItemOffs, ColumnOffs, ColumnWidth:Integer;
  Item:TfrxPageItem;
begin
  if (Index >= Count) or (Index < 0) then
  begin
    if 794 * Scale > ClientWidth then
      ColumnOffs:= 10 else
      ColumnOffs:= Round((ClientWidth-794 * Scale) / 2);
    Result.Left:= ColumnOffs;
    Result.Top:= Round(10 * Scale);
    Result.Right:= Result.Left+Round(794 * Scale);
    Result.Bottom:= Result.Top+Round(1123 * Scale);
    Exit;
  end;

  Item:= Items[Index];
  if ColumnCount > 1 then
  begin
    ItemOffs:= 0;
    FirstColumnIndex:= Index;
    while Items[FirstColumnIndex].Column > 0 do
    begin
      Dec(FirstColumnIndex);
      Inc(ItemOffs, Items[FirstColumnIndex].Width+10);
    end;

    i:= FirstColumnIndex;
    ColumnWidth:= Items[i].Width;
    Inc(i);
    while (i < Count) and (Items[i].Column > 0) do
    begin
      Inc(ColumnWidth, Items[i].Width+10);
      Inc(i);
    end;
  end
  else
  begin
    ItemOffs:= 0;
    ColumnWidth:= Item.Width;
  end;

  if ColumnWidth * Scale > ClientWidth then
    ColumnOffs:= 10 else
    ColumnOffs:= Round((ClientWidth-ColumnWidth * Scale) / 2);
  Result.Left:= ColumnOffs+Round(ItemOffs * Scale);
  Result.Top:= Round(Item.Offset * Scale);
  Result.Right:= Result.Left+Round(Item.Width * Scale);