Drag n Drop

← →
Andy BitOff (2003-01-10 19:45) [0]

Подскажите как мне подвигать несколько определенных компонентов одновременно. Один я двигаю так:
ReleaseCapture;
компонент.Perform(WM_SysCommand, $F012, 0);

← →
Andy BitOff (2003-01-10 23:41) [1]

Неужели ни кто не знает!!!!!!!!!!

← →
Бандерлоги (2003-01-11 01:00) [2]

Абы как комп-ты на панель и её подвигать слабо.

← →
Rouse_ (2003-01-11 01:08) [3]

Ну а в чем проблема? Данный код в обработчик OnMouseMove нужных компонентов и всех их можно будет перемещать.

Желаю успехов

← →
Бандерлоги (2003-01-11 01:31) [4]

"Ни кто" пишется слитно... а... проблемы в самом деле нет.
> Too Rouse_ Однако:
Суть - OnMouseMove с флагом? Значительно проще Perform(WM_SysCommand, $F012, 0), ибо если Panel2.Parent := Panel1, тогда:
procedure TMainForm.Panel2MouseDown begin ReleaseCapture; Panel1.Perform(WM_SysCommand, $F012, 0); end;
И мы двигаем панель со всеми её элементами, которые (Andy BitOff) при необходимости, можно вставить в панель-родителя непосредственно в обработчике, ибо если.. тогда...

Желаем успехов солидарно с [rauz_]

← →
Rouse_ (2003-01-11 01:56) [5]

> Бандерлоги (11.01.03 01:31)
Я просто понял что нужно перемещать каждый компонент по отдельности, а не все в куче :)

Желаю успехов

← →
Andy BitOff (2003-01-11 16:35) [6]

К сожалению не все так легко. Усли бы это было так, я бы сюда и не написал. Дело в том, что на лету создается n-ное количество компонентов и должна быть возможность их подвигать. Один подвигать легко:
//ImageMouseDown
if (button=mbLeft) and (TControl(sender).ClassType=TImage)then begin
ReleaseCapture;
TControl(Sender).Parent.Perform(WM_SysCommand, $F012, 0);
end;
А вот если еще и нажат Shift, то надо двигать их все. Так вот здесь и проблема. Конструкция типа:
if ((ssShift in Shift) and (ssLEFT in Shift)) and (TControl(sender).ClassType=TImage) then begin
for i:=0 to ScrollBox.ControlCount-1 do begin
ReleaseCapture;
TControl(ScrollBox.Controls[i]).Perform(WM_SysCommand, $F012, 0);
end;
end;
Не работает!!!
Да, кстати, суть-то в следующем; на ScrollBox"е создается Panel на нее впихивается рисунок. Так вот, рисунок можно подвигать, и при этом надо иметь возможность подвигать их все, учитывая, конечно, их текущее положение.

← →
Andy BitOff (2003-01-11 19:29) [7]

Всплываем.

← →
Бандерлоги (2003-01-11 20:10) [8]

> Andy BitOff © (11.01.03 19:29)
> Всплываем.?

Нам непонятно, что ввиду, но мы бы в конце концов сделали так:

var MainForm: TMainForm; StartPt: TPoint; DxInt: Integer; DyInt: Integer; MutliDragFlag: boolean = false; implementation {$R *.dfm} procedure TMainForm.ContourControls; var R: TRect; DC: HDC; I: Integer; begin DC := GetDCEx(ScrollBox1.Handle, 0, DCX_CACHE); for I:=0 to ScrollBox1.ControlCount-1 do with TControl(ScrollBox1.Controls[I]) do begin R := BoundsRect; OffsetRect(R, DxInt, DyInt); Windows.DrawFocusRect(DC, R); end; ReleaseDC(HWND_DESKTOP, DC); end; procedure TMainForm.AnyImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if ((ssShift in Shift) and (ssLEFT in Shift)) and (TControl(sender).ClassType=TImage) then begin MutliDragFlag := True; DxInt := 0; DyInt := 0; ContourControls; StartPt := TControl(Sender).ClientToParent(Point(X, Y)); Exit; end; if (button=mbLeft) and (TControl(sender).ClassType=TImage)then begin ReleaseCapture; TControl(Sender).Parent.Perform(WM_SysCommand, $F012, 0); end; end; procedure TMainForm.AnyImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var CurPt: TPoint; begin if MutliDragFlag then begin CurPt := TControl(Sender).ClientToParent(Point(X, Y)); ContourControls; Inc(DxInt, CurPt.X - StartPt.X); Inc(DyInt, CurPt.Y - StartPt.Y); ContourControls; StartPt := CurPt; end; end; procedure TMainForm.AnyImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var I: integer; begin if MutliDragFlag then begin MutliDragFlag := False; for i:=0 to ScrollBox1.ControlCount-1 do with TControl(ScrollBox1.Controls[i]) do begin Left := Left + DxInt; Top := Top + DyInt; end; end; end;

