Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to make a dynamically created TLabel draggable Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
26-Aug-02
Category
VCL-General
Language
Delphi All Versions
Views
94
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas

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.

1   unit Unit1;
2   
3   interface
4   
5   uses
6     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
7   StdCtrls;
8   
9   type
10    TForm1 = class(TForm)
11      procedure FormClick(Sender: TObject);
12    private
13      { Private declarations }
14      downX, downY: Integer;
15      dragging: Boolean;
16      procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
17        Shift: TShiftState; X, Y: Integer);
18      procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
19      procedure ControlMouseUp(Sender: TObject; Button: TMouseButton;
20        Shift: TShiftState; X, Y: Integer);
21    public
22      { Public declarations }
23    end;
24  
25  var
26    Form1: TForm1;
27  
28  implementation
29  
30  {$R *.DFM}
31  
32  type
33    TCracker = class(TControl);
34    { Needed since TControl.MouseCapture is protected }
35  
36  procedure TForm1.FormClick(Sender: TObject);
37  var
38    pt: TPoint;
39  begin
40    {get cursor position, convert to client coordinates}
41    GetCursorPos(pt);
42    pt := ScreenToClient(pt);
43    {create label with top left corner at mouse position}
44    with TLabel.Create(Self) do
45    begin
46      SetBounds(pt.x, pt.y, width, height);
47      Caption := Format('Hit at %d, %d', [pt.x, pt.y]);
48      Color := clBlue;
49      Font.Color := clWhite;
50      Autosize := true;
51      Parent := Self;
52      {attach the drag handlers}
53      OnMouseDown := ControlMouseDown;
54      OnMouseUp := ControlMouseUp;
55      OnMouseMove := ControlMouseMove;
56    end;
57  end;
58  
59  procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
60    Shift: TShiftState; X, Y: Integer);
61  begin
62    downX := X;
63    downY := Y;
64    dragging := TRue;
65    with TCracker(Sender) do
66    begin
67      MouseCapture := True;
68      Color := clRed;
69    end;
70  end;
71  
72  procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: 
73  Integer);
74  begin
75    if dragging then
76      with Sender as TControl do
77      begin
78        Left := X - downX + Left;
79        Top := Y - downY + Top;
80      end;
81  end;
82  
83  procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton;
84    Shift: TShiftState; X, Y: Integer);
85  begin
86    if dragging then
87    begin
88      dragging := False;
89      with TCracker(Sender) do
90      begin
91        MouseCapture := False;
92        Color := clBlue;
93      end;
94    end;
95  end;
96  
97  end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC