Moveable/Sizable TPanel with standard or color SizeGrip

Problem/Question/Abstract:

How can I move/resize a TPanel at runtime. Also can I place a sizegrip on the panel and make it a different color then Grey?

Answer:

Many times an application may need to move or resize items on a form. The custom panel presented here provides the ability to move the panel by holding down the left mouse button and dragging the panel to a new location. The size can be adjusted by holding the left mouse button down in the lower right hand corner of the panel as done when resizing a form. There is a property to show/hide the SizeGrip and even change the style of the SizeGrip so that the color can be changed in the event the panel needs to be different then battleship grey. There is two unusual properties FreezeTopAt and FreezeTop which allow you to restrict how far the top can be moved on the parent form.  It has been tested with D5 but not D6, see comments inside concerning D6.

unit SizeGripPanel;

{
  Description:
  This component, a decendent of TPanel provides methods to size and move
  the panel by using the mouse. The only restriction for sizing the panel
  is that is must be done using the SizeGrip located at the bottom right
  part of the panel.

  There are two additional events, OnMove and OnSize. Yes you guessed
  correct, the are hooked into when a user moves or resizes the panel.

  ColoredGrip when True allows the grip to be colored unlike the default
  style grip.

  Author:
  Kevin S. Gallagher
  gallaghe@teleport.com

  Version
  1.0.2

  Copyrights:
  This is a freeware component. Use at your own risk. You may not sell
  or distruibute the component for profit.

  Notes:
  Originally created in D4, ported to D5.

  I am not sure what all needs to change for D6 since I don't have it yet.
  It will work as reported from one programmer by hacking some code i.e.
  Changing the USES clause and removing the "About" code. There should be
  away to make the "About" code work, will fix it once I get D6.

  Limitations:
  The Grip as is can not assume the color of the panel, for a quick
  solution I added the property . For myself it doesn't matter
  since I am always using drab grey. If anyone wants to change this, feel
  free, just email me the changes.

  IF YOU GET THIS TO WORK UNDER D6 SEND ME THE CHANGES PLEASE SO I CAN POST
  THE CHANGES.

  Revisions
  KSG 02.08.01
  Added the property "FreezeTop" which when set will not allow vertical
  movement of the panel. "FreezeTopAt" control the topmost point the
  panel can move too.

  KSG 09.10.01
  Found flaw in code to set Grip visible, fixed.
  Attempted to make work under D6 w/o D6 available.

}

interface

{$IFDEF VER140}
uses
  Windows, Messages, Classes, ExtCtrls, Controls, ToolsAPI, DesignIntf,
  DesignEditors;
{$ELSE}
uses
  Windows, Messages, Classes, ExtCtrls, Controls, DsgnIntf, Commctrl;
{$ENDIF}

type
  TAbout = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
  end;

  TSizeGripPanel = class(TPanel)
  private
    FAbout: TAbout;
    FUseGrip: Boolean;
    FMoving: Boolean;
    FSizing: Boolean;
    FColorGrip: Boolean;
    FOnMove: TNotifyEvent;
    FOnSize: TNotifyEvent;
    FTop: Integer; { to prevent vertical movement KSG 02.08.01 }
    FFreeze: Boolean;
    function GetGripRect: TRect;
    procedure WMExitSizeMove(var Msg: TMessage); message WM_EXITSIZEMOVE;
    procedure SetGripColorStyle(Value: Boolean);
    procedure SetGripVisability(Value: Boolean); { KSG 09.10.2001 }
  protected
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      override;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property About: TAbout read FAbout write FAbout;
    property FreezeTopAt: Integer read FTop write FTop;
    property FreezeTop: boolean read FFreeze write FFreeze;
    property ShowGrip: Boolean read FUseGrip write SetGripVisability;
    property ColoredGrip: Boolean read FColorGrip write SetGripColorStyle;
    property OnMove: TNotifyEvent read FOnMove write FOnMove;
    property OnSize: TNotifyEvent read FOnSize write FOnSize;
  end;

