Форум: "Основная";
Текущий архив: 2004.12.12;
Скачать: [xml.tar.bz2];
ВнизПеретаскивание визуальных компонентов Найти похожие ветки
← →
Vir (2004-11-26 01:09) [0]Появилась задача сделать нечто на подобии редактора форм, так вот одной из проблем стала возможность таксания оконных элеметов по форме.
Посоветуте как бы это сделать?
← →
jack128 © (2004-11-26 01:31) [1]OnMouseMove/OnMouseDown/OnMouseUp
Посмотри в faq"е, может там есть
← →
KilkennyCat © (2004-11-26 01:50) [2]из кулибы
procedure TForm1.Button1MouseDown(Sender: TObject; Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
{$IFNDEF WIN32}
var
pt : TPoint;
{$ENDIF}
begin
if ssCtrl in Shift then begin
ReleaseCapture;
SendMessage(Button1.Handle, WM_SYSCOMMAND, 61458, 0);
{$IFNDEF WIN32}
GetCursorPos(pt);
SendMessage(Button1.Handle,
WM_LBUTTONUP,
MK_CONTROL,
Longint(pt));
{$ENDIF}
end;
end;
← →
Vir (2004-11-26 02:19) [3]KilkennyCat © (26.11.04 01:50) [2] Спасиб отличный пример
← →
jack128 © (2004-11-26 03:26) [4]KilkennyCat © (26.11.04 1:50) [2]
А что это за магическая команда 61458 ?
← →
kostan © (2004-11-26 05:28) [5]если без SendMessage то через
обработку событий OnDragDrop..... на форме
← →
Rouse_ © (2004-11-26 10:21) [6]
procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Memo1.Perform(WM_SYSCOMMAND, $F012, 0);
end;
← →
Skier © (2004-11-26 11:12) [7]ищи в Инете компонент TStretchHandle
← →
Leonid Troyanovsky (2004-11-26 13:59) [8]
> Vir (26.11.04 01:09)
> Появилась задача сделать нечто на подобии редактора форм,
> так вот одной из проблем стала возможность таксания оконных
> элеметов по форме.
> Посоветуте как бы это сделать?
> 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) 100113.1101@compuserve.com)
--
С уважением, LVT.
← →
KilkennyCat © (2004-11-26 17:13) [9]
> Rouse_ © (26.11.04 10:21) [6]
точно, он самый магикнамбер... если F012 изменять с шагом один, то можно получить не только перемещение, но и изменение размеров в различном направлении...
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.12.12;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.033 c