顶者有分，帮忙呀(200分)

如何在程序运行过程中，能够拖动控件的位置，像用友票据打印中的动态设置控件，就像咱们现在用delphi做界面一样。我用spy看了一下，也没看出啥！！！
它是怎么做的呀？能不能给点思路，最好能给点代码！我的邮箱：cooldren@tom.com

谢谢！

顶一下

不复杂啊
到全文检索搜一下
应该很多

已经发出，请查收

摘抄自大富翁
举例如下：创建一个 Panel，再创建一个Label，通过编程使控件 Lable 可以在 Panel 中被拖放到任意位置。以下是具体实现过程：
　　1.首先做一下准备工作，运行Delphi，进入集成开发环境，在 File 菜单中选择New Application 。
　　2.在Form1中创建对象 Panel1，并在 Panel1 中创建另一对象 Label1。
　　3.选中Label1,修改其下列属性的值：
属性 值
Caption : 标签移动测试!
Cursor : crHandPoint
DragCursor : crDrag
DragMode : dmAutomatic
　　4.在程序的开头部分声明全局变量 x_panel,y_panel,x_label,y_label
　　其中,x_panel,y_panel :鼠标在Panel1上的坐标。
　　x_label,y_label :鼠标在label1上的坐标。
　　注：这里分别获取在Panel1和Label1上的坐标是为了更精确地计算出Label1实际的移动距离。
　　5.在Panel1的OnDragOver 和OnMouseMove 事件中添加如下代码：
　　x_panel:=X;
　　y_panel:=Y;
　　注：该操作是获得 mouse 在Panel1上的坐标。
　　6.在Label1的OnMouseMove 事件中添加如下代码：
　　x_Labell:=X;
　　y_Label1:=Y;
　　注：该操作是获得 mouse 在Label1上的坐标。
　　7.在Label1的OnEndDrag 事件中添加如下代码：
　　label1.left :=x_panel－x_label;
　　label1.top :=y_panel－y_label;
　　说明：两者相减是为了求得 label1 实际的移动距离。
　　8.创建一个对象 Button1 ，并在其 OnClick 事件中添加如下代码：
　　close; 用以关闭应用程序。
　　好了，现在运行程序，测试一下结果。
　　以下是程序源代码，在Delphi3.0、Windows95/98中测试通过。
unit test_move;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure Label1EndDrag(Sender, Target: TObject; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
x_panel,y_panel,x_label,y_label:integer;
end;
var
Form1: TForm1;
implementation
{＄R ＊.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;
procedure FTorm1.Panel1MouseMove
(Sender: TObject; Shift: TShiftState;
X,Y: Integer);
begin
x_panel:=X;
y_panel:=Y;
end;
procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
x_panel:=X;
y_panel:=Y;
end;
procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState;
X,Y: Integer);
begin
x_label:=X;
y_label:=Y;
end;
procedure TForm1.Label1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
label1.left :=x_panel－x_label;
label1.top:=y_panel－y_label;
end;
end.

有分？
我也要来顶一下[]

解释的非常好，可惜我看不懂，顶一下吧！

缺分，帮顶

缺分，帮顶

To cooldren,
我朋友会，他的QQ:84411693

就(yaya8163)的方法行了呀

弄个编程宝典什么的看看撒，这种问题98年以前就有人讨论过的

挺有意思

用delphiX组件。速度很快。

了解动态创建控件，
还有，根据具体需求设置属性
程序控制起来应该不会太难吧

是不是类似ReSizer哪种组件呀

不懂，帮忙顶一下。

托什么控件，是timage吗，
我做了个实验的多媒体课件，用d6，拖电阻电容（image)到电路板上(image)，
但是拖动电阻超过2个时，容易出错，几个一起动，必须加入许多判断。但是放下后就不能再拖动了。
楼上的 yaya8163，如果你有随意拖3个label不出问题的原码，我把我所有分都给你！！！
拜托 dwsrlbbh@163.com

>>>>>顶者有分，帮忙呀
君子一言四马难追。。。

to yostgxf:
感谢您发的源码，谢谢！


下面是yostgxf的源码，好东东不敢独享，把它贴出来，大家一起分享。


unit Resizer;



interface



uses

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

ExtCtrls;



const

GRIDDEFAULT = 4;



type

TResizer = class;

TMover = class;



TMovingEvent = procedure(Sender: TResizer; var NewLeft, NewTop: integer) of
object;

TSizingEvent = procedure(Sender: TResizer; var NewLeft, NewTop, NewWidth,
NewHeight: integer) of object;



