TShape drag

← →
Пётр_К (2007-02-14 16:54) [0]

Можно ли сделать так, чтобы shape можно было таскать так,
как во время разработки?

← →
DVM © (2007-02-14 16:54) [1]

можно

← →
Пётр_К (2007-02-14 16:58) [2]

А как?

← →
Джо © (2007-02-14 17:02) [3]

> [2] Пётр_К (14.02.07 16:58)
> А как?

Обработчики OnMouseDown, OnMouseUp, OnMouseMove. Запоминаем начальные координаты, текущие, два режими: «в движении»/нет. Все просто.

← →
Пётр_К (2007-02-14 17:03) [4]

Спасибо большое.

← →
DVM © (2007-02-14 17:03) [5]

Че-то в этом духе:

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TForm1 = class(TForm) Shape1: TShape; procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } public { Public declarations } end; var Form1: TForm1; b: boolean; implementation {$R *.dfm} procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin b:=true; end; procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if b then begin shape1.Left := x; shape1.Top := y; end; end; procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin b:= false; end; end.

← →
Пётр_К (2007-02-14 17:07) [6]

Ещё раз большое спасибо.

← →
Террабайт (2007-03-25 04:41) [7]

Я проверил пример но там когда начнеш таскат шейп всегда мигает как от этого избавится

← →
Loginov Dmitry © (2007-03-25 08:58) [8]

procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var NewLeft, NewTop: Integer; begin if ssLeft in Shift then begin NewLeft := Shape1.Left + X; NewTop := Shape1.Top + Y; Shape1.BoundsRect := Rect( NewLeft, NewTop, NewLeft + Shape1.Width, NewTop + Shape1.Height) end; end;

← →
KSergey © (2007-03-26 11:34) [9]

В реализации таких штучек всегда есть одна тонкость: пользователь может увести курсов мыши за пределы приложения и тама отпустить кнопку. Тогда OnMouseUp уже не приедет.
Тут нужно либо насильно ограничивать перемещение указателя мыши, лбо перехватив все события мыши на себя до прихода события отпускания кнопки мыши. (Ф-ций не подскажу, увы; нету под рукой)

← →
RASkov (2007-03-26 14:43) [10]

к [8]
procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Shape1.Left <= -Shape1.Width then Shape1.Left:=0; if Shape1.Left >= ClientWidth then Shape1.Left:=ClientWidth-Shape1.Width; if Shape1.Top <= -Shape1.Height then Shape1.Top:=0; if Shape1.Top >= ClientHeight then Shape1.Top:=ClientHeight-Shape1.Height; end;

> В реализации таких штучек всегда есть одна тонкость: пользователь
> может увести курсов мыши за пределы приложения и тама отпустить
> кнопку. Тогда OnMouseUp уже не приедет.

Вы - великий теоретик!

> [9] KSergey © (26.03.07 11:34)
> В реализации таких штучек всегда есть одна тонкость: пользователь
> может увести курсов мыши за пределы приложения и тама отпустить
> кнопку. Тогда OnMouseUp уже не приедет.

Приедет.

> Джо © (26.03.07 15:58) [12]
> > может увести курсов мыши за пределы приложения и тама
> отпустить кнопку. Тогда OnMouseUp уже не приедет.
>
> Приедет.

Хм, ну с голубыми спорить не буду, проверим :)

Или тут не упомянуты какие-то условия? Я имел в виду "не приедет в исходное окно". (А может я правда что путаю? ужасть...)

> Loginov Dmitry © (26.03.07 15:17) [11]
> Вы - великий теоретик!

Мдя, диагноз подтверждается... :(

TShape drag Найти похожие ветки