перемещение объекта

911 views
Skip to first unread message

Aleksey Korkin

unread,
Sep 14, 2004, 8:37:11 AM9/14/04
to
*Привет, All!*
*───────────────────────────────────────────────────--·*

как сделать так, чтобы когда нажимая на каком-нибудь объекте мышкой и удерживая
кнопку можно было переместить/перетащить этот самый объект?

*───────────────────────────────────────────────────--·*
/[/ /*surfing.h12.ru/* /]/ /[/ /*esoterics.by.ru/* /]/ /[/ /*hwor.nm.ru/* /]/
_/[/_ _Эзотерика_ [ *Relax* ][ *ОС* ][ *ВТО* ] _/]_/ _/[/_ *StreetRacing* _/]/_
... ·─[UIN /_*177282862/_*]─·─[Team /_*HwoR/_*]─·─[/_*hw...@km.ru/_*]─·

Nikolay Koltashov

unread,
Sep 14, 2004, 10:23:50 AM9/14/04
to
Hello, Aleksey!

14 Сен 04 18:37, Aleksey Korkin -> All:

AK> как сделать так, чтобы когда нажимая на каком-нибyдь объекте мышкой и
AK> yдеpживая кнопкy можно было пеpеместить/пеpетащить этот самый объект?
вот так y меня для панельки на фоpме сделано

procedure TPeopleForm.FilterPanelMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
SC_DragMove = $F012; { a magic number }
begin
ReleaseCapture;
FilterPanel.Perform(WM_SysCommand, SC_DragMove, 0);
end;


nk/47

Andrey Gusev

unread,
Sep 15, 2004, 11:17:10 AM9/15/04
to
14 Сен 04 17:37, ты вроде писал(а) All:

AK> как сделать так, чтобы когда нажимая на каком-нибудь объекте мышкой и
AK> удерживая кнопку можно было переместить/перетащить этот самый объект?

Если объект имеет hWND (хендл окна) -

Hапример, будем таскать по форме кнопку(правда нажать на неё не удастся...):

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;


Shift: TShiftState; X, Y: Integer);

begin
ReleaseCapture;
Button1.Perform(WM_SYSCOMMAND,SC_MOVE+2,0)
end;

... /*винамп мёpтв*/

Leonid Troyanovsky

unread,
Sep 18, 2004, 4:25:58 AM9/18/04
to
Приветствую, Aleksey.

AK> как сделать так, чтобы когда нажимая на каком-нибудь объекте мышкой и
AK> удерживая кнопку можно было переместить/перетащить этот самый объект?

> I need to write a component that contains nodes which can be selected and
> drug anywhere within it. I would like to be able to select each node, then
> drag it, like components on a form in the IDE. Any help on this would be
> greatly appreciated.
>

Perhaps you can get some ideas from this example.

<quote>
Example for creating controls on the fly, dragging and resizing them
with the mouse at run-time.

unit Unit1;

interface

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

Type
TControlDragKind =
(dkNone, dkTopLeft, dkTop, dkTopRight, dkRight, dkBottomRight,
dkBottom, dkBottomLeft, dkLeft, dkClient);

TForm1 = class(TForm)
procedure FormClick(Sender: TObject);
private
{ Private declarations }
FDownPos : TPoint; { position of last mouse down,
screen-relative }
FDragKind: TcontrolDragKind; { kind of drag in progress }

procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;


Shift: TShiftState; X, Y: Integer);

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


Shift: TShiftState; X, Y: Integer);

function GetDragging: Boolean;
public
{ Public declarations }
property DraggingControl: Boolean read GetDragging;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
Const
{ Set of cursors to use while moving over and dragging on controls. }
DragCursors : Array [TControlDragKind] of TCursor =
( crDefault, crSizeNWSE, crSizeNS, crSizeNESW, crSizeWE,
crSizeNWSE, crSizeNS, crSizeNESW, crSizeWE, crHandPoint );

{Width of "hot zone" for dragging around the control borders. }
HittestMargin = 3;

Type
TCracker = Class(TControl);
{ Needed since TControl.MouseCapture is protected }

{ Perform hittest on the mouse position. Position is in client coordinates
for the passed control. }
function GetDragKind(control: TControl; X,Y: Integer): TControlDragKind;
var
r: TRect;
begin
r:= control.Clientrect;
Result := dkNone;
If Abs(X-r.left) <= HittestMargin Then
If Abs( Y - r.top ) <= HittestMargin Then
Result := dkTopLeft
Else If Abs( Y - r.bottom) <= HittestMargin Then
Result := dkBottomLeft
Else
Result := dkLeft
Else If Abs(X-r.right) <= HittestMargin Then
If Abs( Y - r.top ) <= HittestMargin Then
Result := dkTopRight
Else If Abs( Y - r.bottom) <= HittestMargin Then
Result := dkBottomRight
Else
Result := dkRight
Else If Abs( Y - r.top ) <= HittestMargin Then
Result := dkTop
Else If Abs( Y - r.bottom) <= HittestMargin Then
Result := dkBottom
Else If PtInRect( r, Point(X,Y)) Then
Result := dkClient;
end; { GetDragKind }

