home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / GrabBar.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-28  |  28KB  |  780 lines

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