home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D1 / GRABBAR.ZIP / GrabBar.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-22  |  24KB  |  728 lines
  1. {$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }
  2.  
  3. {------------------------------------------------------------------------------}
  4. { TGrabBar v1.11                                                               }
  5. {------------------------------------------------------------------------------}
  6. { A grab bar, or splitter, to allow two windows to be resized simultaneously.  }
  7. { Copyright 1998, Brad Stowers.  All Rights Reserved.                          }
  8. { This component can be freely used and distributed in commercial and private  }
  9. { environments, provied this notice is not modified in any way.                }
  10. {------------------------------------------------------------------------------}
  11. { Feel free to contact me if you have any questions, comments or suggestions   }
  12. { at bstowers@pobox.com.                                                       }
  13. { The latest version of this component can always be found at:                 }
  14. {    http://www.pobox.com/~bstowers/delphi/                                    }
  15. { See GrabBar.txt for notes, known issues, and revision history.               }
  16. {------------------------------------------------------------------------------}
  17. { Date last modified:  September 21, 1998                                      }
  18. {------------------------------------------------------------------------------}
  19.  
  20. unit GrabBar;
  21.  
  22. interface
  23.  
  24. {$IFDEF DFS_WIN32}
  25.   {$R GrabBar.r32}
  26. {$ELSE}
  27.   {$R GrabBar.r16}
  28. {$ENDIF}
  29.  
  30. uses
  31.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  32.   Forms, Dialogs, DFSAbout;
  33.  
  34.  
  35. const
  36.   { This shuts up C++Builder 3 about the redefiniton being different. There
  37.     seems to be no equivalent in C1.  Sorry. }
  38.   {$IFDEF DFS_CPPB_3_UP}
  39.   {$EXTERNALSYM DFS_COMPONENT_VERSION}
  40.   {$ENDIF}
  41.   DFS_COMPONENT_VERSION = 'TGrabBar v1.11';
  42.  
  43. type
  44.   TGrabBarStyle = (gbHorizontal, gbVertical);
  45.  
  46.   TGrabBar = class(TCustomControl)
  47.   private
  48.     { Property Variables }
  49.     FBorderStyle: TBorderStyle;
  50.     FStyle: TGrabBarStyle;
  51.     FWindowA,
  52.     FWindowB: TWinControl;
  53.     FWindowAMinSize : integer;    { 0 or negative value = no minimum }
  54.     FWindowBMinSize : integer;
  55.     FDragUpdate: boolean;
  56.  
  57.     { Event Variables }
  58.     FOnMove: TNotifyEvent;
  59.  
  60.     { Internal Variables }
  61.     LastRect: TRect;
  62.     OldWndProc: TFarProc;
  63.     NewWndProc: Pointer;
  64.     FDragging: boolean;
  65.  
  66.     { Utility functions }
  67.     procedure HookParent;
  68.     procedure UnhookParent;
  69.     procedure HookWndProc(var Message: TMessage);
  70.  
  71.     function BarRect(APoint: TPoint): TRect;
  72.     function ClientToParent(APoint: TPoint): TPoint;
  73.     procedure InvertedRect(R: TRect; InvertLast: boolean);
  74.     procedure MoveWindows;
  75.     procedure ResizeBar;
  76.  
  77.     { Message response methods }
  78.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  79.     procedure WMMove(var Msg: TWMMove); message WM_MOVE;
  80.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  81.     procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  82.   protected
  83.     { Property methods }
  84.     procedure SetBorderStyle(Value: TBorderStyle);
  85.     procedure SetStyle(Value: TGrabBarStyle);
  86.     function GetThickness: Integer;
  87.     procedure SetThickness(Value: Integer);
  88.     procedure SetWindowA(Value: TWinControl);
  89.     procedure SetWindowB(Value: TWinControl);
  90.     function GetVersion: TDFSVersion;
  91.     procedure SetVersion(const Val: TDFSVersion);
  92.  
  93.     { Overriden methods }
  94.     procedure SetParent(Value: TWinControl); override;
  95.     procedure CreateParams(var Params: TCreateParams); override;
  96.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  97.        X, Y: Integer); override;
  98.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  99.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  100.        override;
  101.     procedure Notification(AComponent: TComponent; Operation: TOperation);
  102.        override;
  103.   public
  104.     constructor Create(AOwner: TComponent); override;
  105.     destructor Destroy; override;
  106.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  107.   published
  108.     { Properties }
  109.     property Version: TDFSVersion
  110.        read GetVersion
  111.        write SetVersion;
  112.     property BorderStyle: TBorderStyle
  113.        read FBorderStyle
  114.        write SetBorderStyle
  115.        default bsSingle;
  116.     property DragUpdate: boolean
  117.        read FDragUpdate
  118.        write FDragUpdate
  119.        default FALSE;
  120.     property Style: TGrabBarStyle
  121.        read FStyle
  122.        write SetStyle
  123.        default gbHorizontal;
  124.     property Thickness: integer
  125.        read GetThickness
  126.        write SetThickness;
  127.     property WindowA: TWinControl
  128.        read FWindowA
  129.        write SetWindowA;
  130.     property WindowAMinSize: integer
  131.        read FWindowAMinSize
  132.        write FWindowAMinSize;
  133.     property WindowB: TWinControl
  134.        read FWindowB
  135.        write SetWindowB;
  136.     property WindowBMinSize: integer
  137.        read FWindowBMinSize
  138.        write FWindowBMinSize;
  139.  
  140.     { Events }
  141.     property OnMove: TNotifyEvent
  142.        read FOnMove
  143.        write FOnMove;
  144.  
  145.     { Publish Inherited Protected Properties }
  146.     property Color;
  147.     property Ctl3D;
  148.     property Cursor
  149.        default crVSplit;
  150.     property Hint;
  151.     property ParentColor;
  152.     property ParentCtl3D;
  153.     property ParentShowHint;
  154.     property ShowHint;
  155.     property Visible;
  156.  
  157.     { Publish Inherited Protected Events }
  158.     property OnClick;
  159.     property OnDblClick;
  160.     property OnMouseDown;
  161.     property OnMouseMove;
  162.     property OnMouseUp;
  163.   end;
  164.  
  165. implementation
  166.  
  167. uses
  168.   ExtCtrls;
  169.  
  170.  
  171. { Note that the "hook" is not installed here.  Parent is not valid in the }
  172. { constructor.  See SetParent.                                            }
  173. constructor TGrabBar.Create(AOwner: TComponent);
  174. begin
  175.   inherited Create(AOwner);
  176.   { Initialize variables }
  177.   FDragging := FALSE;
  178.   FDragUpdate := FALSE;
  179.   NewWndProc := NIL;
  180.   OldWndProc := NIL;
  181.   SetRectEmpty(LastRect);
  182.   { Set Defaults }
  183.   FBorderStyle := bsSingle;
  184.   FStyle := gbHorizontal;
  185.   Cursor := crVSplit;
  186.   Thickness := 4;
  187. end;
  188.  
  189. destructor TGrabBar.Destroy;
  190. begin
  191.   if FDragging then { Remove the clipping of the mouse cursor }
  192.     ClipCursor(NIL);
  193.   { Always make sure that the hook is removed. }
  194.   UnhookParent;
  195.   inherited Destroy;
  196. end;
  197.  
  198. { This procedure is used to get the parent's window procedure, save it,      }
  199. { and replace it with our own.  This allows see all of the parent's messages }
  200. { before it does.                                                            }
  201. procedure TGrabBar.HookParent;
  202. begin
  203.   { If there is no parent, we can't hook it. }
  204.   if Parent = NIL then exit;
  205.   { Get the old window procedure via API call and store it. }
  206.   OldWndProc := TFarProc(GetWindowLong(Parent.Handle, GWL_WNDPROC));
  207.   { Convert our object method into something Windows knows how to call }
  208.   NewWndProc := MakeObjectInstance(HookWndProc);
  209.   { Install it as the new Parent window procedure }
  210.   SetWindowLong(Parent.Handle, GWL_WNDPROC, LongInt(NewWndProc));
  211. end;
  212.  
  213. { Remove our window function and reinstall the original. }
  214. procedure TGrabBar.UnhookParent;
  215. begin
  216.   { We must have a parent, and we must have already hooked it. }
  217.   if (Parent <> NIL) and assigned(OldWndProc) then
  218.     { Set back to original window procedure }
  219.     SetWindowLong(Parent.Handle, GWL_WNDPROC, LongInt(OldWndProc));
  220.   { If we have created a window procedure via MakeObjectInstance, }
  221.   { it must be disposed of.                                       }
  222.   if assigned(NewWndProc) then
  223.     FreeObjectInstance(NewWndProc);
  224.   { Reset variables to NIL }
  225.   NewWndProc := NIL;
  226.   OldWndProc := NIL;
  227. end;
  228.  
  229. { The window procedure that is installed into our parent. }
  230. procedure TGrabBar.HookWndProc(var Message: TMessage);
  231.   function Max(i1, i2: integer): integer;
  232.   begin
  233.     if i1 > i2 then
  234.       Result := i1
  235.     else
  236.       Result := i2;
  237.   end;
  238. begin
  239.   { If there's no parent, something has really gone wrong. }
  240.   if Parent = NIL then exit;
  241.   with Message do begin
  242.     { ALWAYS call the old window procedure so the parent can process its    }
  243.     { messages.  Thanks to Gary Frerking for pointing me at CallWindowProc. }
  244.     { I was trying to call the function directly, which died horribly.      }
  245.     Result := CallWindowProc(OldWndProc, Parent.Handle, Msg, wParam, lParam);
  246.  
  247.     { If Parent gets a WM_SIZE message, it has been resized }
  248.     if (Msg = WM_SIZE) and (wParam <> SIZE_MINIMIZED) then begin
  249.       { We need to resize the bar so it fits in the new size, honor FWindowBMinSize }
  250.       if FStyle = gbHorizontal then begin
  251.         if Top > Parent.ClientHeight-FWindowBMinSize then
  252.           Top := Parent.ClientHeight - FWindowBMinSize;
  253.       end else
  254.         if Left > Parent.ClientWidth-FWindowBMinSize then
  255.           Left := Parent.ClientWidth - FWindowBMinSize;
  256.       ResizeBar;
  257.       { And update the positions of the windows we control }
  258.       MoveWindows;
  259.     end;
  260.   end;
  261. end;
  262.  
  263. { Function to calculate rectangle coordinates of the bar given a point. }
  264. function TGrabBar.BarRect(APoint: TPoint): TRect;
  265. begin
  266.   SetRectEmpty(Result);
  267.   if Parent = nil then exit;
  268.   if FStyle = gbHorizontal then
  269.     Result := Bounds(0, APoint.Y - (Thickness div 2),
  270.                      Parent.ClientWidth, Thickness)
  271.   else
  272.     Result := Bounds(APoint.X - (Thickness div 2), 0,
  273.                      Thickness, Parent.ClientHeight);
  274. end;
  275.  
  276. { Convert from our client coordinates to parent's client coordinates. }
  277. function TGrabBar.ClientToParent(APoint: TPoint): TPoint;
  278. begin
  279.   if Parent = NIL then
  280.     Result := ClientToScreen(APoint)
  281.   else begin
  282.     Result := ClientToScreen(APoint);
  283.     Result := Parent.ScreenToClient(Result);
  284.   end;
  285. end;
  286.  
  287. { Draw an inverted rectangle on the parent to indicate where the bar }
  288. { will be when it is released.                                       }
  289. procedure TGrabBar.InvertedRect(R: TRect; InvertLast: boolean);
  290. var
  291.   aDC: hDC;
  292. begin
  293.   if Parent = nil then exit;
  294.   { Get the parent's device context (something we can draw on).  Flags }
  295.   { indicate that we want to be able to draw anywhere on the parent,   }
  296.   { regardless of what it's child windows have to say about it.  Also  }
  297.   { speed it up a bit.                                                 }
  298.   aDC := GetDCEx(Parent.Handle, 0, DCX_PARENTCLIP or DCX_CACHE);
  299.   { Invert the last rectange we drew to remove it. }
  300.   { Inverted + Inverted = NOT Inverted.            }
  301.   if InvertLast and not IsRectEmpty(LastRect) then
  302.     InvertRect(aDC, LastRect);
  303.   { Draw the new rectangle }
  304.   InvertRect(aDC, R);
  305.   { Release the DC when done with it or very bad things will happen. }
  306.   ReleaseDC(Parent.Handle, aDC);
  307. end;
  308.  
  309. { Reposition the windows we are responsible for. }
  310. procedure TGrabBar.MoveWindows;
  311.   { Move the top or left window by setting its height or width }
  312.   procedure MoveWindowA;
  313.   begin
  314.     if FStyle = gbHorizontal then
  315.       FWindowA.Height := Top - FWindowA.Top
  316.     else
  317.       FWindowA.Width := Left - FWindowA.Left;
  318.   end;
  319.  
  320.   { Move the bottom or right window by recalculating its Top or Left }
  321.   procedure MoveWindowB;
  322.   var
  323.     X: integer;
  324.   begin
  325.     if FStyle = gbHorizontal then begin
  326.       X := Top + Thickness;
  327.       with FWindowB do
  328.         SetBounds(Left, X, Width, Height + Top - X);
  329.     end else begin
  330.       X := Left + Thickness;
  331.       with FWindowB do
  332.         SetBounds(X, Top, Width + (Left - X), Height);
  333.     end;
  334.   end;
  335. var
  336.   newSize: integer;
  337. begin
  338.   if Parent = NIL then exit;
  339.   { Disable parent aligning until we move both windows.  If we don't, the    }
  340.   { parent will try to reposition aligned controls when they are moved.      }
  341.   { This produces scrollbars in some cases and annoying flicker most always. }
  342.   Parent.DisableAlign;
  343.  
  344.   { Added by Beth Weiss, 2/12/97:                                            }
  345.   { If the user has attempted to make one of the window's too small,         }
  346.   { adjust Top/Left so that window is the minimum allowed size.              }
  347.   if assigned(FWindowA) and (FWindowAMinSize > 0) then begin
  348.     if FStyle = gbHorizontal then begin
  349.       if Top - FWindowA.Top < FWindowAMinSize then
  350.         Top := FWindowAMinSize;
  351.     end  { horizontal }
  352.     else begin
  353.       if Left - FWindowA.Left < FWindowAMinSize then
  354.         Left := FWindowAMinSize
  355.     end;  { vertical }
  356.   end;  { adjust windowA's size as necessary }
  357.  
  358.   if assigned(FWindowB) and (FWindowBMinSize > 0) then begin
  359.     if FStyle = gbHorizontal then begin
  360.       newSize := FWindowB.Top + FwindowB.Height - (Top + Thickness);
  361.       if newSize < FWindowBMinSize then
  362.         Top := top - (FWindowBMinSize - newSize);
  363.     end  { horizontal }
  364.     else begin { vertical }
  365.       newSize := FWindowB.Left + FWindowB.Width - (Left + Thickness);
  366.       if newSize < FWindowBMinSize then
  367.         Left := left - (FWindowBMinSize - newSize);
  368.     end;  { vertical }
  369.   end;   { adjust Top if WindowB was made too small }
  370.  
  371.   { end of additions by Beth Weiss }
  372.  
  373.   if assigned(FWindowA) then
  374.     MoveWindowA;
  375.   if assigned(FWindowB) then
  376.     MoveWindowB;
  377.   { Tell parent it can align controls now if it wants.  We have repositioned }
  378.   { windows and they should not need further moving.                         }
  379.   Parent.EnableAlign;
  380. end;
  381.  
  382. { Reset the bar's size to fill the client's width or height. }
  383. procedure TGrabBar.ResizeBar;
  384. var
  385.  PPanel : TPanel;
  386. begin
  387.   if (Parent = NIL) then exit;
  388.   if FStyle = gbHorizontal then
  389.   begin
  390.     if (Parent is TCustomPanel) then
  391.     begin {Respect border widths}
  392.       PPanel := (Parent as TPanel);{Use Panel instead of CustomPanel}
  393.       SetBounds(PPanel.BorderWidth, Top,
  394.                 Parent.ClientWidth - 2*PPanel.BorderWidth, Thickness);
  395.     end else
  396.       SetBounds(0, Top, Parent.ClientWidth, Thickness)
  397.   end else begin
  398.     if (Parent is TCustomPanel) then
  399.     begin {Respect border widths}
  400.       PPanel := (Parent as TPanel);{USe Panel instead of CustomPanel}
  401.       SetBounds(Left, PPanel.BorderWidth ,
  402.                 Thickness, Parent.ClientHeight - 2*PPanel.BorderWidth);
  403.     end else
  404.       SetBounds(Left, 0, Thickness, Parent.ClientHeight);
  405.   end;
  406. end;
  407.  
  408. { The value of the Ctl3D property has changed, invalidate the control so }
  409. { that it is redrawn to reflect the change.                              }
  410. procedure TGrabBar.CMCtl3DChanged(var Message: TMessage);
  411. begin
  412.   inherited;
  413.   Invalidate;
  414. end;
  415.  
  416. { We have been moved.  Make sure we are as wide or tall as the parent. }
  417. procedure TGrabBar.WMMove(var Msg: TWMMove);
  418. begin
  419.   inherited;
  420.   ResizeBar;
  421. end;
  422.  
  423. { We have been resized.  Make sure we are as wide or tall as the parent. }
  424. procedure TGrabBar.WMSize(var Msg: TWMSize);
  425. begin
  426.   inherited;
  427.   ResizeBar;
  428. end;
  429.  
  430. { BorderStyle property has changed.  Redraw control to reflect change. }
  431. procedure TGrabBar.SetBorderStyle(Value: TBorderStyle);
  432. begin
  433.   if Value = FBorderStyle then exit;
  434.   FBorderStyle := Value;
  435.   RecreateWnd;
  436. end;
  437.  
  438. { A Parent has been assigned or changed.  Unhook old parent and install }
  439. { hook in new parent.                                                   }
  440. procedure TGrabBar.SetParent(Value: TWinControl);
  441. begin
  442.   { UnhookParent knows if the current parent has been hooked or not }
  443.   UnhookParent;
  444.   { Set Parent to the new value }
  445.   inherited SetParent(Value);
  446.   { Hook the new parent's window procedure }
  447.   HookParent;
  448.   { Size ourselves to fill the new parent's client area }
  449.   ResizeBar;
  450.   { Position our windows accordingly }
  451.   MoveWindows;
  452. end;
  453.  
  454. { Set whether the bar is horizontal or vertical, setting the cursor }
  455. { accordingly. }
  456. procedure TGrabBar.SetStyle(Value: TGrabBarStyle);
  457. begin
  458.   if Value = FStyle then exit;
  459.   FStyle := Value;
  460.   if FStyle = gbHorizontal then begin
  461.     Cursor := crVSplit;
  462.     Height := Width;
  463. {    if Parent <> NIL then
  464.       Top := Parent.ClientHeight div 2;}
  465.   end else begin
  466.     Cursor := crHSplit;
  467.     Width := Height;
  468. {    if Parent <> NIL then
  469.       Left := Parent.ClientWidth div 2;}
  470.   end;
  471.   ResizeBar;
  472. end;
  473.  
  474. { Return the thickness of the bar, depending on the orientation. }
  475. function TGrabBar.GetThickness: integer;
  476. begin
  477.   if FStyle = gbHorizontal then
  478.     Result := Height
  479.   else
  480.     Result := Width;
  481. end;
  482.  
  483. { Set the thickness, depending on the orientation. }
  484. procedure TGrabBar.SetThickness(Value: integer);
  485. begin
  486.   if (Value = Thickness) or (Value < 0) then exit;
  487.   if FStyle = gbHorizontal then
  488.     Height := Value
  489.   else
  490.     Width := Value;
  491. end;
  492.  
  493. { Set a window we are responsible for.  Do not allow selection of ourself or }
  494. { the other window being split.                                              }
  495. procedure TGrabBar.SetWindowA(Value: TWinControl);
  496. begin
  497.   if (Value = FWindowA) or (Value = FWindowB) or (Value = Self) then exit;
  498.   FWindowA := Value;
  499.   { Position it correctly with the bar. }
  500.   MoveWindows;
  501. end;
  502.  
  503. { Set a window we are responsible for.  Do not allow selection of ourself or }
  504. { the other window being split.                                              }
  505. procedure TGrabBar.SetWindowB(Value: TWinControl);
  506. begin
  507.   if (Value = FWindowA) or (Value = FWindowB) or (Value = Self) then exit;
  508.   FWindowB := Value;
  509.   { Position it correctly with the bar. }
  510.   MoveWindows;
  511. end;
  512.  
  513. procedure TGrabBar.CreateParams(var Params: TCreateParams);
  514. begin
  515.   inherited CreateParams(Params);
  516.   if FBorderStyle = bsSingle then
  517.     Params.Style := Params.Style or WS_BORDER;
  518. end;
  519.  
  520. procedure TGrabBar.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
  521. var
  522.   FrameBrush: HBRUSH;
  523. begin
  524.   inherited; { Paint rectangle with Color property }
  525.   if Ctl3D then begin
  526.     FrameBrush := CreateSolidBrush(ColorToRGB(clBtnShadow));
  527.     try
  528.       FrameRect(Msg.DC, Rect(-1, -1, Width, Height), FrameBrush);
  529.     finally
  530.       DeleteObject(FrameBrush);
  531.     end;
  532.     FrameBrush := CreateSolidBrush(ColorToRGB(clBtnHighlight));
  533.     try
  534.       FrameRect(Msg.DC, Rect(0, 0, Width+1, Height+1), FrameBrush);
  535.     finally
  536.       DeleteObject(FrameBrush);
  537.     end;
  538.   end;
  539. end;
  540.  
  541. { Mouse button has been pressed.  Setup for moving the bar. This is only }
  542. { called when the application is running, not in design mode.            }
  543. procedure TGrabBar.MouseDown(Button: TMouseButton;
  544.                              Shift: TShiftState; X, Y: Integer);
  545.   function Min(i1, i2: integer): integer;
  546.   begin
  547.     if i1 > i2 then
  548.       Result := i2
  549.     else
  550.       Result := i1;
  551.   end;
  552.  
  553.   function Max(i1, i2: integer): integer;
  554.   begin
  555.     if i1 < i2 then
  556.       Result := i2
  557.     else
  558.       Result := i1;
  559.   end;
  560. var
  561.   WARect, WBRect,
  562.   ClipRect: TRect;
  563. begin
  564.   inherited MouseDown(Button, Shift, X, Y);
  565.   { If no parent or not left button pressed, no reason to go on }
  566.   if (Parent = NIL) or (Button <> mbLeft) then exit;
  567.  
  568. (*
  569.   { Get the rectangle of our parent }
  570.   ClipRect := Parent.ClientRect;
  571.   { Convert rectangle to screen coords. Simpler than calling ClientToScreen }
  572.   { twice, once for TopLeft and again for BottomRight                       }
  573.   with Parent.ClientOrigin do OffsetRect(ClipRect, X, Y);
  574. *)
  575.  
  576.   if WindowA = NIL then
  577.     GetWindowRect(Parent.Handle, WARect)
  578.   else
  579.     GetWindowRect(WindowA.Handle, WARect);
  580.  
  581.   if WindowB = NIL then
  582.     GetWindowRect(Parent.Handle, WBRect)
  583.   else
  584.     GetWindowRect(WindowB.Handle, WBRect);
  585.  
  586.   { Remove the minimum sizes from the rectangle }
  587.   if FWindowAMinSize > 0 then begin
  588.     if FStyle = gbHorizontal then { horizontal }
  589.       Inc(WARect.Top, FWindowAMinSize)
  590.     else { vertical }
  591.       Inc(WARect.Left, FWindowAMinSize);
  592.   end;  { adjust windowA's size as necessary }
  593.  
  594.   if FWindowBMinSize > 0 then begin
  595.     if FStyle = gbHorizontal then { horizontal }
  596.       Dec(WBRect.Bottom, FWindowBMinSize)
  597.     else { vertical }
  598.       Dec(WBRect.Right, FWindowBMinSize);
  599.   end;   { adjust Top if WindowB was made too small }
  600.  
  601.   with ClipRect do begin
  602.     Left := Min(WARect.Left, WBRect.Left);
  603.     Top := Min(WARect.Top, WBRect.Top);
  604.     Right := Max(WARect.Right, WBRect.Right);
  605.     Bottom := Max(WARect.Bottom, WBRect.Bottom);
  606.   end;
  607.  
  608.   { Subtract our size from the rectangle }
  609.   if FStyle = gbHorizontal then begin
  610.     Inc(ClipRect.Top, Thickness div 2);
  611.     Dec(ClipRect.Bottom, (Thickness div 2) - 1);
  612.   end else begin
  613.     Inc(ClipRect.Left, Thickness div 2);
  614.     Dec(ClipRect.Right, (Thickness div 2) - 1);
  615.   end;
  616.  
  617.   { Clip the mouse cursor to the rectangle.  Prevents from moving out of it }
  618.   ClipCursor(@ClipRect);
  619.   FDragging := TRUE;
  620.   LastRect := BoundsRect;
  621.   if not FDragUpdate then { Draw the indicator bar }
  622.     InvertedRect(LastRect, FALSE);
  623. end;
  624.  
  625. { The mouse has moved.  Move the indicator bar accordingly. }
  626. procedure TGrabBar.MouseMove(Shift: TShiftState; X, Y: Integer);
  627. var
  628.   R: TRect;
  629. begin
  630.   inherited MouseMove(Shift, X, Y);
  631.   if (ssLeft in Shift) and FDragging then begin
  632.     { Convert our client point to our parent's client point }
  633.     R := BarRect(ClientToParent(Point(X,Y)));
  634.     { If the bar is still in the same place as last time, }
  635.     { there's nothing to do                               }
  636.     if EqualRect(R, LastRect) or IsRectEmpty(R) then exit;
  637.     if not FDragUpdate then { Draw the indicator bar }
  638.       InvertedRect(R, TRUE);
  639.     LastRect := R;
  640.  
  641.     if FDragUpdate then { Update the bar's position.  This updates windows, too}
  642.       if FStyle = gbHorizontal then
  643.         Top := LastRect.Top
  644.       else
  645.         Left := LastRect.Left;
  646.   end;
  647. end;
  648.  
  649. { The mouse button has been released, update the position of the }
  650. { bar and it's windows.                                          }
  651. procedure TGrabBar.MouseUp(Button: TMouseButton;
  652.                            Shift: TShiftState; X, Y: Integer);
  653. var
  654.   OldRect,
  655.   Intersect: TRect;
  656. begin
  657.   inherited MouseUp(Button, Shift, X, Y);
  658.   { Don't do anything if it wasn't the left button. }
  659.   if not ((Button = mbLeft) and FDragging) then exit;
  660.  
  661.   { Remove the clipping of the mouse cursor }
  662.   ClipCursor(NIL);
  663.   FDragging := FALSE;
  664.   if not IsRectEmpty(LastRect) then begin
  665.     if not FDragUpdate then { Remove the last indicator bar }
  666.       InvertedRect(LastRect, FALSE);
  667.     OldRect := BoundsRect;
  668.     { Update the bar position.  Because SetBounds is overridden, }
  669.     { the other windows will be moved accordingly.               }
  670.     if FStyle = gbHorizontal then
  671.       Top := LastRect.Top
  672.     else
  673.       Left := LastRect.Left;
  674.     if not FDragUpdate then begin
  675.       { If new rect is in old rect, part of inverted rect gets left over. }
  676.       { Invalidate the control and update so it is repainted immediately. }
  677.       IntersectRect(Intersect, LastRect, OldRect);
  678.       if not IsRectEmpty(Intersect) then
  679.         Refresh;
  680.     end;
  681.   end;
  682.   SetRectEmpty(LastRect);
  683.   { Fire the OnMove event if there is one }
  684.   if assigned(FOnMove) then
  685.     FOnMove(Self);
  686. end;
  687.  
  688. { We have be notified of a change in the on-form components. If it is one }
  689. { that we are responsible for, update variables accordingly.              }
  690. procedure TGrabBar.Notification(AComponent: TComponent; Operation: TOperation);
  691. begin
  692.   if Operation = opRemove then begin
  693.     if AComponent = FWindowA then
  694.       FWindowA := NIL;
  695.     if AComponent = FWindowB then
  696.       FWindowB := NIL;
  697.   end;
  698. end;
  699.  
  700. { Every change to Top, Left, Width and Height come through this procedure.  }
  701. { The statement: Top := 10; will result in the procedure being called.  By  }
  702. { overriding it, we can ensure that the windows our repositioned every time }
  703. { we are moved.                                                             }
  704. procedure TGrabBar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  705. var
  706.   R: TRect;
  707. begin
  708.   inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  709.   if HandleAllocated then begin
  710.     R := Rect(0, 0, Width, Height);
  711.     InvalidateRect(Handle, @R, TRUE);
  712.     Update;
  713.     MoveWindows;
  714.   end;
  715. end;
  716.  
  717. function TGrabBar.GetVersion: TDFSVersion;
  718. begin
  719.   Result := DFS_COMPONENT_VERSION;
  720. end;
  721.  
  722. procedure TGrabBar.SetVersion(const Val: TDFSVersion);
  723. begin
  724.   { empty write method, just needed to get it to show up in Object Inspector }
  725. end;
  726.  
  727. end.
  728.