运行时,怎样才能拖动控件的边沿,使控件大小改变。就象设计时一样。如panel,button等(50分)

  • 主题发起人 主题发起人 qian0303
  • 开始时间 开始时间
Q

qian0303

Unregistered / Unconfirmed
GUEST, unregistred user!
运行时,怎样才能使鼠标移到控件边沿时,按下鼠标拖动,使控件大小改变。就象设计时一样。控件如panel,button等,非常感谢!!!
 
非常简单,
响应控件的WmNCHitTest消息,
当鼠标移动到左上点时,改变消息标识为HTTOPLEFT就可以向左上拉伸了
TMyPanel=class(TPanel)
private
procedure WMNCHitTest(var Msg:TWMCHiTest) message WM_NCHitTest;
....
end;
procedure TMyPanel.WmNCHitTest(var Msg: TWMNCHitTest);
const v=10; //border width
var p:TPoint;
begin
p:=Point(Msg.XPos,Msg.YPos);
p:=ScreenToClient(p);
if PtInRect(Rect(0,0,v,v),p) then
Msg.Result:=HTTOPLEFT
else if PtInRect(Rect(Width-v,Height-v,Width,Height),p) then
Msg.Result:=HTBOTTOMRIGHT
else if PtInRect(Rect(Width-v,0,Width,v),p) then
Msg.Result:=HTTOPRIGHT
else if PtInRect(Rect(0,Height-v,v,Height),p) then
Msg.Result:=HTBOTTOMLEFT
else if PtInRect(Rect(v,0,Width-v,v),p) then
Msg.Result:=HTTOP
else if PtInRect(Rect(0,v,v,Height-v),p) then
Msg.Result:=HTLEFT
else if PtInRect(Rect(Width-v,v,Width,Height-v),p) then
Msg.Result:=HTRIGHT
else if PtInRect(Rect(v,Height-v,Width-v,Height),p) then
Msg.Result:=HTBOTTOM;
Inherited;
end;
如果你不想用写控件的方式,那你就可以通过API,SetWindowLong函数来截获控件的
消息,你要是不清楚的话就搜索一下论坛。
 
你可以在两个空间之间加上splitter控件,连代码都不用写
 
toxiaoma4466:我在窗体里面只有一个panel啊,要拖大拖小的是panel呀。谢谢
 
NeutronDelphi, 的方法就可以了
 
这个你看看吧
在运行时可用dxfDesigner控件,在www.51delphi.com或www.playicq.com中有下载.
dxforumlibrary;
//////////////////////////////////////////////////////////////////////////////////////
constructor TSizerControl.myCreate(AOwner: TComponent; AControl: TControl);
var
R : TRect;
begin
inherited Create(AOwner);
FControl := AControl;
OnExit := SizeControlExit;

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 TSizerControl.Createhandle;
begin
inherited Createhandle;
SetFocus;
end;

procedure TSizerControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
//增加透明特性
Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;

procedure TSizerControl.paint;
var
i : integer;
begin
Canvas.Brush.Color := clBlack;
for i := 1 to 8 do
with FRectList do
Canvas.Rectangle(Left,Top,Right,Bottom);

end;

procedure TSizerControl.SizeControlExit(sender: TObject);
begin
Free;
end;

procedure TSizerControl.WmLButtonDown(var Msg: TWmLButtonDown);
begin
//执行拖动命令
Perform(wm_syscommand,sc_DragMove,0);
end;

procedure TSizerControl.WmMove(var Msg: TWmMove);
var
R : TRect;
begin
R := BoundsRect;
InflateRect(R,-2,-2);
FControl.Invalidate;
FControl.BoundsRect := R;
end;

procedure TSizerControl.WmNcHitTest(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,Pt) then
msg.Result := FPosList;
if msg.Result = 0 then
inherited;
end;

procedure TSizerControl.WmSize(var Msg: TWmSize);
var
R : TRect;
begin
R := BoundsRect;
InflateRect(R,-2,-2);
FControl.BoundsRect := R;
//计算8个黑方框
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 Register;
begin
RegisterNoicon([TSizerControl]);
end;
 
这个方法没提到
放3个Button,
Button1被拖动者
Button2开始
Button3结束
procedure TForm1.Button2Click(Sender: TObject);
begin
Self.DockSite:=true;
Button1.DragKind:=dkDock;
Button1.DragMode:=dmAutomatic;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Button1.DragKind:=dkDrag;
Button1.DragMode:=dmManual;
end;
 
谢谢我是说,让控件象设计时一样,可拖动改变大小拖动改变位置。
 
请问dxfDesigner在下面的哪们包里面啊??
Devexpress Page contro 2.12
DevExpress QuantumGrid 4.5.2
Devexpress printing system v3.02
DevExpress FlowChart 1.21
DevExpress Layout Control 1.17
DevExpress Inspector 2.01
Devexpress orgchart v1.3
Devexpress DBTree 1.3 1
Devexpress Memdata v1.81
Devexpress DBTree 1.3 1
ExpressBar 4.2
Devexpress Page control 1.1
Devexpress Memdata v1.81
 
苦,还是没有好方法。
 
后退
顶部