frxdock.pas

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

{******************************************}
{                                          }
{             FastReport v3.0              }
{              Tool controls               }
{                                          }
{         Copyright (c) 1998-2006          }
{         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, frxFormUtils;

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;