How to make a dynamically created TLabel draggable

Mirror

How to make a dynamically created TLabel draggable (Views: 439)

Problem/Question/Abstract:

How to make a dynamically created TLabel draggable

Answer:

Create a new project with an empty form, add StdCtls to the Uses clause (for the TLabel class, you can also add a single label at design time). Add a handler to the forms OnClick method, then modify the unit as below. Compile and run, click on the form to create a label, drag on a label to move it.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormClick(Sender: TObject);
  private
    { Private declarations }
    downX, downY: Integer;
    dragging: Boolean;
    procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ControlMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TCracker = class(TControl);
  { Needed since TControl.MouseCapture is protected }

procedure TForm1.FormClick(Sender: TObject);
var
  pt: TPoint;
begin
  {get cursor position, convert to client coordinates}
  GetCursorPos(pt);
  pt := ScreenToClient(pt);
  {create label with top left corner at mouse position}
  with TLabel.Create(Self) do
  begin
    SetBounds(pt.x, pt.y, width, height);
    Caption := Format('Hit at %d, %d', [pt.x, pt.y]);
    Color := clBlue;
    Font.Color := clWhite;
    Autosize := true;
    Parent := Self;
    {attach the drag handlers}
    OnMouseDown := ControlMouseDown;
    OnMouseUp := ControlMouseUp;
    OnMouseMove := ControlMouseMove;
  end;
end;

procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  downX := X;
  downY := Y;
  dragging := TRue;
  with TCracker(Sender) do
  begin
    MouseCapture := True;
    Color := clRed;
  end;
end;

procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if dragging then
    with Sender as TControl do
    begin
      Left := X - downX + Left;
      Top := Y - downY + Top;
    end;
end;

procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if dragging then
  begin
    dragging := False;
    with TCracker(Sender) do
    begin
      MouseCapture := False;
      Color := clBlue;
    end;
  end;
end;

end.

<< Back to main page