请问如何让元件在执行中象在设计中一样自由拖放与移动

[mouse]

请问如何让控件在程序执行中,可以象在DELPHI的IDE中一样自由拖放与移动.敬请指教.

[kxy]

去www.midatech.com/jiangtao下载DDH Code
第8章 运行时的Dragging与Sizing组件有一个例子.

更好的是DreamContorl控件包,很多地方可以下载.它功能强大,但看懂源码要花
一些时间.

[渤海海峡]

原码在此：
unit DdhSizer;

interface

uses
Classes, Windows, Messages, Controls, StdCtrls;

const
sc_DragMove: Longint = $F012;

type
TDdhSizerControl = class (TCustomControl)
private
FControl: TControl;
FRectList: array [1..8] of TRect;
FPosList: array [1..8] of Integer;
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 SizerControlExit (Sender: TObject);
end;

implementation

uses
Graphics;
// TDdhSizerControl methods

constructor TDdhSizerControl.Create (
AOwner: TComponent; AControl: TControl);
var
R: TRect;
begin
inherited Create (AOwner);
FControl := AControl;
// install the new handler
OnExit := SizerControlExit;
// set the size and position
R := FControl.BoundsRect;
InflateRect (R, 2, 2);
BoundsRect := R;
// set the parent
Parent := FControl.Parent;
// create the list of positions
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 TDdhSizerControl.CreateHandle;
begin
inherited CreateHandle;
SetFocus;
end;

procedure TDdhSizerControl.CreateParams (var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle +
ws_ex_Transparent;
end;

procedure TDdhSizerControl.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 TDdhSizerControl.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 [I], Pt) then
Msg.Result := FPosList [I];
// if the return value was not set
if Msg.Result = 0 then
inherited;
end;

procedure TDdhSizerControl.WmSize (var Msg: TWmSize);
var
R: TRect;
begin
R := BoundsRect;
InflateRect (R, -2, -2);
FControl.BoundsRect := R;
// setup data structures
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 TDdhSizerControl.SizerControlExit (Sender: TObject);
begin
Free;
end;

procedure TDdhSizerControl.WmLButtonDown (var Msg: TWmLButtonDown);
begin
Perform (wm_SysCommand, sc_DragMove, 0);
end;

procedure TDdhSizerControl.WmMove (var Msg: TWmMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect (R, -2, -2);
FControl.Invalidate; //repaint entire surface
FControl.BoundsRect := R;
end;
end.


然后在要拖动的控件的onclick中加以下代码：
if 拖动 then
TDdhSizerControl.Create (self, Sender as TControl);

[Firing_Sky]

天！别吓我，那么麻烦？试试这一段代码
在一个新的Form中放入一个Panel，加入如下代码：
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
SC_DragMove = $F012; { a magic number }begin ReleaseCapture;
panel1.perform(WM_SysCommand, SC_DragMove, 0);
end;

[zyb]

将要自由自由拖动的控件放在一个能响应一切鼠标消息的控件上，然后在鼠标移动时，将控件移动到鼠标位置即可。具体编程代码嘛，就不贴出来啦！

[xujiaqiang]

StretchHandle组件，除了可拖放移动还可Resize,我有源码，编译后可使用(D4)