home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_Dock.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-04  |  32KB  |  1,231 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {              Tool controls               }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_Dock;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   Classes, Types, QGraphics, QControls, QForms, QStdCtrls, QComCtrls, FR_Ctrls,
  19.   QExtCtrls, QButtons, IniFiles;
  20.  
  21. type
  22.   TfrOrientation = (toAny, toVertOnly, toHorzOnly);
  23.  
  24.   TfrFloatWindow = class;
  25.  
  26.   TfrDock = class(TPanel)
  27.   private
  28.     FRowSize: Integer;
  29.   protected
  30.     procedure Loaded; override;
  31.   public
  32.     constructor Create(AOwner: TComponent); override;
  33.     procedure AdjustBounds;
  34.     procedure Paint; override;
  35.   published
  36.     property RowSize: Integer read FRowSize write FRowSize default 26;
  37.   end;
  38.  
  39.   TfrDragBox = class(TGraphicControl)
  40.   protected
  41.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  42.       X, Y: Integer); override;
  43.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  44.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  45.       X, Y: Integer); override;
  46.   public
  47.     constructor Create(AOwner: TComponent); override;
  48.     procedure Paint; override;
  49.   end;
  50.  
  51.   TfrToolBar = class(TPanel)
  52.   private
  53.     FDragBox: TfrDragBox;
  54.     FWindow: TfrFloatWindow;
  55.     FIsFloat: Boolean;
  56.     FDown: Boolean;
  57.     FLastX, FLastY: Integer;
  58.     FOrientation: TfrOrientation;
  59.     FCanFloat: Boolean;
  60.     function ParentAlign: TAlign;
  61.     function FindDock(AOwner: TWinControl; p: TPoint): Boolean;
  62.     procedure MakeFloat;
  63.     function MoveTo(X, Y: Integer): Boolean;
  64.     function GetVisible: Boolean;
  65.     procedure SetVisible(Value: Boolean);
  66.     procedure DockTo(Dock: TfrDock; X, Y: Integer);
  67.     procedure FloatTo(X,Y: Integer);
  68.     procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
  69.       Shift: TShiftState; X, Y: Integer);
  70.     procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
  71.       Y: Integer);
  72.     procedure DoMouseUp(Sender: TObject; Button: TMouseButton;
  73.       Shift: TShiftState; X, Y: Integer);
  74.     procedure DoResize(Sender: TObject);
  75.     function GetFloatWindow: TForm;
  76.   protected
  77.     procedure Loaded; override;
  78.     procedure RealignControls;
  79.     function GetClientRect: TRect; override;
  80.   public
  81.     constructor Create(AOwner: TComponent); override;
  82.     destructor Destroy; override;
  83.     procedure Paint; override;
  84.     procedure AdjustBounds;
  85.     procedure AddToDock(Dock: TfrDock);
  86.     property IsFloat: Boolean read FIsFloat;
  87.     property FloatWindow: TForm read GetFloatWindow;
  88.     property IsVisible: Boolean read GetVisible write SetVisible;
  89.   published
  90.     property CanFloat: Boolean read FCanFloat write FCanFloat default True;
  91.     property Orientation: TfrOrientation read FOrientation write FOrientation;
  92.   end;
  93.  
  94.   TfrTBToolBar = class(TToolBar)
  95.   protected
  96.     procedure SetParent(const AParent: TWinControl); override;
  97.   public
  98.     constructor Create(AOwner: TComponent); override;
  99.   end;
  100.  
  101.   TfrTBSeparator = class(TGraphicControl)
  102.   protected
  103.     FDrawBevel: Boolean;
  104.     procedure SetParent(const AParent: TWinControl); override;
  105.     procedure SetDrawBevel(Value: Boolean);
  106.   public
  107.     constructor Create(AOwner: TComponent); override;
  108.     procedure Paint; override;
  109.   published
  110.     property Align;
  111.     property DrawBevel: Boolean read FDrawBevel write SetDrawBevel default True;
  112.     property Height;
  113.     property Width;
  114.   end;
  115.  
  116.   TfrTBPanel = class(TPanel)
  117.   protected
  118.     procedure SetParent(const AParent: TWinControl); override;
  119.   public
  120.     constructor Create(AOwner: TComponent); override;
  121.     procedure Paint; override;
  122.   end;
  123.  
  124.   TfrTBButton = class(TfrSpeedButton)
  125.   protected
  126.     procedure SetParent(const AParent: TWinControl); override;
  127.   public
  128.     constructor Create(AOwner: TComponent); override;
  129.   published
  130.     property Align;
  131.     property Flat default True;
  132.   end;
  133.  
  134.   TfrFloatWindow = class(TForm)
  135.     Panel1: TPanel;
  136.     CloseBtn: TfrSpeedButton;
  137.     procedure FormDestroy(Sender: TObject);
  138.     procedure FormPaint(Sender: TObject);
  139.     procedure CloseBtnClick(Sender: TObject);
  140.     procedure FormShow(Sender: TObject);
  141.   private
  142.     FPoint: TPoint;
  143.     FDown: Boolean;
  144.   protected
  145.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  146.       X, Y: Integer); override;
  147.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  148.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  149.       X, Y: Integer); override;
  150.   public
  151.     ToolBar: TfrToolBar;
  152.     constructor Create(AOwner: TComponent); override;
  153.     procedure Capture;
  154.   end;
  155.  
  156. const
  157.   rsToolBar             = 'ToolBar';
  158.   rsForm                = 'Form';
  159.   rsWidth               = 'Width';
  160.   rsHeight              = 'Height';
  161.   rsTop                 = 'Top';
  162.   rsLeft                = 'Left';
  163.   rsFloat               = 'isFloat';
  164.   rsVisible             = 'isVisible';
  165.   rsX                   = 'XPosition';
  166.   rsY                   = 'YPosition';
  167.   rsDockName            = 'DockName';
  168.   rsMaximized           = 'Maximized';
  169.  
  170. procedure SaveToolbarPosition(Ini: TMemIniFile; t: TfrToolBar);
  171. procedure RestoreToolbarPosition(Ini: TMemIniFile; t: TfrToolBar);
  172. procedure SaveFormPosition(Ini: TMemIniFile; f: TForm);
  173. procedure RestoreFormPosition(Ini: TMemIniFile; f: TForm);
  174.  
  175.  
  176. implementation
  177.  
  178. {$R *.xfm}
  179.  
  180. var
  181.   FloatingToolBars: TList;
  182.  
  183.  
  184. procedure AddToToolbarList(t: TfrToolBar);
  185. begin
  186.   if FloatingToolbars.IndexOf(t) <> -1 then
  187.     FloatingToolbars.Add(t);
  188. end;
  189.  
  190. procedure RemoveFromToolbarList(t: TfrToolBar);
  191. var
  192.   i: Integer;
  193. begin
  194.   i := FloatingToolbars.IndexOf(t);
  195.   if i <> -1 then
  196.     FloatingToolbars.Delete(i);
  197. end;
  198.  
  199. procedure DestroyToolbarList;
  200. var
  201.   i: Integer;
  202. begin
  203.   for i := 0 to FloatingToolBars.Count-1 do
  204.     TfrToolBar(FloatingToolBars[i]).Free;
  205. end;
  206.  
  207.  
  208. procedure SaveToolbarPosition(Ini: TMemIniFile; t: TfrToolBar);
  209. var
  210.   X, Y: integer;
  211.   Name: String;
  212. begin
  213.   Name := rsToolbar + t.Name;
  214.   Ini.WriteBool(Name, rsFloat, t.isFloat);
  215.   Ini.WriteBool(Name, rsVisible, t.IsVisible);
  216.   X := t.Left; Y := t.Top;
  217.   if t.IsFloat then
  218.   begin
  219.     X := t.FloatWindow.Left; Y := t.FloatWindow.Top;
  220.   end;
  221.   Ini.WriteInteger(Name, rsX, X);
  222.   Ini.WriteInteger(Name, rsY, Y);
  223.   Ini.WriteInteger(Name, rsWidth, t.Width);
  224.   Ini.WriteInteger(Name, rsHeight, t.Height);
  225.   if t.Parent is TfrDock then
  226.     Ini.WriteString(Name, rsDockName, t.Parent.Name);
  227. end;
  228.  
  229. procedure RestoreToolbarPosition(Ini: TMemIniFile; t: TfrToolBar);
  230. var
  231.   X, Y: Integer;
  232.   DN: string;
  233.   NewDock: TfrDock;
  234.   Name: String;
  235. begin
  236.   Name := rsToolbar + t.Name;
  237.   t.IsVisible := False;
  238.   X := Ini.ReadInteger(Name, rsX, t.Left);
  239.   Y := Ini.ReadInteger(Name, rsY, t.Top);
  240.   t.Width := Ini.ReadInteger(Name, rsWidth, t.Width);
  241.   t.Height := Ini.ReadInteger(Name, rsHeight, t.Height);
  242.   if Ini.ReadBool(Name, rsFloat, False) then
  243.     t.FloatTo(X, Y)
  244.   else
  245.   begin
  246.     t.Left := X;
  247.     t.Top := Y;
  248.     DN := Ini.ReadString(Name, rsDockName, t.Parent.Name);
  249.     if (t.Owner <> nil) then
  250.     begin
  251.       NewDock := t.Owner.FindComponent(DN) as TfrDock;
  252.       if (NewDock <> nil) and (NewDock <> t.Parent) then
  253.         t.DockTo(NewDock, X, Y);
  254.     end;
  255.     t.AdjustBounds;
  256.   end;
  257.   t.IsVisible := Ini.ReadBool(Name, rsVisible, True);
  258. end;
  259.  
  260. procedure SaveFormPosition(Ini: TMemIniFile; f: TForm);
  261. var
  262.   Name: String;
  263. begin
  264.   Name := rsForm + f.ClassName;
  265.   Ini.WriteInteger(Name, rsX, f.Left);
  266.   Ini.WriteInteger(Name, rsY, f.Top);
  267.   Ini.WriteInteger(Name, rsWidth, f.Width);
  268.   Ini.WriteInteger(Name, rsHeight, f.Height);
  269.   Ini.WriteBool(Name, rsMaximized, f.WindowState = wsMaximized);
  270. end;
  271.  
  272. procedure RestoreFormPosition(Ini: TMemIniFile; f: TForm);
  273. var
  274.   Name: String;
  275.   Maximized: Boolean;
  276. begin
  277.   Name := rsForm + f.ClassName;
  278.   Maximized := Ini.ReadBool(Name, rsMaximized, True);
  279.   if not Maximized then
  280.     f.WindowState := wsNormal;
  281.   f.SetBounds(Ini.ReadInteger(Name, rsX, f.Left),
  282.               Ini.ReadInteger(Name, rsY, f.Top),
  283.               Ini.ReadInteger(Name, rsWidth, f.Width),
  284.               Ini.ReadInteger(Name, rsHeight, f.Height));
  285. end;
  286.  
  287.  
  288. {--------------------------------------------------------------------------}
  289. constructor TfrDock.Create(AOwner: TComponent);
  290. begin
  291.   inherited Create(AOwner);
  292.   RowSize := 26;
  293.   Align := alTop;
  294. end;
  295.  
  296. procedure TfrDock.Loaded;
  297. begin
  298.   inherited Loaded;
  299.   AdjustBounds;
  300. end;
  301.  
  302. procedure TfrDock.AdjustBounds;
  303. var
  304.   i, Line, LineCount, l, dl: Integer;
  305.   CtlOnLine, NewSize: Integer;
  306.   c: TControl;
  307.   ShiftNeeded: Boolean;
  308. begin
  309.   if ControlCount = 0 then
  310.   begin
  311.     if Align in [alTop, alBottom] then
  312.       Height := 1 else
  313.       Width := 1;
  314.     Exit;
  315.   end;
  316.   if Align in [alTop, alBottom] then
  317.     L := Height else
  318.     L := Width;
  319.   LineCount := L div RowSize;
  320.   NewSize := RowSize * LineCount + 1;
  321.   L := 0;
  322.   dL := RowSize;
  323.   if Align in [alRight, alBottom] then
  324.   begin
  325.     dL := -RowSize;
  326.     if Align = alRight then
  327.       L := Width else
  328.       L := Height;
  329.   end;
  330.   Line := 0;
  331.   while Line < LineCount do
  332.   begin
  333.     CtlOnLine := 0;
  334.     for i := 0 to ControlCount-1 do
  335.     begin
  336.       c := Controls[i];
  337.       if c.Visible then
  338.       case Align of
  339.         alLeft:
  340.           if (c.Left = L) or
  341.             ((c.Left < L) and (c.Left + c.Width > L)) then Inc(CtlOnLine);
  342.         alRight:
  343.           if (c.Left + c.Width = L) or
  344.             ((c.Left + c.Width > L) and (c.Left < L)) then Inc(CtlOnLine);
  345.         alTop:
  346.           if (c.Top = L) or
  347.             ((c.Top < L) and (c.Top + c.Height > L)) then Inc(CtlOnLine);
  348.         alBottom:
  349.           if (c.Top + c.Height = L) or
  350.             ((c.Top + c.Height > L) and (c.Top < L)) then Inc(CtlOnLine);
  351.       end;
  352.     end;
  353.     if CtlOnLine = 0 then
  354.     begin
  355.       for i := 0 to ControlCount-1 do
  356.       begin
  357.         c := Controls[i];
  358.         if c.Visible then
  359.         begin
  360.           if ((Align = alLeft) and (c.Left > L)) or
  361.              ((Align = alRight) and (c.Left + c.Width > L)) then
  362.             c.Left := c.Left - RowSize;
  363.           if ((Align = alTop) and (c.Top > L)) or
  364.              ((Align = alBottom) and (c.Top + c.Height > L)) then
  365.             c.Top := c.Top - RowSize;
  366.         end;
  367.       end;
  368.       Dec(NewSize, RowSize);
  369.       Dec(LineCount);
  370.       Dec(Line);
  371.       if Align in [alTop, alLeft] then Dec(L, dL);
  372.     end;
  373.     Inc(Line);
  374.     Inc(L, dL);
  375.   end;
  376.  
  377.   ShiftNeeded := False;
  378.   for i := 0 to ControlCount-1 do
  379.   begin
  380.     c := Controls[i];
  381.     if c.Visible then
  382.     begin
  383.       if (Align = alRight) and (c.Left < 0) then
  384.       begin
  385.         ShiftNeeded := True;
  386.         L := -c.Left + 1;
  387.         Inc(NewSize, L);
  388.         break;
  389.       end;
  390.       if (Align = alBottom) and (c.Top < 0) then
  391.       begin
  392.         ShiftNeeded := True;
  393.         L := -c.Top + 1;
  394.         Inc(NewSize, L);
  395.         break;
  396.       end;
  397.       if (Align = alTop) and (c.Top + c.Height > NewSize) then
  398.       begin
  399.         NewSize := c.Top + c.Height + 1;
  400.         break;
  401.       end;
  402.       if (Align = alLeft) and (c.Left + c.Width > NewSize) then
  403.       begin
  404.         NewSize := c.Left + c.Width + 1;
  405.         break;
  406.       end;
  407.     end;
  408.   end;
  409.   if ShiftNeeded then
  410.     for i := 0 to ControlCount - 1 do
  411.     begin
  412.       c := Controls[i];
  413.       if c.Visible then
  414.         if Align = alRight then
  415.           c.Left := c.Left + L
  416.         else if Align = alBottom then
  417.           c.Top := c.Top + L;
  418.     end;
  419.  
  420.   for i := 0 to ControlCount - 1 do
  421.   begin
  422.     c := Controls[i];
  423.     if c.Visible then
  424.     begin
  425.       if (Align = alRight) and (c.Left + c.Width > NewSize) then
  426.         NewSize := c.Left + c.Width;
  427.       if (Align = alBottom) and (c.Top + c.Height > NewSize) then
  428.         NewSize := c.Top + c.Height;
  429.     end;
  430.   end;
  431.  
  432.   case Align of
  433.     alTop: Height := NewSize;
  434.     alLeft: Width := NewSize;
  435.     alBottom:
  436.       if Height < NewSize then
  437.         SetBounds(0, Top - (NewSize - Height), Width, NewSize)
  438.       else
  439.         Height := NewSize;
  440.     alRight:
  441.       if Width < NewSize then
  442.         SetBounds(Left - (NewSize - Width), Top, NewSize, Height)
  443.       else
  444.         Width := NewSize;
  445.   end;
  446. end;
  447.  
  448. procedure TfrDock.Paint;
  449. var
  450.   R: TRect;
  451. begin
  452.   with Canvas do
  453.   begin
  454.     Brush.Color := clBtnFace;
  455.     R := Rect(0, 0, Width, Height);
  456.     FillRect(R);
  457.     if csDesigning in ComponentState then
  458.     begin
  459.       Pen.Color := clBtnShadow;
  460.       Rectangle(0, 0, Width, Height);
  461.     end;
  462.   end;
  463. end;
  464.  
  465.  
  466. {--------------------------------------------------------------------------}
  467. constructor TfrDragBox.Create(AOwner: TComponent);
  468. begin
  469.   inherited Create(AOwner);
  470.   Width := 11;
  471.   Height := 11;
  472. end;
  473.  
  474. procedure TfrDragBox.Paint;
  475. var
  476.   R: TRect;
  477. begin
  478.   with Canvas do
  479.   begin
  480.     Brush.Color := clBtnFace;
  481.     R := Rect(0, 0, Width, Height);
  482.     FillRect(R);
  483.   end;
  484.   if (Parent as TfrToolBar).ParentAlign = alTop then
  485.   begin
  486.     R := Rect(2, 0, 5, Height);
  487.     Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
  488.     R := Rect(5, 0, 8, Height);
  489.     Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
  490.   end
  491.   else if (Parent as TfrToolBar).ParentAlign = alLeft then
  492.   begin
  493.     R := Rect(0, 2, Width, 5);
  494.     Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
  495.     R := Rect(0, 5, Width, 8);
  496.     Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
  497.   end;
  498. end;
  499.  
  500. procedure TfrDragBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  501.   X, Y: Integer);
  502. var
  503.   p: TPoint;
  504. begin
  505.   p := ClientToScreen(Point(X, Y));
  506.   p := Parent.ScreenToClient(p);
  507.   (Parent as TfrToolBar).DoMouseDown(Self, Button, Shift, P.X, P.Y);
  508. end;
  509.  
  510. procedure TfrDragBox.MouseMove(Shift: TShiftState; X, Y: Integer);
  511. var
  512.   p: TPoint;
  513. begin
  514.   p := ClientToScreen(Point(X, Y));
  515.   p := Parent.ScreenToClient(p);
  516.   (Parent as TfrToolBar).DoMouseMove(Self, Shift, P.X, P.Y);
  517. end;
  518.  
  519. procedure TfrDragBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  520.   X, Y: Integer);
  521. var
  522.   p: TPoint;
  523. begin
  524.   p := ClientToScreen(Point(X, Y));
  525.   p := Parent.ScreenToClient(p);
  526.   (Parent as TfrToolBar).DoMouseUp(Self, Button, Shift, P.X, P.Y);
  527. end;
  528.  
  529.  
  530. {--------------------------------------------------------------------------}
  531. constructor TfrToolBar.Create(AOwner: TComponent);
  532. begin
  533.   inherited Create(AOwner);
  534.   Height := 26;
  535.   FDragBox := TfrDragBox.Create(Self);
  536.   FDragBox.Parent := Self;
  537.   FDragBox.Align := alLeft;
  538.   OnMouseDown := DoMouseDown;
  539.   OnMouseMove := DoMouseMove;
  540.   OnMouseUp := DoMouseUp;
  541.   OnResize := DoResize;
  542.   FCanFloat := True;
  543.   FOrientation := toAny;
  544. end;
  545.  
  546. destructor TfrToolBar.Destroy;
  547. begin
  548.   FDragBox.Free;
  549.   if FWindow <> nil then
  550.   begin
  551.     Parent := nil;
  552.     FWindow.Hide;
  553.     FWindow.Free;
  554.   end;
  555.   inherited Destroy;
  556. end;
  557.  
  558. procedure TfrToolBar.Loaded;
  559. begin
  560.   inherited Loaded;
  561.   AdjustBounds;
  562. end;
  563.  
  564. procedure TfrToolBar.Paint;
  565. var
  566.   R: TRect;
  567. begin
  568.   with Canvas do
  569.   begin
  570.     Brush.Color := clBtnFace;
  571.     R := Rect(0, 0, Width, Height);
  572.     FillRect(R);
  573.     if not IsFloat then
  574.       Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
  575.   end;
  576. end;
  577.  
  578. function TfrToolBar.ParentAlign: TAlign;
  579. begin
  580.   Result := Parent.Align;
  581.   if Result = alBottom then Result := alTop;
  582.   if Result = alRight then Result := alLeft;
  583. end;
  584.  
  585. function TfrToolBar.GetClientRect: TRect;
  586. begin
  587.   Result := inherited GetClientRect;
  588.   Inc(Result.Top);
  589.   Inc(Result.Left);
  590. end;
  591.  
  592. function TfrToolBar.GetVisible: Boolean;
  593. begin
  594.   if IsFloat then
  595.     Result := FWindow.Visible else
  596.     Result := Visible;
  597. end;
  598.  
  599. procedure TfrToolBar.SetVisible(Value: Boolean);
  600. begin
  601.   if IsFloat then
  602.     FWindow.Visible := Value else
  603.     Visible := Value;
  604. end;
  605.  
  606. procedure TfrToolBar.DockTo(Dock: TfrDock; X, Y: Integer);
  607. var
  608.   oldParent: TfrDock;
  609. begin
  610.   Hide;
  611.   if FWindow <> nil then
  612.   begin
  613.     FWindow.Hide;
  614.     FWindow.Release;
  615.     Parent := nil;
  616.   end;
  617.   FWindow := nil;
  618.   oldParent := nil;
  619.   if (Parent <> nil) and (Parent is TfrDock) then
  620.     oldParent := Parent as TfrDock;
  621.   Parent := Dock;
  622.   if oldParent <> nil then
  623.     oldParent.AdjustBounds;
  624.   FIsFloat := False;
  625.   FDragBox.Show;
  626.   RealignControls;
  627.   Left := X; Top := Y;
  628.   Show;
  629.   AdjustBounds;
  630.   Dock.AdjustBounds;
  631.   RemoveFromToolbarList(Self);
  632. end;
  633.  
  634. procedure TfrToolBar.AddToDock(Dock: TfrDock);
  635. var
  636.   X,Y: Integer;
  637. begin
  638.   X := 0; Y := 0;
  639.   case Dock.Align of
  640.     alTop:
  641.       begin
  642.         X := 0; Y := Dock.Height - 1;
  643.       end;
  644.     alBottom:
  645.       begin
  646.         X := 0; Y := -Height + 1;
  647.       end;
  648.     alLeft:
  649.       begin
  650.         X := Dock.Width - 1; Y := 0;
  651.       end;
  652.     alRight:
  653.       begin
  654.         X := -Width + 1; Y := 0;
  655.       end;
  656.   end;
  657.   DockTo(Dock, X, Y);
  658. end;
  659.  
  660. function TfrToolBar.FindDock(AOwner: TWinControl; p: TPoint): Boolean;
  661. var
  662.   i: Integer;
  663.   c: TControl;
  664.   d: TfrDock;
  665. begin
  666.   Result := False;
  667.   for i := 0 to AOwner.ControlCount - 1 do
  668.   begin
  669.     c := AOwner.Controls[i];
  670.     if c is TfrDock then
  671.       if (p.X >= c.Left) and (p.X <= c.Left + c.Width) and
  672.          (p.Y >= c.Top) and (p.Y <= c.Top + c.Height) then
  673.       begin
  674.         with c as TfrDock do
  675.           if ((FOrientation = toHorzOnly) and (Align in [alLeft, alRight])) or
  676.              ((FOrientation = toVertOnly) and (Align in [alTop, alBottom])) then
  677.             break;
  678.         d := c as TfrDock;
  679.         if d.Align in [alTop,alBottom] then
  680.         begin
  681.           p := Point(p.X - d.Left, d.Height - 1);
  682.           if p.X + Width > d.Width then
  683.             p.X := d.Width - Width;
  684.           if p.X < 0 then p.X := 0;
  685.           if d.Align = alBottom then
  686.             p.Y := -Height + 1;
  687.         end
  688.         else
  689.         begin
  690.           p := Point(d.Width - 1, p.Y - d.Top);
  691.           if p.Y + Height > d.Height then
  692.             p.Y := d.Height - Height;
  693.           if p.Y < 0 then p.Y := 0;
  694.           if d.Align = alRight then
  695.             p.X := -Height + 1;
  696.         end;
  697.         DockTo(d, p.X, p.Y);
  698.         SetCaptureControl(Self);
  699.         DoMouseDown(Self, mbLeft, [], 0, 0);
  700.         Result := True;
  701.         break;
  702.       end;
  703.   end;
  704. end;
  705.  
  706. procedure TfrToolBar.RealignControls;
  707. var
  708.   i, j, t: Integer;
  709.   TempCtrl: TControl;
  710.   Ctrls: Array[0..100] of TControl;
  711. begin
  712.   with FDragBox do
  713.     SetBounds(0, 0, Width, Height);
  714.   for i := 0 to ControlCount - 1 do
  715.     Ctrls[i] := Controls[i];
  716.   for i := 0 to ControlCount - 1 do
  717.     for j := 0 to ControlCount - 2 do
  718.       if Ctrls[j].Visible then
  719.         if Parent.Align in [alTop, alBottom, alNone] then
  720.         begin
  721.           if Ctrls[j].Left > Ctrls[j + 1].Left then
  722.           begin
  723.             TempCtrl := Ctrls[j + 1];
  724.             Ctrls[j + 1] := Ctrls[j];
  725.             Ctrls[j] := TempCtrl;
  726.           end;
  727.         end
  728.         else
  729.         begin
  730.           if (Ctrls[j].Align in [alTop, alBottom]) and
  731.              (Ctrls[j + 1].Align in [alTop, alBottom]) and
  732.              (Ctrls[j].Top > Ctrls[j + 1].Top) then
  733.           begin
  734.             TempCtrl := Ctrls[j];
  735.             Ctrls[j] := Ctrls[j + 1];
  736.             Ctrls[j + 1] := TempCtrl;
  737.           end;
  738.         end;
  739.   case Parent.Align of
  740.     alTop, alBottom, alNone:
  741.     begin
  742.       if Height > Width then
  743.       begin
  744.         t := Width;
  745.         Width := Height;
  746.         Height := t;
  747.       end;
  748.       for t := 0 to ControlCount - 1 do
  749.         if (Ctrls[t] <> nil) and Ctrls[t].Visible then
  750.           if not (Ctrls[t].Align in [alLeft, alRight]) then
  751.             if (Ctrls[t].Align = alBottom) then
  752.               Ctrls[t].Align := alRight
  753.             else
  754.             begin
  755.               Ctrls[t].Left := Ctrls[t].Top;
  756.               Ctrls[t].Align := alLeft;
  757.             end;
  758.     end;
  759.     alLeft, alRight:
  760.     begin
  761.       if Width > Height then
  762.       begin
  763.         t := Width;
  764.         Width := Height;
  765.         Height := t;
  766.       end;
  767.       for t := 0 to ControlCount - 1 do
  768.         if (Ctrls[t] <> nil) and Ctrls[t].Visible then
  769.           if not (Ctrls[t].Align in [alTop, alBottom]) then
  770.             if (Ctrls[t].Align = alRight) then
  771.               Ctrls[t].Align := alBottom
  772.             else
  773.             begin
  774.               Ctrls[t].Top := Ctrls[t].Left;
  775.               Ctrls[t].Align := alTop;
  776.             end;
  777.     end;
  778.   end;
  779. end;
  780.  
  781. procedure TfrToolBar.AdjustBounds;
  782. var
  783.   i, max: Integer;
  784.   c: TControl;
  785. begin
  786.   RealignControls;
  787.   max := 0;
  788.   for i := 0 to ControlCount - 1 do
  789.   begin
  790.     c := Controls[i];
  791.     if c.Visible then
  792.       if Parent.Align in [alTop, alBottom, alNone] then
  793.         Inc(max, c.Width)
  794.       else
  795.         Inc(max, c.Height);
  796.   end;
  797.   if Parent.Align in [alTop, alBottom, alNone] then
  798.     Width := max + 4 else
  799.     Height := max + 4;
  800. end;
  801.  
  802. procedure TfrToolBar.MakeFloat;
  803. var
  804.   p: TPoint;
  805. begin
  806.   FIsFloat := True;
  807.   GetCursorPos(p);
  808.   FloatTo(p.X, p.Y);
  809.   FWindow.Capture;
  810. end;
  811.  
  812. procedure TfrToolBar.FloatTo(X, Y: Integer);
  813. var
  814.   oldParent: TfrDock;
  815. begin
  816.   FIsFloat := True;
  817.   if FWindow = nil then
  818.   begin
  819.     oldParent := nil;
  820.     if (Parent <> nil) and (Parent is TfrDock) then
  821.       oldParent := Parent as TfrDock;
  822.     Hide;
  823.     FDragBox.Hide;
  824.     FWindow := TfrFloatWindow.Create(GetParentForm(Self));
  825.     FWindow.BorderStyle := fbsNone;
  826.     FWindow.Left := X;
  827.     FWindow.Top := Y;
  828.     FWindow.Caption := Caption;
  829.     Parent := FWindow;
  830.     RealignControls;
  831.     if oldParent <> nil then
  832.     begin
  833.       if oldParent.Align in [alTop, alBottom] then
  834.         AdjustBounds;
  835.       oldParent.AdjustBounds;
  836.     end;
  837.     FWindow.Width := Width + 4;
  838.     FWindow.Height := Height + 18;
  839.     FWindow.ToolBar := Self;
  840.     Left := 2; Top := 16;
  841.     Show;
  842.     FWindow.Show;
  843.     AddToToolbarList(Self);
  844.   end
  845.   else
  846.     FWindow.SetBounds(X, Y, FWindow.Width, FWindow.Height);
  847. end;
  848.  
  849. function TfrToolBar.MoveTo(X, Y: Integer): Boolean;
  850. var
  851.   i, n, oldSize, ShiftCount: Integer;
  852.   c: TControl;
  853.   procedure Shift(ax,ay:Integer);
  854.   begin
  855.     x := ax;
  856.     y := ay;
  857.     Inc(ShiftCount);
  858.   end;
  859. begin
  860.   Result := True;
  861.   if IsFloat then Exit;
  862.   n := 0;
  863.   repeat
  864.     ShiftCount := 0;
  865.     if ParentAlign = alTop then
  866.     begin
  867.       if x < -20 then FIsFloat := True;
  868.       if x < 0 then Shift(0, y);
  869.       if x + Width > Parent.Width then Shift(Parent.Width - Width, y);
  870.     end
  871.     else // if ParentAlign = alLeft then
  872.     begin
  873.       if y < -20 then FIsFloat := True;
  874.       if y < 0 then Shift(x, 0);
  875.       if y + Height > Parent.Height then Shift(x, Parent.Height - Height);
  876.     end;
  877.     if not IsFloat then
  878.       for i := 0 to Parent.ControlCount-1 do
  879.       begin
  880.         c := Parent.Controls[i];
  881.         if (c <> Self) and c.Visible then
  882.           if ParentAlign = alTop then
  883.           begin
  884.             if ((y >= c.Top) and (y < c.Top + c.Height)) or
  885.                ((y <= c.Top) and (y + Height > c.Top)) then
  886.             begin
  887.               if (x >= c.Left) and (x < c.Left + c.Width) then
  888.                 Shift(c.Left + c.Width, y);
  889.               if (x < c.Left) and (x + Width > c.Left) then
  890.                 Shift(c.Left - Width, y);
  891.             end;
  892.           end
  893.           else // if ParentAlign = alLeft then
  894.           begin
  895.             if ((x >= c.Left) and (x < c.Left + c.Width)) or
  896.                ((x <= c.Left) and (x + Width > c.Left)) then
  897.             begin
  898.               if (y >= c.Top) and (y < c.Top + c.Height) then
  899.                 Shift(x, c.Top + c.Height);
  900.               if (y < c.Top) and (y + Height > c.Top) then
  901.                 Shift(x, c.Top - Height);
  902.             end;
  903.           end;
  904.       end;
  905.     Inc(n);
  906.   until (n > 3) or (ShiftCount = 0) or IsFloat;
  907.  
  908.   if not FCanFloat then FIsFloat := False;
  909.   if IsFloat then
  910.     MakeFloat
  911.   else
  912.     if n < 3 then
  913.     begin
  914.       if ParentAlign = alTop then
  915.         if (y + Height > Parent.Height) or (y < 0) then
  916.           oldSize := Parent.Height else
  917.           oldSize := 0
  918.       else
  919.         if (x + Width > Parent.Width) or (x < 0) then
  920.           oldSize := Parent.Width else
  921.           oldSize := 0;
  922.       Left := x;
  923.       Top := y;
  924.       (Parent as TfrDock).AdjustBounds;
  925.       if FCanFloat then
  926.         if ((ParentAlign = alTop) and (Parent.Height = oldSize)) or
  927.            ((ParentAlign = alLeft) and (Parent.Width = oldSize)) then
  928.           MakeFloat;
  929.     end
  930.     else Result := False;
  931. end;
  932.  
  933. procedure TfrToolBar.DoMouseDown(Sender: TObject; Button: TMouseButton;
  934.   Shift: TShiftState; X, Y: Integer);
  935. var
  936.   p: TPoint;
  937. begin
  938.   GetCursorPos(p);
  939.   FLastX := p.X; FLastY := p.Y;
  940.   FDown := True;
  941. end;
  942.  
  943. procedure TfrToolBar.DoMouseMove(Sender: TObject; Shift: TShiftState; X,
  944.   Y: Integer);
  945. var
  946.   p: TPoint;
  947.   dx, dy: Integer;
  948.   StepX, StepY: Integer;
  949.   b: Boolean;
  950. begin
  951.   if IsFloat then
  952.   begin
  953.     Cursor := crDefault;
  954.     FDown := False;
  955.     Exit;
  956.   end;
  957.   if not FDown then Exit;
  958.   GetCursorPos(p);
  959.   if ParentAlign = alTop then
  960.     StepY := (Parent as TfrDock).RowSize else
  961.     StepY := 1;
  962.   if ParentAlign = alLeft then
  963.     StepX := (Parent as TfrDock).RowSize else
  964.     StepX := 1;
  965.   dx := (p.X - FLastX) div StepX * StepX;
  966.   dy := (p.Y - FLastY) div StepY * StepY;
  967.   b := False;
  968.   if (dx <> 0) or (dy <> 0) then b := MoveTo(Left + dx, Top + dy);
  969.   if b then
  970.   begin
  971.     if dx <> 0 then FLastX := p.X;
  972.     if dy <> 0 then FLastY := p.Y;
  973.   end;
  974. end;
  975.  
  976. procedure TfrToolBar.DoMouseUp(Sender: TObject; Button: TMouseButton;
  977.   Shift: TShiftState; X, Y: Integer);
  978. begin
  979.   FDown := False;
  980. end;
  981.  
  982. procedure TfrToolBar.DoResize(Sender: TObject);
  983. begin
  984.   if csDestroying in ComponentState then Exit;
  985.   FDragBox.SetBounds(-20, -20, 11, 11);
  986.   if ParentAlign = alTop then
  987.     FDragBox.Align := alLeft else
  988.     FDragBox.Align := alTop;
  989. end;
  990.  
  991. function TfrToolBar.GetFloatWindow: TForm;
  992. begin
  993.   Result := FWindow;
  994. end;
  995.  
  996.  
  997. { TfrTBToolBar }
  998.  
  999. function GetAlign(al: TAlign): TAlign;
  1000. begin
  1001.   if al in [alLeft, alRight] then
  1002.     Result := alTop else
  1003.     Result := alLeft;
  1004. end;
  1005.  
  1006. constructor TfrTBToolBar.Create(AOwner: TComponent);
  1007. begin
  1008.   inherited Create(AOwner);
  1009.   Parent := AOwner as TWinControl;
  1010.   ButtonHeight := 22;
  1011.   ButtonWidth := 22;
  1012.   EdgeBorders := [];
  1013.   Flat := True;
  1014.   AutoSize := True;
  1015.   Indent := 0;
  1016. end;
  1017.  
  1018. procedure TfrTBToolBar.SetParent(const AParent: TWinControl);
  1019. begin
  1020.   Align := alNone;
  1021.   inherited SetParent(AParent);
  1022.   if not (csDestroying in ComponentState) and (AParent <> nil) and (Parent is TPanel) then
  1023.   begin
  1024.     Align := GetAlign(AParent.Parent.Align);
  1025.     if Parent is TfrToolBar then
  1026.       TfrToolBar(Parent).DoResize(Self);
  1027.   end;
  1028. end;
  1029.  
  1030.  
  1031. { TTBSeparator }
  1032.  
  1033. constructor TfrTBSeparator.Create(AOwner: TComponent);
  1034. begin
  1035.   inherited Create(AOwner);
  1036.   Align := alLeft;
  1037.   Width := 8;
  1038.   Height := 8;
  1039.   FDrawBevel := True;
  1040. end;
  1041.  
  1042. procedure TfrTBSeparator.SetParent(const AParent: TWinControl);
  1043. begin
  1044.   inherited;
  1045.   if not (csDestroying in ComponentState) and (AParent <> nil) and (Parent is TPanel) then
  1046.     Align := GetAlign(AParent.Parent.Align);
  1047. end;
  1048.  
  1049. procedure TfrTBSeparator.SetDrawBevel(Value: Boolean);
  1050. begin
  1051.   FDrawBevel := Value;
  1052.   Invalidate;
  1053. end;
  1054.  
  1055. procedure TfrTBSeparator.Paint;
  1056. begin
  1057.   with Canvas do
  1058.   begin
  1059.     Brush.Style := bsSolid;
  1060.     Brush.Color := clBtnFace;
  1061.     Pen.Style := psClear;
  1062.     Rectangle(0, 0, Width, Height);
  1063.     Pen.Style := psSolid;
  1064.     if FDrawBevel then
  1065.     case Align of
  1066.       alLeft, alRight:
  1067.       begin
  1068.         Pen.Color := clBtnShadow;
  1069.         MoveTo(Width div 2 - 1, 2);
  1070.         LineTo(Width div 2 - 1, Height - 2);
  1071.         Pen.Color := clBtnHighlight;
  1072.         MoveTo(Width div 2, 2);
  1073.         LineTo(Width div 2, Height - 2);
  1074.       end;
  1075.       alTop, alBottom:
  1076.       begin
  1077.         Pen.Color := clBtnShadow;
  1078.         MoveTo(2, Height div 2 - 1);
  1079.         LineTo(Width - 2, Height div 2 - 1);
  1080.         Pen.Color := clBtnHighlight;
  1081.         MoveTo(2, Height div 2);
  1082.         LineTo(Width - 2, Height div 2);
  1083.       end;
  1084.     end;
  1085.     if csDesigning in ComponentState then
  1086.     begin
  1087.       Brush.Style := bsClear;
  1088.       Pen.Style := psDot;
  1089.       Pen.Color := clBtnShadow;
  1090.       Rectangle(0, 0, Width - 1, Height - 1);
  1091.     end;
  1092.   end;
  1093. end;
  1094.  
  1095. constructor TfrTBPanel.Create(AOwner: TComponent);
  1096. begin
  1097.   inherited Create(AOwner);
  1098.   Align := alLeft;
  1099.   Width := 8;
  1100.   Height := 8;
  1101. end;
  1102.  
  1103. procedure TfrTBPanel.SetParent(const AParent: TWinControl);
  1104. begin
  1105.   inherited;
  1106.   if not (csDestroying in ComponentState) and (AParent <> nil) and (Parent is TPanel) then
  1107.     Align := GetAlign(AParent.Parent.Align);
  1108. end;
  1109.  
  1110. procedure TfrTBPanel.Paint;
  1111. begin
  1112.   with Canvas do
  1113.   begin
  1114.     Brush.Color := clBtnFace;
  1115.     FillRect(Rect(0, 0, Width, Height));
  1116.     if csDesigning in ComponentState then
  1117.     begin
  1118.       Brush.Style := bsClear;
  1119.       Pen.Style := psDot;
  1120.       Pen.Color := clBtnShadow;
  1121.       Rectangle(0, 0, Width - 1, Height - 1);
  1122.     end;
  1123.   end;
  1124. end;
  1125.  
  1126. { TTBButton }
  1127.  
  1128. constructor TfrTBButton.Create(AOwner: TComponent);
  1129. begin
  1130.   inherited Create(AOwner);
  1131.   Align := alLeft;
  1132.   Flat := True;
  1133. end;
  1134.  
  1135. procedure TfrTBButton.SetParent(const AParent: TWinControl);
  1136. begin
  1137.   inherited;
  1138.   if not (csDestroying in ComponentState) and (AParent <> nil) and (Parent is TPanel) then
  1139.     Align := GetAlign(AParent.Parent.Align);
  1140. end;
  1141.  
  1142.  
  1143.  
  1144. { TfrFloatWindow }
  1145.  
  1146. constructor TfrFloatWindow.Create(AOwner: TComponent);
  1147. begin
  1148.   inherited Create(AOwner);
  1149.   Parent := AOwner as TWinControl;
  1150. end;
  1151.  
  1152. procedure TfrFloatWindow.Capture;
  1153. begin
  1154.   SetCaptureControl(Self);
  1155.   MouseDown(mbLeft, [], 0, 0);
  1156. end;
  1157.  
  1158. procedure TfrFloatWindow.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1159.   X, Y: Integer);
  1160. var
  1161.   p: TPoint;
  1162. begin
  1163.   GetCursorPos(p);
  1164.   FPoint := p;
  1165.   Application.ProcessMessages;
  1166.   FDown := True;
  1167. end;
  1168.  
  1169. procedure TfrFloatWindow.MouseMove(Shift: TShiftState; X, Y: Integer);
  1170. var
  1171.   p: TPoint;
  1172. begin
  1173.   if not FDown or not (ssLeft in Shift) then Exit;
  1174.   GetCursorPos(p);
  1175.   SetBounds(Left + p.X - FPoint.X, Top + p.Y - FPoint.Y, Width, Height);
  1176.  
  1177.   FPoint := p;
  1178.   if ToolBar.FindDock(Owner as TWinControl,
  1179.     (Owner as TWinControl).ScreenToClient(p)) then
  1180.     Exit;
  1181. end;
  1182.  
  1183. procedure TfrFloatWindow.MouseUp(Button: TMouseButton; Shift: TShiftState;
  1184.   X, Y: Integer);
  1185. begin
  1186.   FDown := False;
  1187. end;
  1188.  
  1189. procedure TfrFloatWindow.FormDestroy(Sender: TObject);
  1190. begin
  1191.   if ToolBar <> nil then
  1192.     ToolBar.FWindow := nil;
  1193. end;
  1194.  
  1195. procedure TfrFloatWindow.FormPaint(Sender: TObject);
  1196. begin
  1197.   with Canvas do
  1198.   begin
  1199.     DrawButtonFace(Canvas, Rect(0, 0, Width, Height), 1, False, False, False);
  1200. //    Brush.Color := clActiveCaption;
  1201.     Brush.Color := clGray;
  1202.     FillRect(Rect(2, 2, Width - 2, 16));
  1203. //    Font.Color := clCaptionText;
  1204.     Font.Color := clWhite;
  1205.     Font.Size := 8;
  1206.     TextOut(2, 2, Caption);
  1207.   end;
  1208. end;
  1209.  
  1210. procedure TfrFloatWindow.CloseBtnClick(Sender: TObject);
  1211. begin
  1212.   Close;
  1213. end;
  1214.  
  1215. procedure TfrFloatWindow.FormShow(Sender: TObject);
  1216. begin
  1217.   Panel1.SetBounds(Width - 14, 4, 11, 11);
  1218. end;
  1219.  
  1220.  
  1221. {----------------------------------------------------------------------------}
  1222.  
  1223. initialization
  1224.   FloatingToolBars := TList.Create;
  1225.  
  1226. finalization
  1227.   DestroyToolbarList;
  1228.   FloatingToolBars.Free;
  1229.  
  1230. end.
  1231.