怎么实现对象拖动? 重画 or 直接移动对象? (100分)

  • 主题发起人 主题发起人 majorsoft
  • 开始时间 开始时间
M

majorsoft

Unregistered / Unconfirmed
GUEST, unregistred user!
各位DFW,我想实现象delphi中设计期能快速随意拖动组件的效果。用移动对象的方法,有明显的迟钝感。
FastReport中拖动是在Canvas上重新画对象的图片,而不是移动对象,但对象的图片是在canvas 上重画的,我的疑问是它重画之后,又是怎么和对象挂钩的呢?
delphi中的设计期实现拖动又是怎么实现呢?
 
对象另外保存
 
对象还能拖动??你拖一个TObject我看看???
组建能够拖动也使外在表现,也是画出来而已。
TControl,TWinControl都是画出来的。
 
to wr960204 :
也没有必要这么咬文嚼字,组件也是对象啊。
主要问题是他的图片怎么和对象联系起来的?
 
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 WmKeyDown(var Msg: TWMKEY); message WM_KEYDOWN;
procedure Paint; override;
procedure SizerControlExit (Sender: TObject);
end;

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 .Left, FRectList .Top,FRectList .Right, FRectList .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 , Pt) then Msg.Result := FPosList ;
// 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, $F012, 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;

procedure TDdhSizerControl.WmKeyDown(var Msg: TWMKEY);
begin
if (Msg.CharCode = VK_DELETE) then
begin
FControl.Free;
Free;
end;
end;
 
多人接受答案了。
 
后退
顶部