Если есть предложения порациональней, плз.

← →
Andy BitOff (2003-01-11 21:03) [9]

(робко) я... я... конечно попробую... но... я и не думал... а как это работае??? 8-)

← →
Andy BitOff (2003-01-11 21:05) [10]

А всплываем, это - сегодня с утра эта ветвь была на третьей странице, вот я ее на верх и вывел.

← →
Бандерлоги (2003-01-11 21:12) [11]

Получилось? Хоть не ново, но это развитие идеи

> Rouse_ © (11.01.03 01:08)

А как это работае??? Там написано. Есть вопросы поконкретней - мы пока недалеко.

← →
Rouse_ (2003-01-11 21:19) [12]

← →
Бандерлоги (2003-01-11 21:24) [13]

← →
Andy BitOff (2003-01-11 22:39) [14]

Оформил. Все прекрасно работает, как раз то, что доктор прописал. Буду теперь разбираться. Но по первому просмотру такой вопрос: можно ли сделать так, чтобы перемещаемые компоненты перерисовывались в момент их таскания.

← →
Нежить (2003-01-11 22:56) [15]

> Andy BitOff © (11.01.03 22:39)

Можно. Но именно поэтому мы всё оформили именно так, как оформили.
Во-первых, при перетаскивании имиджа возникает мерцание изображения, особенно если оно крупное.
Во-вторых, Perform(... рисует фокусрект. Поэтому мы тоже рисуем фокусректы.
В-третьих, этот перформ - очень удобный метод, поскольку помимо того, что он позволяет перетащить компонент, он его ещё и BringToFront того этого, отказываться от него неохота.

Если очень хотса, можно вот этот код:

for i:=0 to ScrollBox1.ControlCount-1 do
with TControl(ScrollBox1.Controls[i]) do
begin
Left := Left + DxInt;
Top := Top + DyInt;
end;
убрать из AnyImageOnMouseUp и вставить после фразы:

Inc(DxInt, CurPt.X - StartPt.X);
Inc(DyInt, CurPt.Y - StartPt.Y);

и везде убрать ContourControls.

Но тогда следует отказаться от:
ReleaseCapture;
TControl(Sender).Parent.Perform(WM_SysCommand, $F012, 0);

И добавить пару строчек куда-нибудь.
Ибо всё будет выглядеть в этом случае вразнобой, т.е. по-уродски.

← →
Diamond Cat (2003-01-12 00:14) [16]

а вот еще идея правда не доведена до конца но...

implementation
var
re:Trect;
cross:Tpoint;
controler:hwnd;
{$R *.DFM}

function me(p:tpoint;wnd:hwnd):Tpoint;
begin
//вычисление абсолютных координат
clienttoscreen(getparent(wnd),p);
result:=p;
end;

procedure Tform1.Mes(var Msg: TMsg; var handleIn: Boolean);
var
d:tpoint;
begin
if msg.message=wm_rbuttondown then
begin
//вычисление координатов на передвигаемом компоненте
d:=me(msg.pt,msg.hwnd);
getwindowrect(msg.hwnd,re);
cross.x:=d.x-re.Left;
cross.y:=d.y-re.top;
controler:=msg.hwnd;
end;
//гдето тут вычислять координаты остальных нуждающихся в перетаскивании компонентов
if (msg.message=wm_mousemove) and (msg.wparam=MK_Rbutton ) then
begin
//Передвигание компонента
setwindowpos(controler,HWND_TOP,msg.pt.x-cross.x,msg.pt.y-cross.y,0,0,SWP_SHOWWINDOW or SWP_NOSIZE);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
application.OnMessage:=mes;
end;

Drag n Drop Найти похожие ветки