procedure Register;

implementation

uses Dialogs, SysUtils, Graphics;

procedure TAbout.Edit;
begin
  MessageDlg('SizeMovePanel component v1.0.2'#13'by Kevin S. Gallagher',
    mtInformation, [mbOK], 0);
end;

function TAbout.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paDialog, paReadOnly];
end;

function TAbout.GetValue: string;
begin
  Result := '(about)';
end;

constructor TSizeGripPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { Don't care for a caption at all }
  ControlStyle := ControlStyle - [csSetCaption];
  ShowGrip := True;
  FreezeTop := False;
  FColorGrip := False;
end;

procedure TSizeGripPanel.WMExitSizeMove(var Msg: TMessage);
begin
  inherited;

  if FreezeTop then
    Top := FTop;

  Msg.Result := 0;
end;

procedure TSizeGripPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
const
  SC_DRAGMOVE: Longint = $F012;
begin
  { Might also want to check for Client alignment too. }
  if (Align = alNone) then
  begin
    FMoving := True;
    ReleaseCapture;
    SendMessage(Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);
  end
  else
    inherited MouseDown(Button, Shift, X, Y);
end;

procedure TSizeGripPanel.WMMove(var Message: TWMMove);
begin
  inherited;
  if FMoving then
  begin
    FMoving := False;
    Parent.Realign;
    if Assigned(FOnMove) then
      FOnMove(Self);
  end;
end;

procedure TSizeGripPanel.WMSize(var Message: TWMSize);
begin
  inherited;
  if FSizing then
  begin
    FSizing := False;
    Parent.Realign;
    if Assigned(FOnSize) then
      FOnSize(Self);
  end;
end;

function TSizeGripPanel.GetGripRect: TRect;
var
  GripWidth: integer;
  GripHeight: integer;
begin
  GripWidth := GetSystemMetrics(SM_CXHSCROLL);
  GripHeight := GetSystemMetrics(SM_CYVSCROLL);
  Result := GetClientRect();
  Result.Left := Result.Right - GripWidth;
  Result.Top := Result.Bottom - GripHeight;
end;

procedure TSizeGripPanel.WMNCHitTest(var Msg: TWMNCHitTest);
var
  ScreenPt: TPoint;
begin
  inherited;
  if not (csDesigning in ComponentState) and (Msg.Result = HTCLIENT) then
  begin
    ScreenPt := ScreenToClient(Point(Msg.Xpos, Msg.Ypos));
    if (ScreenPt.x >= GetGripRect.Left) and (ScreenPt.y >= GetGripRect.Top) then
      Msg.Result := HTBOTTOMRIGHT;

    { Used to trigger OnSize }
    with Msg do
      if Result in [Windows.HTLEFT..Windows.HTBOTTOMRIGHT] then
        FSizing := True;
  end;
end;

procedure TSizeGripPanel.Paint;
var
  Rect: TRect;
begin
  inherited Paint;

  if not FUseGrip then
    exit;

  Rect := GetGripRect;

  if not FColorGrip then
    DrawFrameControl(Canvas.Handle, Rect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP)
  else
    with Self.Canvas do
    begin
      Brush.Style := bsClear;
      Font.Name := 'Marlett';
      Font.Size := 8;

      Font.Color := clGray;
      TextOut(rect.left, rect.top, 'o');

      Font.Color := clWhite;
      TextOut(rect.left, rect.top, 'p');
    end;
end;

procedure TSizeGripPanel.SetGripColorStyle(Value: Boolean);
begin
  if Value <> FColorGrip then
  begin
    FColorGrip := Value;
    Repaint;
  end;
end;

procedure TSizeGripPanel.SetGripVisability(Value: Boolean);
begin
  if Value <> FUseGrip then
  begin
    FUsegrip := Value;
    Repaint;
  end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TSizeGripPanel]);
  RegisterPropertyEditor(TypeInfo(TAbout), TSizeGripPanel, 'ABOUT', TAbout);
end;
end.