TResizer = class(TComponent)

protected

FActive : boolean;

FControl : TControl;

Sizers : TList;

GroupMovers : TList;

FGroup : TWinControl;

FGridX : integer;

FGridY : integer;

FOnSized : TNotifyEvent;

FOnSizing : TSizingEvent;

FOnMoved : TNotifyEvent;

FOnMoving : TMovingEvent;

Sizing : boolean;

Moving : boolean;

OrigSize : TRect;

NewSize : TRect;

DownX : integer;

DownY : integer;

FAllowSize : boolean;

FAllowMove : boolean;

FKeepIn : boolean;

FHotTrack : boolean;

OneMover : TMover;

CurMover : TMover;

procedure Notification(AComponent: TComponent; Operation: TOperation);
override;

procedure SetActive(b: boolean);

procedure SetControl(c: TControl);

procedure SetGroup(p: TWinControl);

procedure CreateSizers;

procedure CheckSizers;

procedure ShowSizers;

procedure HideSizers;

procedure SizerDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);

procedure SizerUp(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);

procedure SizerMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure MoverDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);

procedure MoverUp(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);

procedure MoverMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure DrawSizeRect(Rect: TRect);

procedure Calc_Size_Rect(SizerNum, dx, dy: integer);

procedure DoSizingEvent;

procedure Calc_Move_Rect(dx, dy: integer);

procedure DoMovingEvent;

procedure Constrain_Size;

procedure Constrain_Move;

procedure MoverKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);

procedure DoSizeMove(var Key: Word; Shift: TShiftState; dx, dy: integer);

procedure CreateGroupMovers;

procedure CreateOneMover(m: TMover; c: TControl);

function FindMoverByBuddy(c: TControl): TMover;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

property Active: boolean read FActive write SetActive default True;

property ResizeControl: TControl read FControl write SetControl;

property ResizeGroup: TWinControl read FGroup write SetGroup;

property GridX: integer read FGridX write FGridX default GRIDDEFAULT;

property GridY: integer read FGridY write FGridY default GRIDDEFAULT;

property OnSized: TNotifyEvent read FOnSized write FOnSized;

property OnSizing: TSizingEvent read FOnSizing write FOnSizing;

property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;

property OnMoving: TMovingEvent read FOnMoving write FOnMoving;

property AllowSize: boolean read FAllowSize write FAllowSize default
True;

property AllowMove: boolean read FAllowMove write FAllowMove default
True;

property KeepInParent: boolean read FKeepIn write FKeepIn default True;

property HotTrack: boolean read FHotTrack write FHotTrack;

end;



TInvisWin = class(TPanel) // This could also derive from TPanel

protected

procedure WndProc(var Message: TMessage); override;

procedure CreateParams(var Params: TCreateParams); override;

procedure WMDLGCode(var Message: TMessage); message WM_GETDLGCODE;

public

property OnKeyDown;

end;



TMover = class(TInvisWin)

public

Buddy : TControl;

procedure Show;

end;





procedure Register;



implementation



const

SIZE = 6;

HALFSIZE = SIZE div 2;



type

TSizer = class(TPanel)

end;



procedure Register;

begin

RegisterComponents('Samples', [TResizer]);

end;





// *****************************************************************

// TInvisWin



procedure TInvisWin.WndProc(var Message: TMessage);

var

ps : TPaintStruct;

begin

case Message.Msg of

WM_ERASEBKGND: Message.Result := 1;

WM_PAINT: begin

BeginPaint(Handle, ps);

EndPaint(Handle, ps);

Message.Result := 1;

end;

else

inherited WndProc(Message);

end;

end;



procedure TInvisWin.CreateParams(var Params: TCreateParams);

begin

inherited;

Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;

end;



procedure TInvisWin.WMDLGCode(var Message: TMessage);

begin

Message.Result := DLGC_WANTARROWS or DLGC_WANTALLKEYS;

end;





// *****************************************************************

// TMover



procedure TMover.Show;

begin

Assert(Buddy <> nil);

BoundsRect := Buddy.BoundsRect;

Parent := Buddy.Parent;

Visible := True;

BringToFront;

end;





// *****************************************************************

// TResizer



constructor TResizer.Create(AOwner: TComponent);

begin

inherited;

FActive := True;

FKeepIn := True;

FGridX := GRIDDEFAULT;

FGridY := GRIDDEFAULT;

FAllowSize := True;

FAllowMove := True;

GroupMovers := TList.Create;

Sizers := TList.Create;



OneMover := TMover.Create(Self);

CreateOneMover(OneMover, nil);



