Таскать фигуру мышкой

[Poseydon]

Подскажите, пожалуйста, как реализовать фигуру Shape1, которую во время работы программы можно будет таскать мышкой? Была мысль проверять координаты мыши и нажатие левой кнопки, но в процедуре:

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   begin
   Shape1.Left:=X;
   Shape1.Top:=Y;
end;

фугура сдвигается при нажатии, но не тащится.

[Crivel]

А вы попробуйте вот это -

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Shape1.Left:=X;
Shape1.Top:=Y;
end;

[Poseydon]

Спасибо, фигура сдвигается при нажатии мыши. Но тащить нажатой мышью фигуру не получается.

[Poseydon]

Извиняюсь, что спрашивал, решение нашёл сам:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Shape1: TShape;
    Timer1: TTimer;
    Shape2: TShape;
    Shape3: TShape;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  mpr:boolean;
  mx,my:integer;
  r: TRect;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
Var m,i:integer;
begin
mx:=Mouse.CursorPos.X-Form1.Left;
my:=Mouse.CursorPos.Y-Form1.Top;
m:=5;
with Canvas do begin
Pen.Color:=0;
MoveTo(56,8);
LineTo(56,496);
MoveTo(8,448);
LineTo(976,448);
MoveTo(48,16);
LineTo(56,8);
LineTo(64,16);
MoveTo(968,440);
LineTo(976,448);
LineTo(968,456);
For i:=1 to 10 do begin
TextOut(20,440-40*i,IntToStr(m*i));
MoveTo(48,448-40*i);
LineTo(64,448-40*i);
                  end;
For i:=1 to 22 do begin
TextOut(48+40*i,474,IntToStr(m*i));
MoveTo(56+40*i,440);
LineTo(56+40*i,456);
                  end;
                    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
mpr:=FALSE;
SetWindowLong(Handle, GWL_STYLE,
    GETWINDOWLONG(Handle, GWL_STYLE) and (not WS_CAPTION));
  Height := ClientHeight;
Timer1.Interval:=1;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
halt;
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var   r1: TRect;
begin
  GetClipCursor(r);
  r1 := Form1.ClientRect;
  r1.Left:=56+Form1.Left;
  r1.Top:=8+Form1.Top;;
  r1.Bottom:=448+Form1.Top;
  r1.Right:=976+Form1.Left;
  If (mx>=56) and (mx<=976) and (my>=8) and (my<=448) then begin
  ClipCursor(@r1);
  mpr:=TRUE;
Shape1.Left:=mx-5;
Shape1.Top:=my-5;
Shape2.Top:=my;
Shape2.Width:=mx-Shape2.Left;
Shape3.Left:=mx;
Shape3.Top:=my;
Shape3.Height:=490-Shape3.Top;
end;
end;

procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mpr:=FALSE;
  ClipCursor(@r);
end;

procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
If mpr then begin
  mpr:=TRUE;
Shape1.Left:=mx-5;
Shape1.Top:=my-5;
Shape2.Top:=my;
Shape2.Width:=mx-Shape2.Left;
Shape3.Left:=mx;
Shape3.Top:=my;
Shape3.Height:=490-Shape3.Top;
end;
end;

end.

Заодно нарисовал систему координат и запретил перемещать кружок за её пределы

[Stilet]

Poseydon

НЕдавно выкладывал код как двигать мышой обьект.
Плюс к тому уже обсуждалось - рули поиском.