Resize a TControl object graphically

Problem/Question/Abstract:

Move or resize graphically a TControl object by using another objet that has all the necessary code.

Answer:

The unit showed bellow is for the TControlHandler class.

TControlHandler can manipulate graphically any descendant of the TControl class. A TControl objet can be selected by the TControlHandler Control property : a border appears surrounding the control passed to this method as  reference. At run-time, you can then change its location or change its size with the mouse.
For example, in an application, create a TControlHandler at startup :

FControlHandler := TControlHandler.Create(Self);

To manipulate a Button1 objet placed on the form, write the following instruction :

FControlHandler.Control := Button1;

You can choose another control by assigning a new TControl's reference ; the previous one is deselected.


unit ControlHandler;

// Written by Bertrand Goetzmann (http://www.object-everywhere.com)

interface

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

type
  TControlPoint = (pcTopLeft, pcTopRight, pcBottomLeft, pcBottomRight, pcOther);

  TControlHandler = class(TCustomControl)
  private
    Rgn: HRGN;
    R, R1: TRect;
    Pos: TPoint;
    Pt: TControlPoint;
    bDrag: Boolean;
  protected
    FControl: TControl;
    procedure SetRegion;
    function GetControlPoint(const Point: TPoint): TControlPoint;
    procedure Paint; override;
    procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer);
    procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y:
      Integer);
    procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetControl(Control: TControl);
  published
    property Control: TControl read FControl write SetControl;
  end;

implementation

const
  LARGEUR = 5;

  // M�thodes de TControlHandler

constructor TControlHandler.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Parent := AOwner as TWinControl;

  Rgn := 0;
  bDrag := False;

  OnMouseDown := MouseDown;
  OnMouseMove := MouseMove;
  OnMouseUp := MouseUp;
end;

destructor TControlHandler.Destroy;
begin
  if Rgn <> 0 then
    DeleteObject(Rgn);
  inherited Destroy;
end;

function TControlHandler.GetControlPoint(const Point: TPoint): TControlPoint;
begin
  Result := pcOther;
  if PtInRect(Rect(0, 0, LARGEUR, LARGEUR), Point) then
    Result := pcTopLeft
  else if PtInRect(Rect(Width - LARGEUR, 0, Width, LARGEUR), Point) then
    Result := pcTopRight
  else if PtInRect(Rect(0, Height - LARGEUR, LARGEUR, Height), Point) then
    Result := pcBottomLeft
  else if PtInRect(Rect(Width - LARGEUR, Height - LARGEUR, Width, Height), Point) then
    Result := pcBottomRight;
end;

procedure TControlHandler.MouseDown(Sender: TObject; Button: TMouseButton; Shift:
  TShiftState; X, Y: Integer);
begin
  Pos.x := X;
  Pos.y := Y;
  bDrag := True;

  R := Rect(FControl.Left, FControl.Top, FControl.Left + FControl.Width, FControl.Top
    + FControl.Height);
  R1 := Rect(FControl.Left, FControl.Top, FControl.Left + FControl.Width, FControl.Top
    + FControl.Height);

  Pt := GetControlPoint(Pos);

  Visible := False;
end;

procedure TControlHandler.MouseUp(Sender: TObject; Button: TMouseButton; Shift:
  TShiftState; X, Y: Integer);
begin
  Screen.Cursor := crDefault;
  bDrag := False;

  Control.Left := R.Left;
  Control.Top := R.Top;
  Control.Width := R.Right - R.Left;
  Control.Height := R.Bottom - R.Top;

  SetRegion;

  Visible := True;
end;

procedure TControlHandler.MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
  Integer);
begin
  case GetControlPoint(Point(X, Y)) of
    pcTopLeft:
      Cursor := crSizeNWSE;
    pcTopRight:
      Cursor := crSizeNESW;
    pcBottomLeft:
      Cursor := crSizeNESW;
    pcBottomRight:
      Cursor := crSizeNWSE;
    pcOther:
      Cursor := crDrag;
  end;

  if not bDrag then
    Exit;

  case Pt of
    pcTopLeft:
      begin
        R.Left := R1.Left + X - Pos.x;
        R.Top := R1.Top + Y - Pos.y;
      end;
    pcTopRight:
      begin
        R.Right := R1.Right + X - Pos.x;
        R.Top := R1.Top + Y - Pos.y;
      end;
    pcBottomLeft:
      begin
        R.Left := R1.Left + X - Pos.x;
        R.Bottom := R1.Bottom + Y - Pos.y;
      end;
    pcBottomRight:
      begin
        R.Right := R1.Right + X - Pos.x;
        R.Bottom := R1.Bottom + Y - Pos.y;
      end;
    pcOther:
      begin
        R.Left := R1.Left + X - Pos.x;
        R.Top := R1.Top + Y - Pos.y;
        R.Right := R1.Right + X - Pos.x;
        R.Bottom := R1.Bottom + Y - Pos.y;
      end;
  end;

  with FControl do
  begin
    Left := R.Left;
    Top := R.Top;
    Width := R.Right - R.Left;
    Height := R.Bottom - R.Top;
  end;
end;

procedure TControlHandler.SetRegion;
var
  Rgn1, Rgn2: HRGN;
begin
  if Rgn <> 0 then
    DeleteObject(Rgn);
  Visible := False;

  Left := Control.Left - LARGEUR;
  Top := Control.Top - LARGEUR;
  Width := Control.Width + 2 * LARGEUR;
  Height := Control.Height + 2 * LARGEUR;

  Rgn := CreateRectRgn(0, 0, Width, Height);
  Rgn1 := CreateRectRgn(0, 0, Width, Height);
  Rgn2 := CreateRectRgn(LARGEUR, LARGEUR, Control.Width + LARGEUR, Control.Height +
    LARGEUR);
  CombineRgn(Rgn, Rgn1, Rgn2, RGN_DIFF);
  DeleteObject(Rgn1);
  DeleteObject(Rgn2);
  SetWindowRgn(Handle, Rgn, True);

  Visible := True;
end;

procedure TControlHandler.SetControl(Control: TControl);
begin
  FControl := Control;
  SetRegion;
end;

procedure TControlHandler.Paint;
begin
  with Canvas do
  begin
    Brush.Color := clBlack;
    Brush.Style := bsBDiagonal;
    Rectangle(0, 0, Width, Height);

    // Dessiner les poignets
    Brush.Style := bsSolid;
    FillRect(Rect(0, 0, LARGEUR, LARGEUR));
    FillRect(Rect(Width - LARGEUR, 0, Width, LARGEUR));
    FillRect(Rect(0, Height - LARGEUR, LARGEUR, Height));
    FillRect(Rect(Width - LARGEUR, Height - LARGEUR, Width, Height));
  end;
end;

end.


Component Download: http://perso.worldonline.fr/objecteverywhere/control.zip