CreateSizers;

end;



destructor TResizer.Destroy;

begin

GroupMovers.Free;

Sizers.Free;

Sizers := nil;

inherited;

end;



procedure TResizer.Notification(AComponent: TComponent; Operation: TOperation);

begin

inherited;

if csDestroying in ComponentState then exit;

if (AComponent = ResizeControl) and (Operation = opRemove) then

ResizeControl := nil;

end;



procedure TResizer.SetActive(b: boolean);

begin

if b<>FActive then begin

FActive := b;

CheckSizers;

end;

end;



procedure TResizer.SetControl(c: TControl);

begin

if c <> FControl then begin



if c<>nil then begin

if ResizeGroup<>nil then begin

Assert(c.Parent = ResizeGroup, 'ResizeControl is not in ResizeGroup!'
);

CurMover := FindMoverByBuddy(c);

end else begin

CurMover := OneMover;

CurMover.Buddy := c;

end;

CurMover.Show;

end;



FControl := c;

CheckSizers;

end;

end;



procedure TResizer.SetGroup(p: TWinControl);

begin

if p <> FGroup then begin

FGroup := p;

CreateGroupMovers;

end;

end;



procedure TResizer.CreateGroupMovers;

var

i : integer;

m : TMover;

c : TControl;

begin

if csDesigning in ComponentState then exit;



// Clear out the old Movers

for i := 0 to GroupMovers.Count-1 do

TObject(GroupMovers).Free;

GroupMovers.Clear;



if ResizeGroup <> nil then begin

for i := 0 to ResizeGroup.ControlCount-1 do begin

c := ResizeGroup.Controls;

if (c is TMover) or (c is TSizer) then continue;



m := TMover.Create(Self);

CreateOneMover(m, c);

GroupMovers.Add(m);

m.Show;

end;

end;

end;



procedure TResizer.CreateSizers;

var

i : integer;

p : TSizer;

begin

if csDesigning in ComponentState then exit;



for i := 0 to 7 do begin

p := TSizer.Create(Self);

Sizers.Add(p);



p.BevelOuter := bvNone;

p.Width := SIZE;

p.Height := SIZE;

p.Color := clBlack;

p.Caption := '';

p.Tag := i;

p.OnMouseDown := SizerDown;

p.OnMouseUp := SizerUp;

p.OnMouseMove := SizerMove;

p.TabStop := False;



case i of

0, 7 : p.Cursor := crSizeNWSE;

2, 5 : p.Cursor := crSizeNESW;

1, 6 : p.Cursor := crSizeNS;

3, 4 : p.Cursor := crSizeWE;

end;

end;

end;



procedure TResizer.CreateOneMover(m: TMover; c: TControl);

begin

m.OnMouseDown := MoverDown;

m.OnMouseUp := MoverUp;

m.OnMouseMove := MoverMove;

m.TabStop := True;

m.OnKeyDown := MoverKeyDown;

m.Buddy := c;

end;



procedure TResizer.CheckSizers;

begin

if (ResizeControl<>nil) and Active and (not (csDesigning in ComponentState))
then

ShowSizers

else

HideSizers;

end;



procedure TResizer.ShowSizers;

var

i : integer;

p : TPanel;

c : TControl;

begin

c := ResizeControl;

Assert(c <> nil);



for i := 0 to 7 do begin

p := TPanel(Sizers);

case i of

0, 1, 2 : p.Top := c.Top - HALFSIZE;

3, 4 : p.Top := c.Top + c.Height div 2 - HALFSIZE;

5, 6, 7 : p.Top := c.Top + c.Height - HALFSIZE;

end;



case i of

0, 3, 5 : p.Left := c.Left - HALFSIZE;

1, 6 : p.Left := c.Left + c.Width div 2 - HALFSIZE;

2, 4, 7 : p.Left := c.Left + c.Width - HALFSIZE;

end;

end;



Assert(CurMover<>nil);

CurMover.Show;



for i := 0 to Sizers.Count-1 do begin

p := TPanel(Sizers);

p.Parent := c.Parent;

p.Visible := True;

p.BringToFront;

end;



if CurMover.HandleAllocated and CurMover.CanFocus then

CurMover.SetFocus;

end;



procedure TResizer.HideSizers;

var

i : integer;

p : TPanel;

begin

for i := 0 to Sizers.Count-1 do begin

p := TPanel(Sizers);

p.Visible := False;

p.Update;

end;

OneMover.Visible := False;

end;



procedure TResizer.SizerDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);

begin

Sizing := True;

DownX := X;

DownY := Y;

HideSizers;

