unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
Type
TForm1 = Class(TForm)
Shape1: TShape;
Pprocedure shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure Shape1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
Private
{ Private declarations }
public
{ Public declarations }
End;
Var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Begin
//kolla om man tryclker ner vänster knapp:
if Button = mbleft then
Begin
//ja det gjorde vi och då kollar vi om det är en shape
with sender as Tshape do
Begin
//ja det var det och vi börjar dragningen.
DoubleBuffered := True;
//använder DoubleBufferd för att
//ta bort flimmer;
Begindrag(true);
End;
End;
End;
procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
Begin
//kolla om den man drar är en shape,om du vill ha en label skriver du Tlabel.
if Source is Tshape then
Begin
Accept := true;
End;
//flytta shape1 till musens X och Y;
shape1.Left := X ;
shape1.Top := Y;
End;
Procedure TForm1.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
Begin
//när man släpper musenknappen
//kolla om source är Tshape
If Source is Tshape then
//ja det var det, då flyttar vi shape1 till musens X och Y;
with shape1 do
Begin
left := x;
top := y;
End;
End;
procedure TForm1.Shape1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
Begin
//fixar så du även kan dra över shape1 utan att den stannar upp
//utan denna procedure kan du inte dra musen över shape1 för då stannar den.
Accept := true;
shape1.Left := shape1.Left + X;
shape1.Top := shape1.Top + Y;
End;
End.