frxdock.pas

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

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

unit frxDock;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls, Buttons, IniFiles
{$IFDEF Delphi6}
, Variants
{$ENDIF};
  

type
  TfrxOrientation = (toAny, toVertOnly, toHorzOnly);

  TfrxFloatWindow = class;

  TfrxDock = class(TPanel)
  private
    FRowSize:Integer;
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner:TComponent); override;
    procedure AdjustBounds;
    procedure Paint; override;
  published
    property RowSize:Integer read FRowSize write FRowSize default 26;
  end;

  TfrxDragBox = class(TGraphicControl)
  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;
  public
    constructor Create(AOwner:TComponent); override;
    procedure Paint; override;
  end;

  TfrxToolBar = class(TPanel)
  private
    FDragBox:TfrxDragBox;
    FWindow:TfrxFloatWindow;
    FIsFloat:Boolean;
    FDown:Boolean;
    FLastX, FLastY:Integer;
    FOrientation:TfrxOrientation;
    FCanFloat:Boolean;
    function ParentAlign:TAlign;
    function FindDock(AOwner:TWinControl; p:TPoint):Boolean;
    procedure MakeFloat;
    function MoveTo(X, Y:Integer):Boolean;
    function GetVisible:Boolean;
    procedure SetVisible(Value:Boolean);
    procedure DockTo(Dock:TfrxDock; X, Y:Integer);
    procedure FloatTo(X,Y:Integer);
    procedure DoMouseDown(Sender:TObject; Button:TMouseButton;
      Shift:TShiftState; X, Y:Integer);
    procedure DoMouseMove(Sender:TObject; Shift:TShiftState; X,
      Y:Integer);
    procedure DoMouseUp(Sender:TObject; Button:TMouseButton;
      Shift:TShiftState; X, Y:Integer);
    procedure DoResize(Sender:TObject);
    procedure WMWindowPosChanged(var Message:TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    function GetFloatWindow:TForm;
  protected
    procedure Loaded; override;
    procedure RealignControls;
    function GetClientRect:TRect; override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure AdjustBounds;
    procedure AddToDock(Dock:TfrxDock);
    property IsFloat:Boolean read FIsFloat;
    property FloatWindow:TForm read GetFloatWindow;
    property IsVisible:Boolean read GetVisible write SetVisible;
  published
    property CanFloat:Boolean read FCanFloat write FCanFloat default True;
    property Orientation:TfrxOrientation read FOrientation write FOrientation;
  end;

  TfrxTBPanel = class(TPanel)
  protected
    procedure SetParent(AParent:TWinControl); override;
  public
    constructor Create(AOwner:TComponent); override;
    procedure Paint; override;
  end;

  TfrxFloatWindow = class(TForm)
    CloseBtn:TSpeedButton;
    procedure FormDestroy(Sender:TObject);
    procedure FormPaint(Sender:TObject);
    procedure CloseBtnClick(Sender:TObject);
    procedure FormShow(Sender:TObject);
  private
    FPoint:TPoint;
    FDown:Boolean;
  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;
  public
    ToolBar:TfrxToolBar;
    constructor Create(AOwner:TComponent); override;
    procedure CreateParams(var Params:TCreateParams); override;
    procedure Capture;
  end;

  TfrxDockSite = class(TPanel)
  private
    FDown:Boolean;
    FPanelWidth:Integer;
    FSplitter:TGraphicControl;
    procedure SMouseDown(Sender:TObject; Button:TMouseButton;
      Shift:TShiftState; X, Y:Integer);
    procedure SMouseMove(Sender:TObject; Shift:TShiftState; X, Y:Integer);
    procedure SMouseUp(Sender:TObject; Button:TMouseButton;
      Shift:TShiftState; X, Y:Integer);
  public
    constructor Create(AOwner:TComponent); override;
    procedure DockDrop(Source:TDragDockObject; X, Y:Integer); override;
    procedure DockOver(Source:TDragDockObject; X, Y:Integer;
      State:TDragState; var Accept:Boolean); override;
    function DoUnDock(NewTarget:TWinControl; Client:TControl):Boolean; override;
    procedure SetParent(AParent:TWinControl); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight:Integer); override;
    procedure ReloadDockedControl(const AControlName:string;
      var AControl:TControl); override;
  end;

procedure frxSaveToolbarPosition(Ini:TCustomIniFile; t:TfrxToolBar);
procedure frxRestoreToolbarPosition(Ini:TCustomIniFile; t:TfrxToolBar);
procedure frxSaveDock(Ini:TCustomIniFile; d:TfrxDockSite);
procedure frxRestoreDock(Ini:TCustomIniFile; d:TfrxDockSite);
procedure frxSaveFormPosition(Ini:TCustomIniFile; f:TForm);
procedure frxRestoreFormPosition(Ini:TCustomIniFile; f:TForm);

