The Unofficial Newsletter of Delphi Users - by Robert Vivrette


Extending the Sizeable/Moveable Component Technique

by Clinton R. Johnson - xepol@poboxes.com

Last week, there was an interesting offer from Matt Hamilton on how to make virtually any component moveable or resizable. Since then I have received quite a bit of excellent suggestions on how to extend these capabilities. Clinton Johnson offers this use of the technique in his Sizeable/Moveable Panel demo.

In a nutshell, he did the following... First, he added AllowMove and AllowResize properties to control whether the panel could be moved or sized. In the event that a move area needed to be established, he added a CaptionHeight property. This property controls the size of the region where you can click and drag to move the component. Next, he included a set property called ResizeDirection, allowing the user to control which edges of the control could be resized. He then added events that could be overridden for OnCanMove or OnCanResize. Finally, he implemented resizing restrictions using the WM_GETMINMAXINFO message. This allows the user to specify the maximum or minimum size that the panel can be.

The code is well commented, and will illustrate well the steps you can take to add resizing or moving control to your own components.

All-in-all a very complete solution. Well done Clinton!
 
unit SMPanel;

interface

//*****************************************************************************
// Sizable/Movable Panel Demo prepared for UNDO
//
// Written by Clinton R. Johnson - xepol@poboxes.com
//
// Based on an article by M. Hamilton - MHamilton@bunge.com.au (and a little extra
// by Robert Vivrette)
//
// Fully extends the concept of resizing, and provides the fundamentals required to
// include this code in any component.  Minimum and maximum window sizes are enforced.
// Moving the mouse over the regions which cause resizing also cause the cursor to
// change to the appropriate cursor shape.
//
// This code is released into the public domain.
//*****************************************************************************

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

Type
  TResizeDirection = (rdNone,rdTop,rdBottom,rdLeft,rdRight,rdTopLeft,rdTopRight,rdBottomLeft,rdBottomRight);
  TResizeDirectionSet = Set Of TResizeDirection;

Type
  TNotifyMoveEvent = Procedure (Sender : TObject; X: Integer; Y : Integer; Var CanMove : Boolean) Of Object;
  TNotifyResizeEvent = Procedure (Sender : TObject; ResizeDirection : TResizeDirection; Var CanResize : Boolean) Of Object;

type
  TSMPanel = class(TPanel)
  private
    { Private declarations }
    fAllowMove          : Boolean;
    fAllowResize        : Boolean;
    fCaptionHeight      : Integer;
    fMaxHeight          : Integer;
    fMaxWidth           : Integer;
    fMinHeight          : Integer;
    fMinWidth           : Integer;
    fOnCanMove          : TNotifyMoveEvent;
    fOnCanResize        : TNotifyResizeEvent;
    fResizeDirection    : TResizeDirectionSet;

    Procedure WMGetMinMaxInfo(Var Msg : TWMGetMinMaxInfo); Message WM_GetMinMaxInfo;
    Procedure WMNCHitTest(var Msg : TWMNCHitTest); Message WM_NCHITTEST;
    Procedure WMMouseMove(Var Msg : TWMMouseMove); Message WM_MouseMove;
    Procedure TestHit(XPos : INteger; YPos : INteger; Var Result : INteger);
  protected
    { Protected declarations }
    Procedure DoCanMove(X : Integer; Y : Integer; Var CanMove : Boolean); Virtual;
    Procedure DoCanResize(ResizeDirection : TResizeDirection; Var CanResize : Boolean); Virtual;
  public
    { Public declarations }
    Constructor Create(AnOwner : TComponent); OverRide;
  published
    { Published declarations }
    Property AllowMove       : Boolean             Read fAllowMove       Write fAllowMove;
    Property AllowResize     : Boolean             Read fAllowResize     Write fAllowResize;
    Property CaptionHeight   : Integer             Read fCaptionHeight   Write fCaptionHeight;
    Property MaxHeight       : Integer             Read fMaxHeight       Write fMaxHeight;
    property MaxWidth        : Integer             Read fMaxWidth        Write fMaxWidth;
    Property MinHeight       : Integer             Read fMinHeight       Write fMinHeight;
    property MinWidth        : Integer             Read fMinWidth        Write fMinWidth;
    Property ResizeDirection : TResizeDirectionSet Read fResizeDirection Write fResizeDirection;

    Property OnCanMove : TNotifyMoveEvent          Read fOnCanMove       Write fOnCanMove;
    Property OnCanResize : TNotifyResizeEvent      Read fOnCanResize     Write fOnCanResize;
  end;