procedure TForm1.FormClick(Sender: TObject);
var
pt: TPoint;
begin
// get cursor position, convert to client coordinates
GetCursorPos( pt );
pt := ScreenToClient( pt );
// create label with top left corner at mouse position
With TLabel.Create( Self ) Do Begin
SetBounds( pt.x, pt.y, width, height );
Caption := Format('Hit at %d,%d',[pt.x, pt.y]);
Color := clBlue;
Font.Color := clWhite;
Autosize := False; { Otherwise resizing is futile. }
Parent := Self;

// attach the drag handlers
OnMouseDown := ControlMouseDown;
OnMouseUp := ControlMouseUp;
OnMouseMove := ControlMouseMove;
End; { With }
end; { FormClick }

procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;


Shift: TShiftState; X, Y: Integer);
begin

{ Go into drag mode if left mouse button went down and no modifier key
is pressed. }
If (Button = mbLeft) and (Shift = [ssLeft]) Then Begin
{ Determine where on the control the mouse went down. }
FDragKind := GetDragKind( Sender As TControl, X, Y );
If FDragKind <> dkNone Then Begin
With TCracker(Sender) Do Begin
{ Record current position screen-relative, the origin for the
client-relative position will move if the form is moved or
resized on left/top sides. }
FDownPos:= ClientToScreen( Point( X, Y ));
MouseCapture := True;
Color := clRed;
End; { With }
End; { If }
End; { If }
end; { ControlMouseDown }

procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
dx, dy: Integer;
pt: TPoint;
r: TRect;
begin
{ Set controls cursor depending on position in control. }
(Sender as TControl).Cursor :=
DragCursors[ GetDragKind( TControl(Sender), X, Y )];

{ If we are dragging the control, get amount the mouse has moved since
last call and calculate a new boundsrect for the control from it,
depending on drag mode. }
If DraggingControl Then
with Sender As TControl Do Begin
pt:= ClientToScreen( Point( X, Y ));
dx:= pt.X - FDownPos.X;
dy:= pt.Y - FDownPos.Y;
{ Update stored mouse position to current position. }
FDownPos := pt;
r:= BoundsRect;
Case FDragKind Of
dkTopLeft: Begin
r.Left := r.Left + dx;
r.Top := r.Top + dy;
End; { Case dkTopLeft }
dkTop: Begin
r.Top := r.Top + dy;
End; { Case dkTop }
dkTopRight: Begin
r.Right := r.Right + dx;
r.Top := r.Top + dy;
End; { Case dkTopRight }
dkRight: Begin
r.Right := r.Right + dx;
End; { Case dkRight }
dkBottomRight: Begin
r.Right := r.Right + dx;
r.Bottom := r.Bottom + dy;
End; { Case dkBottomRight }
dkBottom: Begin
r.Bottom := r.Bottom + dy;
End; { Case dkBottom }
dkBottomLeft: Begin
r.Left := r.Left + dx;
r.Bottom := r.Bottom + dy;
End; { Case dkBottomLeft }
dkLeft: Begin
r.Left := r.Left + dx;
End; { Case dkLeft }
dkClient: Begin
OffsetRect( r, dx, dy );
End; { Case dkClient }
End; { Case }
{ Don't let the control be resized to nothing }
If ((r.right - r.left ) > 2*HittestMargin) and
((r.bottom - r.top ) > 2*HittestMargin)
Then
Boundsrect := r;
End; { With }
end; { ControlMouseMove }

procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton;


Shift: TShiftState; X, Y: Integer);
begin

If DraggingControl then Begin
{ Revert to non-dragging state. }
FDragKind := dkNone;
With TCracker(Sender) Do Begin
MouseCapture := False;
Color := clBlue;
End; { With }
End; { If }
end; { ControlMouseUp }

{ Read method for ControlDragging property, returns true if form is in drag
mode. }
function TForm1.GetDragging: Boolean;
begin
Result := FDragKind <> dkNone;
end;

end.
</quote>
Peter Below (TeamB) 10011...@compuserve.com)

--

С уважением, LVT.

Reply all
Reply to author
Forward
0 new messages