how to drag a label at runtime?

[chihong liu]

I want to create a label on form at runtime,
then drag the label and change its position.
How can I do it ?

[Peter Below (TeamB)]

>
> I want to create a label on form at runtime,
> then drag the label and change its position.
> How can I do it ?
>

Here is an example. 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.

Peter Below (TeamB) 10011...@compuserve.com)
No e-mail responses, please, unless explicitely requested!