ResizeControl.Parent.Update;

ResizeControl.Update;

OrigSize := ResizeControl.BoundsRect;

NewSize := OrigSize;

DrawSizeRect(NewSize);

end;



procedure DoSwap(DoSwap: boolean; var a, b: integer);

var

t : integer;

begin

if DoSwap then begin

t := a;

a := b;

b := t;

end;

end;



procedure TResizer.SizerUp(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);

begin

if NewSize.Right < NewSize.Left then

DoSwap(True, NewSize.Right, NewSize.Left);

if NewSize.Bottom < NewSize.Top then

DoSwap(True, NewSize.Bottom, NewSize.Top);



Sizing := False;

DrawSizeRect(NewSize);

ResizeControl.Invalidate;

ResizeControl.BoundsRect := NewSize;

ShowSizers;

if Assigned(OnSized) then OnSized(Self);

end;



procedure TResizer.SizerMove(Sender: TObject; Shift: TShiftState; X, Y: Integer)
;

begin

if Sizing then begin

DrawSizeRect(NewSize);



if AllowSize then begin

Calc_Size_Rect((Sender as TSizer).Tag, X - DownX, Y - DownY);

DoSizingEvent;

end;



DrawSizeRect(NewSize);

if HotTrack then ResizeControl.BoundsRect := NewSize;

end;

end;



procedure TResizer.DoSizingEvent;

var

tmpWid, tmpHgt : integer;

begin

tmpWid := NewSize.Right - NewSize.Left;

tmpHgt := NewSize.Bottom - NewSize.Top;

if Assigned(OnSizing) then

OnSizing(Self, NewSize.Left, NewSize.Top, tmpWid, tmpHgt);

NewSize.Right := NewSize.Left + tmpWid;

NewSize.Bottom := NewSize.Top + tmpHgt;

end;



procedure GetNonClientOffset(h: THandle; var nx, ny: integer);

var

p : TPoint;

R : TRect;

begin

p := Point(0, 0);

Windows.ClientToScreen(h, p);

Windows.GetWindowRect(h, R);

nx := p.x - R.Left;

ny := p.y - R.Top;

end;



procedure TResizer.DrawSizeRect(Rect: TRect);

var

h : THandle;

dc : THandle;

c : TCanvas;

nx, ny : integer;

OldPen : TPen;

OldBrush : TBrush;

begin

if HotTrack then exit;



h := (ResizeControl.Parent as TWinControl).Handle;

GetNonClientOffset(h, nx, ny);

dc := GetWindowDC(h);

try

c := TCanvas.Create;

c.Handle := dc;



OldPen := TPen.Create;

OldPen.Assign(c.Pen);

OldBrush := TBrush.Create;

OldBrush.Assign(c.Brush);



c.Pen.Width := 2;

c.Pen.Mode := pmXOR;

c.Pen.Color := clWhite;

c.Brush.Style := bsClear;

c.Rectangle(Rect.Left + nx, Rect.Top + ny, Rect.Right + nx, Rect.Bottom +
ny);



c.Pen.Assign(OldPen);

OldPen.Free;

c.Brush.Assign(OldBrush);

OldBrush.Free;



c.Handle := 0;

c.Free;

finally

ReleaseDC(h, dc);

end;

end;



procedure TResizer.Calc_Size_Rect(SizerNum, dx, dy: integer);

begin

dx := (dx div GridX) * GridX;

dy := (dy div GridY) * GridY;



case SizerNum of

0, 1, 2 : NewSize.Top := OrigSize.Top + dy;

5, 6, 7 : NewSize.Bottom := OrigSize.Bottom + dy;

end;



case SizerNum of

0, 3, 5 : NewSize.Left := OrigSize.Left + dx;

2, 4, 7 : NewSize.Right := OrigSize.Right + dx;

end;



if KeepInParent then Constrain_Size;

end;



procedure TResizer.MoverDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);

begin

CurMover := Sender as TMover;

FControl := CurMover.Buddy;

Assert(FControl<>nil);

FControl.BringToFront;

CurMover.BringToFront;



Moving := True;

DownX := X;

DownY := Y;

HideSizers;

ResizeControl.Parent.Update;

ResizeControl.Update;

OrigSize := ResizeControl.BoundsRect;

NewSize := OrigSize;

DrawSizeRect(NewSize);

end;



procedure TResizer.MoverUp(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);

begin

Moving := False;

ResizeControl.BoundsRect := NewSize;

CurMover.Invalidate;

ResizeControl.Refresh;

DrawSizeRect(NewSize);

ShowSizers;

