怎样在运行时实现label或image的拖动以及在控件周围出现8个定位的点就像在TForm设计时调整其上控件的大小和位置一样?(150分)

  • 主题发起人 主题发起人 alvinlv
  • 开始时间 开始时间
A

alvinlv

Unregistered / Unconfirmed
GUEST, unregistred user!
怎样在运行时实现label或image的拖动以及在控件周围出现8个定位的点就像
在TForm设计时调整其上控件的大小和位置一样?
 
拖动简单

form.docksite:=true;
label.dragkind:=dkdock;
label.dragmode:=dmautomatic;

就行了。
改变大小可不容易。可能要使用第三方控件了
 
to menxin

这样即使能拖动, 可是总是出现window啊。 而且不能选中, 也不出现对像选中
时的那8个点啊。
 
自己继承类,改写外观和实现拖动代码
 
unit SizerControl;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TSizerControl = class(TCustomControl)
private
FControl: TControl;
FRectList: Array [1..8] of TRect;
FPosList: Array [1..8] of Integer;

{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent; AControl: TControl);
procedure CreateParams(var Params: TCreateParams); override;
procedure Createhandle;override;
procedure WmNcHitTest(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 SizeControlExit(Sender: TObject);

{ Public declarations }
published
{ Published declarations }
end;
const
sc_DragMove: Longint = $F012;


procedure Register;

implementation

constructor TSizerControl.Create(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.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
//增加透明特性
Params.ExStyle := Params.ExStyle
+ WS_EX_TRANSPARENT;
end;

procedure TSizerControl.Createhandle;
begin
inherited Createhandle;
SetFocus;
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 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.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 Register;
begin
RegisterNoicon([TSizerControl]);
end;

end

主窗口程序:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
btn: TButton;
GroupBox1: TGroupBox;
procedure btnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses SizerControl;

{$R *.DFM}

procedure TForm1.btnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
SizeControl: TSizerControl;
begin
SizeControl := TSizerControl.Create(self, btn);
end;

procedure TForm1.GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
SizeControl: TSizerControl;
begin
SizeControl := TSizerControl.Create(self, GroupBox1);
end;



end.
 
有个第三方控件。可以更改,比自己写代码效果好。
如果要我发给你。
 
to lovefox:
也发一个给我好吗?
terry_lzs@sina.com.cn
 
to lovefox: 那个控件有多大? < 2M 发到 alvin.lv@263.net
> 2M 发到 alvinlv@china.com
谢谢。

to angshuangxi
我马上试这个方法。 ok 就给分
 
到深度历险里找现成组件:
HANDEL或者Resizer(名字大概如此)。
 
我也要,谢谢hukaijt@sina.com.cn
 
给我一个:bslijie@etang.com
 
to lovefox: 我强烈要那个控件,请发到hukaijt@sina.com.cn
hukaijt@263.net谢谢!
 
给我一个:lin.ceiba@263.net
 
to lovefox 请发给我吧。

alvin.lv@263.net

thanks.
 
请发给我一个lazycat521@263.net
 
谢谢!quantum99@sina.com
 
能给我一个么?谢谢:guestwind@21cn.com
 
你的方法还真行。 谢谢。

不过有点建议。 对象的选中和拖动是分开在两次鼠标点击事件中做的。 如果是
在一次事件中就可以处理就更好了。
 
后退
顶部