fr_dock.pas

FASTREPORT报表工具,可以迅速制作报表.

{******************************************}
{                                          }
{             FastReport v2.4              }
{              Tool controls               }
{                                          }
{ Copyright (c) 1998-2001 by Tzyganenko A. }
{                                          }
{******************************************}

unit FR_Dock;

interface

{$I FR.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, FR_Ctrls;

type
  TfrOrientation = (toAny, toVertOnly, toHorzOnly);

  TfrFloatWindow = class;

  TfrDock = 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;

  TfrDragBox = 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;

  TfrToolBar = class(TPanel)
  private
    FDragBox: TfrDragBox;
    FWindow: TfrFloatWindow;
    FIsFloat: Boolean;
    FDown: Boolean;
    FLastX, FLastY: Integer;
    FOrientation: TfrOrientation;
    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: TfrDock; 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: TfrDock);
    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: TfrOrientation read FOrientation write FOrientation;
  end;

  TfrTBSeparator = class(TGraphicControl)
  protected
    FDrawBevel: Boolean;
    procedure SetParent(AParent: TWinControl); override;
    procedure SetDrawBevel(Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  published
    property Align;
    property DrawBevel: Boolean read FDrawBevel write SetDrawBevel default True;
    property Height;
    property Width;
  end;

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

  TfrTBButton = class(TfrSpeedButton)
  protected
    procedure SetParent(AParent:TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property Flat default True;
  end;

  TfrFloatWindow = class(TForm)
    procedure FormDestroy(Sender: TObject);
  private
    FRect: TRect;
    FDown: Boolean;
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  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: TfrToolBar;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Capture;
  end;

var
  RegRootKey: String;

const
  rsToolBar             = 'ToolBar\';
  rsForm                = 'Form\';
  rsWidth               = 'Width';
  rsHeight              = 'Height';
  rsTop                 = 'Top';
  rsLeft                = 'Left';
  rsFloat               = 'isFloat';
  rsVisible             = 'isVisible';
  rsX                   = 'XPosition';
  rsY                   = 'YPosition';
  rsDockName            = 'DockName';
  rsMaximized           = 'Maximized';

procedure SaveToolbarPosition(t: TfrToolBar);
procedure RestoreToolbarPosition(t: TfrToolBar);
procedure SaveFormPosition(f: TForm);
procedure RestoreFormPosition(f: TForm);


implementation

{$R *.DFM}

uses Registry;

var
  FloatingToolBars: TList;


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

procedure RemoveFromToolbarList(t: TfrToolBar);
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
    TfrToolBar(FloatingToolBars[i]).Free;
end;


procedure SaveToolbarPosition(t: TfrToolBar);
var
  Ini: TRegIniFile;
  X, Y: integer;
  Name: String;
begin
  Ini := TRegIniFile.Create(RegRootKey);
  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, rsX, X);
  Ini.WriteInteger(Name, rsY, Y);
  Ini.WriteInteger(Name, rsWidth, t.Width);
  Ini.WriteInteger(Name, rsHeight, t.Height);
  if t.Parent is TfrDock then
    Ini.WriteString(Name, rsDockName, t.Parent.Name);
  Ini.Free;
end;

procedure RestoreToolbarPosition(t: TfrToolBar);
var
  Ini: TRegIniFile;
  X, Y: Integer;
  DN: string;
  NewDock: TfrDock;
  Name: String;
begin
  Ini := TRegIniFile.Create(RegRootKey);
  Name := rsToolbar + t.Name;
  t.IsVisible := False;
  X := Ini.ReadInteger(Name, rsX, t.Left);
  Y := Ini.ReadInteger(Name, rsY, t.Top);
  t.Width := Ini.ReadInteger(Name, rsWidth, t.Width);
  t.Height := Ini.ReadInteger(Name, rsHeight, t.Height);
  if Ini.ReadBool(Name, rsFloat, False) then
    t.FloatTo(X, Y)
  else
  begin
    t.Left := X;
    t.Top := Y;
    DN := Ini.ReadString(Name, rsDockName, t.Parent.Name);
    if (t.Owner <> nil) then
    begin
      NewDock := t.Owner.FindComponent(DN) as TfrDock;
      if (NewDock <> nil) and (NewDock <> t.Parent) then
        t.DockTo(NewDock, X, Y);
    end;
    t.AdjustBounds;
  end;
  t.IsVisible := Ini.ReadBool(Name, rsVisible, True);
  Ini.Free;
end;

procedure SaveFormPosition(f: TForm);
var
  Ini: TRegIniFile;
  Name: String;
begin
  Ini := TRegIniFile.Create(RegRootKey);
  Name := rsForm + f.ClassName;
  Ini.WriteInteger(Name, rsX, f.Left);
  Ini.WriteInteger(Name, rsY, f.Top);
  Ini.WriteInteger(Name, rsWidth, f.Width);
  Ini.WriteInteger(Name, rsHeight, f.Height);
  Ini.WriteBool(Name, rsMaximized, f.WindowState = wsMaximized);
  Ini.Free;
end;

procedure RestoreFormPosition(f: TForm);
var
  Ini: TRegIniFile;
  Name: String;
  Maximized: Boolean;
begin
  Ini := TRegIniFile.Create(RegRootKey);
  Name := rsForm + f.ClassName;
  Maximized := Ini.ReadBool(Name, rsMaximized, True);
  if not Maximized then
    f.WindowState := wsNormal;
  f.SetBounds(Ini.ReadInteger(Name, rsX, f.Left),
              Ini.ReadInteger(Name, rsY, f.Top),
              Ini.ReadInteger(Name, rsWidth, f.Width),
              Ini.ReadInteger(Name, rsHeight, f.Height));
  Ini.Free;
end;


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

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

procedure TfrDock.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;
      if (Align = alBottom) and (c.Top < 0) then
      begin
        ShiftNeeded := True;
        L := -c.Top + 1;
        Inc(NewSize, L);
        break;
      end;
      if (Align = alTop) and (c.Top + c.Height > NewSize) then