if Assigned(OnMoved) then OnMoved(Self);

end;



procedure TResizer.Calc_Move_Rect(dx, dy: integer);

begin

NewSize := OrigSize;

dx := (dx div GridX) * GridX;

dy := (dy div GridY) * GridY;

OffsetRect(NewSize, dx, dy);

if KeepInParent then Constrain_Move;

end;



procedure TResizer.DoMovingEvent;

var

tmpWid, tmpHgt : integer;

begin

tmpWid := NewSize.Right - NewSize.Left;

tmpHgt := NewSize.Bottom - NewSize.Top;

if Assigned(OnMoving) then

OnMoving(Self, NewSize.Left, NewSize.Top);

NewSize.Right := NewSize.Left + tmpWid;

NewSize.Bottom := NewSize.Top + tmpHgt;

end;



procedure TResizer.MoverMove(Sender: TObject; Shift: TShiftState; X, Y: Integer)
;

var

dx, dy: integer;

begin

if Moving then begin

DrawSizeRect(NewSize);



if AllowMove then begin

dx := X - DownX;

dy := Y - DownY;

Calc_Move_Rect(dx, dy);

DoMovingEvent;

end;



DrawSizeRect(NewSize);

if HotTrack then ResizeControl.BoundsRect := NewSize;

end;

end;



procedure TResizer.Constrain_Size;

var

p : TWinControl;

begin

p := ResizeControl.Parent;



with NewSize do begin

if Left < 0 then Left := 0;

if Top < 0 then Top := 0;

if Right > p.ClientWidth then Right := p.ClientWidth;

if Bottom > p.ClientHeight then Bottom := p.ClientHeight;



if Right < Left + GridX then Right := Left + GridX;

if Bottom < Top + GridY then Bottom := Top + GridY;

end;

end;



procedure TResizer.Constrain_Move;

begin

if NewSize.Left < 0 then

OffsetRect(NewSize, -NewSize.Left, 0);



if NewSize.Top < 0 then

OffsetRect(NewSize, 0, -NewSize.Top);



if NewSize.Right > ResizeControl.Parent.ClientWidth then

OffsetRect(NewSize, ResizeControl.Parent.ClientWidth - NewSize.Right, 0);



if NewSize.Bottom > ResizeControl.Parent.ClientHeight then

OffsetRect(NewSize, 0, ResizeControl.Parent.ClientHeight - NewSize.Bottom);

end;



procedure TResizer.MoverKeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);

begin

if Active then begin

case Key of

VK_LEFT : DoSizeMove(Key, Shift, -GridX, 0);

VK_RIGHT : DoSizeMove(Key, Shift, GridX, 0);

VK_UP : DoSizeMove(Key, Shift, 0, -GridY);

VK_DOWN : DoSizeMove(Key, Shift, 0, GridY);

end;

end;

end;



procedure TResizer.DoSizeMove(var Key: Word; Shift: TShiftState; dx, dy: integer
);

begin

if (ssCtrl in Shift) or (ssShift in Shift) then begin

Key := 0;



NewSize := ResizeControl.BoundsRect;



if (ssCtrl in Shift) and AllowMove then begin

OffsetRect(NewSize, dx, dy);

if KeepInParent then Constrain_Move;

DoMovingEvent;

end;



if (ssShift in Shift) and AllowSize then begin

NewSize.Right := NewSize.Right + dx;

NewSize.Bottom := NewSize.Bottom + dy;

if KeepInParent then Constrain_Size;

DoSizingEvent;

end;



ResizeControl.BoundsRect := NewSize;

ShowSizers;

end;

end;



function TResizer.FindMoverByBuddy(c: TControl): TMover;

var

i : integer;

begin

Result := nil;

for i := 0 to GroupMovers.Count-1 do

if TMover(GroupMovers).Buddy = c then

Result := GroupMovers;

Assert(Result <> nil);

end;



end.



这个控件装上去，就能设置控件在程序运行时随意拖动，就象设计时一样，边上还有四个小
点



1.在label的OnMouseDown中写label1.BeginDrag(false);

2.在TForm1 OnDragOver中写if Source is TLabel

Accept=true;

3.在Form1的OnDrawDrop中写

Label1.left=x;

Label1.top=y;

如果是Panel或Button,可以用Perform()

void __fastcall TForm1:anel1MouseDown(TObject *Sender,

TMouseButton Button, TShiftState Shift, int X, int Y)

{

int SC_DragMove=0xF012;

ReleaseCapture();

Panel1->Perform(WM_SYSCOMMAND,SC_DragMove,0);

}