procedure Register;

implementation

Constructor TSMPanel.Create(AnOwner : TComponent);
Begin
  Inherited Create(AnOwner);
  fAllowMove := True;
  fAllowResize := True;
  fCaptionHeight := 0;
  fMaxHeight := 0;
  fMaxWidth := 0;
  fMinHeight := 1;
  fMinWidth := 1;
  fResizeDirection := [rdTop,rdBottom,rdLeft,rdRight,rdTopLeft,rdTopRight,rdBottomLeft,rdBottomRight];
End;

Procedure TSMPanel.DoCanMove(X : Integer; Y : Integer; Var CanMove : Boolean);
Begin
  If Assigned(FOnCanMove) Then fOnCanMove(Self,X,Y,CanMove);
End;

Procedure TSMPanel.DoCanResize(ResizeDirection : TResizeDirection; Var CanResize : Boolean);
Begin
  If Assigned(fOnCanResize) Then fOnCanResize(Self,ResizeDirection,CanResize);
End;

Procedure TSMPanel.WMGetMinMaxInfo(Var Msg : TWMGetMinMaxInfo);
Var
  P                     : TPoint;
Begin
  Inherited;
  Msg.MinMaxInfo^.ptMinTrackSize := Point(MinWidth,MinHeight);
  P := Msg.MinMaxInfo^.ptMaxTrackSize;
  If (MaxWidth<>0) Then P.X := MaxWidth;
  If (MaxHeight<>0) Then P.Y := MaxHeight;
  Msg.MinMaxInfo^.ptMaxTrackSize := P;
End;

Procedure TSMPanel.TestHit(XPos : INteger; YPos : INteger; Var Result : INteger);
Var
  BottomB               : Boolean;
  CanMove               : Boolean;
  CanResize             : Boolean;
  LeftB                 : Boolean;
  RightB                : Boolean;
  TopB                  : Boolean;
  BWidth                : Integer;
  Pt                    : TPoint;
  Client                : TRect;
  Direction             : TResizeDirection;
Begin
//*****************************************************************************
// We don't want to interfere with the IDE, no design time.
//*****************************************************************************
  If Not (csDesigning In ComponentState) Then
  Begin
//*****************************************************************************
// X&Y come in as screen co-ordinates.  Switch to Client for easier
// manipulation.
//*****************************************************************************
    Pt := ScreenToClient(Point(XPos,YPos));
//*****************************************************************************
// We'll consider the bevel & border areas the area for resizing here.
//*****************************************************************************
    BWidth := BorderWidth;
    If (BevelInner<>bvNone) Then BWidth := BWidth+BevelWidth;
    If (BevelOuter<>bvNone) Then BWidth := BWidth+BevelWidth;
//*****************************************************************************
// Set the client area so we can test later for dragging.
//*****************************************************************************
    Client := Rect(0,0,Width,Height);
    If AllowResize Then
    Begin
//*****************************************************************************
// See where the mouse is in the resizing areas.
//*****************************************************************************
      TopB := (Pt.Y<BWidth);
      LeftB := (Pt.X<BWidth);
      RightB := (Pt.X>=(Width-BWidth));
      BottomB := (Pt.Y>=(Height-BWidth));
