请问:
如何在运行期间拖动 label 、edit 以及 memo?谢谢!!!
如何在运行期间拖动 label 、edit 以及 memo?谢谢!!!
解决方案 »
- 为何出错
- 想用D7写一个程序,客户端如何自动找寻到LAN里面的SQL SERVER ?
- 大家帮忙看看这个奇怪的问题,急!!!!!!!!!!
- FastReport的高手请进(关于证件打印数据位置的调整)*特急*
- 如何清空一个非空数组?
- 如何动态在form中创建label,并且显示?
- 请教几个问题.
- 请问各位大侠,这个问题如何解决? access 不支持连接表达式(sql连接表达式的问题)?(access数据库)
- 急急急!!!我想做一个对指定的网页填写数据的程序,请问如何编写?如何实现?用什么原理?(高分相赠!!)
- 求教关于调用outlook express群发邮件的问题
- 如何将Ehlib的Dbgrid页脚footer的第一列设置成显示"合计"字符,第二列设置成显示"记录数",第三列设置成显示字段合计值
- 想了很久都没有做出的问题(救急)
然后改变LABEL,EDIT MEMO 的位置
用控件的onmousedown获取鼠标位置和控件位置
onmousemove获得鼠标的相对移动距离
onmouseup修改控件的位置
procedure TFrmMain.APMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
tmpAP:TAP;//自定义的一个类,可以是TLabel\TEdit等等
begin
if (ssLeft in Shift) then//如果是点下鼠标移动
begin
{决定新位置}
tmpAP:=(Sender as TAP);
tmpAP.Left:=tmpAP.Left + X - StartX;
tmpAP.Top:=tmpAP.Top + Y - StartY;
tempX:=tmpAP.CenterX;
tempY:=tmpAP.CenterY;
end ;
end;
当按下鼠标时向控件发送WM_SysCommand消息。如下
const
sc_drag=$F012;//这是按纽的鼠标按下事件;
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in Shift then
begin
ReleaseCapture;
TWinControl(Sender).Perform(wm_syscommand,sc_dragmove,0);
end;
end;
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.//调用tsizer.create(self,tcontrol(sender));
你可以将改变大小部分去掉的
加上
ReleaseCapture;
sendmessage(要移动的控件.Handle, wm_syscommand, $f012, 0);或者在控件的OnMouseDown事件中加入
ReleaseCapture;
sendmessage(要移动的控件.Handle, wm_syscommand, $f012, 0);