var
  frxRegRootKey:String;

implementation

{$R *.DFM}

uses frxUtils;

const
  rsToolBar = 'ToolBar';
  rsForm = 'Form';
  rsWidth = 'Width';
  rsHeight = 'Height';
  rsTop = 'Top';
  rsLeft = 'Left';
  rsFloat = 'Float';
  rsVisible = 'Visible';
  rsDock = 'Dock';
  rsMaximized = 'Maximized';
  rsData = 'Data';

var
  FloatingToolBars:TList;

procedure AddToToolbarList(t:TfrxToolBar);
begin
  if FloatingToolbars.IndexOf(t)<>-1 then
    FloatingToolbars.Add(t);
end;

procedure RemoveFromToolbarList(t:TfrxToolBar);
var
  i:Integer;
begin
  i:= FloatingToolbars.IndexOf(t);
  if i<>-1 then
    FloatingToolbars.Delete(i);
end;

procedure DestroyToolbarList;
var
  i:Integer;
begin
  for i:= 0 to FloatingToolBars.Count-1 do
    TfrxToolBar(FloatingToolBars[i]).Free;
end;

procedure frxSaveToolbarPosition(Ini:TCustomIniFile; t:TfrxToolBar);
var
  X, Y:integer;
  Name:String;
begin
  Name:= rsToolbar+'.'+t.Name;
  Ini.WriteBool(Name, rsFloat, t.isFloat);
  Ini.WriteBool(Name, rsVisible, t.IsVisible);
  X:= t.Left; Y:= t.Top;
  if t.IsFloat then
  begin
    X:= t.FloatWindow.Left;
    Y:= t.FloatWindow.Top;
  end;
  Ini.WriteInteger(Name, rsLeft, X);
  Ini.WriteInteger(Name, rsTop, Y);
  Ini.WriteInteger(Name, rsWidth, t.Width);
  Ini.WriteInteger(Name, rsHeight, t.Height);
  if t.Parent is TfrxDock then
    Ini.WriteString(Name, rsDock, t.Parent.Name);
end;

procedure frxRestoreToolbarPosition(Ini:TCustomIniFile; t:TfrxToolBar);
var
  X, Y:Integer;
  DN:string;
  NewDock:TfrxDock;
  Name:String;
begin
  Name:= rsToolbar+'.'+t.Name;
  t.IsVisible:= False;
  X:= Ini.ReadInteger(Name, rsLeft, t.Left);
  Y:= Ini.ReadInteger(Name, rsTop, t.Top);
  if Ini.ReadBool(Name, rsFloat, False) then
    t.FloatTo(X, Y)
  else
  begin
    t.Left:= X;
    t.Top:= Y;
    DN:= Ini.ReadString(Name, rsDock, t.Parent.Name);
    if (t.Owner<>nil) then
    begin
      NewDock:= t.Owner.FindComponent(DN) as TfrxDock;
      if (NewDock<>nil) and (NewDock<>t.Parent) then
        t.DockTo(NewDock, X, Y);
    end;
  end;
  t.Width:= Ini.ReadInteger(Name, rsWidth, t.Width);
  t.Height:= Ini.ReadInteger(Name, rsHeight, t.Height);
  t.AdjustBounds;
  t.IsVisible:= Ini.ReadBool(Name, rsVisible, True);
end;

procedure frxSaveDock(Ini:TCustomIniFile; d:TfrxDockSite);
var
  s:TMemoryStream;
begin
  s:= TMemoryStream.Create;
  d.DockManager.SaveToStream(s);
{$IFDEF Delphi9}
  Ini.WriteString(rsDock+'.'+d.Name, rsData+'2005', frxStreamToString(s));
{$ELSE}
  Ini.WriteString(rsDock+'.'+d.Name, rsData, frxStreamToString(s));
{$ENDIF}
  s.Free;
end;

procedure frxRestoreDock(Ini:TCustomIniFile; d:TfrxDockSite);
var
  s:TStream;
  sd:String;
begin
  s:= TMemoryStream.Create;
{$IFDEF Delphi9}
  sd:= Ini.ReadString(rsDock+'.'+d.Name, rsData+'2005', '');
{$ELSE}
  sd:= Ini.ReadString(rsDock+'.'+d.Name, rsData, '');
{$ENDIF}
  frxStringToStream(sd, s);
  s.Position:= 0;
  if s.Size > 0 then
    d.DockManager.LoadFromStream(s);
  s.Free;
