如何在运行时拖动label dbtext等控件？

Question

我想在运行时拖动label dbtext等控件，
但是尝试了两种方法：
下面这个不能拖动label，dbtext控件，其他好像可以。// 光标在控件的客户区 ( 移动整个控件 )******************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>5) and (Y>5) and (X<Control.Width-5) and (Y<Control.Height-5)
then begin
SC_MANIPULATE := $F009;
Control.Cursor := crSizeAll;
end
else begin
SC_MANIPULATE := $F000;
Control.Cursor := crDefault;

Answer 1

下面这个可以拖动，改变label dbtext控件大小，但是可能是重绘后，双击事件不能响应了。请问如何解决，谢谢。
unit Sizer;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;type
TSizer = class(TCustomControl)
private
{ Private declarations }
FControl:TControl;
FRectList:array[1..8] of Trect;
FPosList:Array[1..8] of integer;
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(Aowner:TComponent;AControl:TControl);
procedure CreateParams(Var Params:TCreateParams);override;
Procedure CreateHandle;override;
Procedure WNNCHITTEST(var msg:Twmnchittest);message wm_nchittest;
procedure wmsize(var msg:Twmsize);message wm_size;
procedure WmLbuttonDown(var msg:twmlbuttondown);message wm_lbuttondown;
procedure wmmove(var msg:twmmove);message wm_move;
procedure paint;override;
procedure sizercontrolexit(sender:tobject);
published
{ Published declarations }
end;procedure Register;implementationprocedure Register;
begin
RegisterNoicon([Tsizer]);
end;{ TSizer }constructor TSizer.Create(Aowner: TComponent; AControl: TControl);
var
r:trect;
begin
inherited create(Aowner);
FControl:=Acontrol;
onexit:=sizercontrolexit;
r:=fcontrol.BoundsRect;
inflaterect(r,2,2);
boundsrect:=r;
parent:=fcontrol.Parent;
fposlist[1]:=httopleft;
fposlist[2]:=httop;
fposlist[3]:=httopRight;
fposlist[4]:=htRight;
fposlist[5]:=htBottomRight;
fposlist[6]:=htBottom;
fposlist[7]:=htBottomleft;
fposlist[8]:=htleft;
end;procedure TSizer.CreateHandle;
begin
inherited createhandle;
setfocus;
end;procedure TSizer.CreateParams(var Params: TCreateParams);
begin
inherited createparams(params);
params.ExStyle:=params.ExStyle+ws_ex_transparent
end;procedure TSizer.paint;
var
i:integer;
begin
Canvas.Brush.Color:=clblack;
for i:=1 to 8 do
canvas.Rectangle(Frectlist[i].left,frectlist[i].top,frectlist[i].right,frectlist[i].bottom);
end;procedure TSizer.sizercontrolexit(sender: tobject);
begin
free;
end;procedure TSizer.WmLbuttonDown(var msg: twmlbuttondown);
begin
perform(wm_syscommand,$f012,0);
end;procedure TSizer.wmmove(var msg: twmmove);
var
r:trect;
begin
r:=boundsrect;
inflaterect(r,-2,-2);
fcontrol.BoundsRect:=r;
fcontrol.Invalidate;
end;procedure TSizer.wmsize(var msg: Twmsize);
var
r:trect;
begin
r:=boundsrect;
inflaterect(r,-2,-2);
fcontrol.BoundsRect:=r;
frectlist[1]:=rect(0,0,5,5);
frectlist[2]:=rect(width div 2-3,0,width div 2+2,5);
frectlist[3]:=rect(width-5,0,width,5);
frectlist[4]:=rect(width-5,height div 2-3,width,height div 2+2);
frectlist[5]:=rect(width -5,height-5,width,height);
frectlist[6]:=rect(width div 2-3,height-5,width div 2+2,height);
frectlist[7]:=rect(0,height-5,5,height);
frectlist[8]:=rect(0,height div 2-3,5,height div 2+2);
end;procedure TSizer.WNNCHITTEST(var msg: Twmnchittest);
var
pt:tpoint;
i:integer;
begin
pt:=point(msg.XPos,msg.YPos);
pt:=screentoclient(pt);
msg.Result:=0;
for i:=1 to 8 do
if ptinrect(frectlist[i],pt) then
msg.Result:=fposlist[i];
if msg.Result=0 then
inherited;
end;end.在onmousemove里调用
tsizer.create(self,tcontrol(sender));

Answer 2

http://www.codechina.net/resource/html/2006-02/23/141782.html

Answer 3

您好，你给的这个例子，能移动很多控件，但是label还是不行的，他上面显示的label实际还是通过panel的。
有没有什么其他方法啊？

Answer 4

双击实际上是双击到TSizer上了，你就在TSizer在加个WM_LBUTTONDBLCLK消息的处理方法，在其中把改消息发给FControl就可以了，参考代码：
procedure TSizer.WMLButtonDblClk(var Message: TMessage);
begin
  FControl.Perform(Message.Msg, Message.WParam, Message.LParam);
end;