//*****************************************************************************
// Adjust the client area for dragging to NOT include any valid direction
// for resizing.
//*****************************************************************************
      If ((fResizeDirection * [rdTop,rdTopLeft,rdTopRight])<>[]) Then
      Begin
        Client.Top := Client.Top+BWidth;
      End;
      If ((fResizeDirection * [rdBottom,rdBottomLeft,rdBottomRight])<>[]) Then
      Begin
        Client.Bottom := Client.Bottom-BWidth;
      End;
      If ((fResizeDirection * [rdLeft,rdTopLeft,rdBottomLeft])<>[]) Then
      Begin
        Client.Left:= Client.Left+BWidth;
      End;
      If ((fResizeDirection * [rdRight,rdTopRight,rdBottomRight])<>[]) Then
      Begin
        Client.Right := Client.Right-BWidth;
      End;
//*****************************************************************************
// Determine exactly what direction we need to resize in.
// Bottom & right are given preference here.  This is so that if the client
// area is shrunk to its smallest, the object will always grow down and to the
// right.
//
// rdNone is primarily as semaphore for choosing a direction here, but if
// it is included, then all resizing is turned off, regardless of how all the
// rest of the flags are set.
//
//*****************************************************************************
      Direction := rdNone;
      If Not (rdNone IN fResizeDirection) Then
      Begin
        If (rdTop In fResizeDirection) And TopB Then Direction := rdTop;
        If (rdLeft In fResizeDirection) And LeftB Then Direction := rdLeft;
        If (rdBottom In fResizeDirection) And BottomB Then Direction := rdBottom;
        If (rdRight In fResizeDirection) And RightB Then Direction := rdRight;
        If (rdTopLeft In fResizeDirection) And (TopB And LeftB) Then Direction := rdTopLeft;
        If (rdTopRight In fResizeDirection) And (TopB And RightB) Then Direction := rdTopRight;
        If (rdBottomLeft In fResizeDirection) And (BottomB And LeftB) Then Direction := rdBottomLeft;
        If (rdBottomRight In fResizeDirection) And (BottomB And RightB) Then Direction := rdBottomRight;
      End;
//*****************************************************************************
// If the resize direction is not blank, then ask the code using this
// component to validate the resize - this allows the component's
// resizing to be controlled in a more flexible manner.
//*****************************************************************************
      CanResize := (Direction<>rdNone);
      If CanResize Then DoCanResize(Direction,CanResize);
//*****************************************************************************
// Test the resizing.  Only allow resizing in allowed directions.
// Bottom & right are given preference here again.
//*****************************************************************************
      If CanResize Then
      Begin
        If (rdTop=Direction)         Then Result := HTTOP;
        If (rdLeft=Direction)        Then Result := HTLEFT;
        If (rdBottom=Direction)      Then Result := HTBOTTOM;
        If (rdRight=Direction)       Then Result := HTRight;
        If (rdTopLeft=Direction)     Then Result := HTTOPLEFT;
        If (rdTopRight=Direction)    Then Result := HTTOPRight;
        If (rdBottomLeft=Direction)  Then Result := HTBOTTOMLEFT;
        If (rdBottomRight=Direction) Then Result := HTBOTTOMRIGHT;
      End;
    End;
//*****************************************************************************
// If the CaptionHeight is non-zero, the user only wants part of the height
// of the control to be used as a drag area.
//*****************************************************************************
    If (CaptionHeight<>0) Then
    Begin
      Client.Bottom := Client.Top+CaptionHeight;
    End;
//*****************************************************************************
// Test if Moving is permitted, and the point is in the client area for moving.
//*****************************************************************************
    CanMove := AllowMove And PtInRect(Client,Pt);
//*****************************************************************************
// Always leave the Final decision to move to the code using the component.
// It can change a false to a true, and vice versa.  This allows people
// to refind the caption area to a greater detail.
//*****************************************************************************
    DoCanMove(Pt.X,Pt.Y,CanMove);
    If CanMove Then Result := HTCAPTION;
  End;
End;

procedure TSMPanel.WMNCHitTest(var Msg: TWMNCHitTest);
Begin
  Inherited;
  TestHit(Msg.XPos,Msg.YPos,Msg.Result);
End;

procedure TSMPanel.WMMouseMove(var Msg : TWMMouseMove);
Begin
  Inherited;
  TestHit(Msg.XPos,Msg.YPos,Msg.Result);
End;

procedure Register;
begin
  RegisterComponents('Samples', [TSMPanel]);
end;

end.