end;

procedure frxSaveFormPosition(Ini:TCustomIniFile; f:TForm);
var
  Name:String;
begin
  Name:= rsForm+'.'+f.ClassName;
  Ini.WriteInteger(Name, rsLeft, f.Left);
  Ini.WriteInteger(Name, rsTop, f.Top);
  Ini.WriteInteger(Name, rsWidth, f.Width);
  Ini.WriteInteger(Name, rsHeight, f.Height);
  Ini.WriteBool(Name, rsMaximized, f.WindowState = wsMaximized);
  Ini.WriteBool(Name, rsVisible, f.Visible);
  if f.HostDockSite<>nil then
    Ini.WriteString(Name, rsDock, f.HostDockSite.Name) else
    Ini.WriteString(Name, rsDock, '');
end;

procedure frxRestoreFormPosition(Ini:TCustomIniFile; f:TForm);
var
  Name:String;
  Dock:String;
  cDock:TWinControl;
begin
  Name:= rsForm+'.'+f.ClassName;
  if Ini.ReadBool(Name, rsMaximized, False) then
    f.WindowState:= wsMaximized
  else
    f.SetBounds(Ini.ReadInteger(Name, rsLeft, f.Left),
                Ini.ReadInteger(Name, rsTop, f.Top),
                Ini.ReadInteger(Name, rsWidth, f.Width),
                Ini.ReadInteger(Name, rsHeight, f.Height));
  Dock:= Ini.ReadString(Name, rsDock, '');
  cDock:= frxFindComponent(f.Owner, Dock) as TWinControl;
  if cDock<>nil then
    f.ManualDock(cDock);
  f.Visible:= Ini.ReadBool(Name, rsVisible, True);
end;

{--------------------------------------------------------------------------}
constructor TfrxDock.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  RowSize:= 26;
  Align:= alTop;
end;

procedure TfrxDock.Loaded;
begin
  inherited Loaded;
  AdjustBounds;
end;

procedure TfrxDock.AdjustBounds;
var
  i, Line, LineCount, l, dl:Integer;
  CtlOnLine, NewSize:Integer;
  c:TControl;
  ShiftNeeded:Boolean;
begin
  if ControlCount = 0 then
  begin
    if Align in [alTop, alBottom] then
      Height:= 1 else
      Width:= 1;
    Exit;
  end;
  if Align in [alTop, alBottom] then
    L:= Height else
    L:= Width;
  LineCount:= L div RowSize;
  NewSize:= RowSize * LineCount+1;
  L:= 0;
  dL:= RowSize;
  if Align in [alRight, alBottom] then
  begin
    dL:=-RowSize;
    if Align = alRight then
      L:= Width else
      L:= Height;
  end;
  Line:= 0;
  while Line < LineCount do
  begin
    CtlOnLine:= 0;
    for i:= 0 to ControlCount-1 do
    begin
      c:= Controls[i];
      if c.Visible then
      case Align of
        alLeft:
          if (c.Left = L) or
            ((c.Left < L) and (c.Left+c.Width > L)) then Inc(CtlOnLine);
        alRight:
          if (c.Left+c.Width = L) or
            ((c.Left+c.Width > L) and (c.Left < L)) then Inc(CtlOnLine);
        alTop:
          if (c.Top = L) or
            ((c.Top < L) and (c.Top+c.Height > L)) then Inc(CtlOnLine);
        alBottom:
          if (c.Top+c.Height = L) or
            ((c.Top+c.Height > L) and (c.Top < L)) then Inc(CtlOnLine);
      end;
    end;
    if CtlOnLine = 0 then
    begin
      for i:= 0 to ControlCount-1 do
      begin
        c:= Controls[i];
        if c.Visible then
        begin
          if ((Align = alLeft) and (c.Left > L)) or
             ((Align = alRight) and (c.Left+c.Width > L)) then
            c.Left:= c.Left-RowSize;
          if ((Align = alTop) and (c.Top > L)) or
             ((Align = alBottom) and (c.Top+c.Height > L)) then
            c.Top:= c.Top-RowSize;
        end;
      end;
      Dec(NewSize, RowSize);
      Dec(LineCount);
      Dec(Line);
      if Align in [alTop, alLeft] then Dec(L, dL);
    end;
    Inc(Line);
    Inc(L, dL);
  end;

  ShiftNeeded:= False;
  for i:= 0 to ControlCount-1 do
  begin
    c:= Controls[i];
    if c.Visible then
    begin
      if (Align = alRight) and (c.Left < 0) then
      begin
        ShiftNeeded:= True;
        L:=-c.Left+1;
        Inc(NewSize, L);
        break;
      end;