Форум: "Основная";
Текущий архив: 2003.09.18;
Скачать: [xml.tar.bz2];

Вниз

DragDrop Pro   Найти похожие ветки 

← →
Alibaba   (2003-08-28 03:03) [0]

Всем привет.

У меня есть прога, где lbTasks: TListBox содержит некоторые елементы.
Используя DragOver, DragDrop я предоставляю возможность изменять порядок елементов в списке.

Функции DragOver, DragDrop реализованы простейшим образом.
Использовались Delphi-примеры.

Как известно, аппетит приходит во время еды.
Вот и меня не минула сия участь (ко мне пришел аппетит :) ).
Я хочу пойти дальше и сделать процесс перетаскивания елементов в списке более профессиональным.
Как, например, перетаскиваются Favorites в IE или Bookmarks в Opera.

Что отличает продвинутый подход от елементарного:
1. Курсор - это картинка содержащая название елемента списка.
2. Когда двигаемся над списком (перетаскивая елемент), появляется линия между елементами списка, куда, предположительно, можно разместить елемент, который перетаскиваем.

Вот эти две особенности я и хотел бы реализовать.
Порекомендуйте, пожалуйста, как это сделать.

---

← →
Alibaba   (2003-09-02 17:36) [1]

Народ, я решил задачу №1
1. Курсор - это картинка содержащая название елемента списка.

Сейчас бьюсь над задачей №2
2. Когда двигаемся над списком (перетаскивая елемент), появляется линия между елементами списка, куда, предположительно, можно разместить елемент, который перетаскиваем.

Если у кого-то есть идеи - поделитесь.

---

← →
Ык   (2003-09-02 20:35) [2]

Черпай, если че найдешь:)
type
TImgDragObject = class(TDragObjectEx)
private
FControl: TControl;
FImage: TDragImageList;
function GetControlAtMousePos: TControl;
protected
procedure WndProc(var Msg: TMessage); override;
function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
function GetDragImages: TDragImageList; override;
public
constructor Create(AControl: TControl);
destructor Destroy; override;
property Control: TControl read FControl;
property DragImage: TDragImageList read FImage;
procedure HideDragImage; override;
procedure ShowDragImage; override;
end;

TLBDragObject = class(TImgDragObject)
private
FInd, FSelInd, FOldSel: integer;
protected
procedure DrawRect(X, Y: integer);
public
constructor Create(AControl: TListBox;
Index: Integer; AsImage: boolean = false);
destructor Destroy; override;
procedure MoveDropped(X, Y: integer);
end;

{ TImgDragObject }

constructor TImgDragObject.Create(AControl: TControl);
begin
FControl:=AControl;
FImage:=TDragImageList.Create(nil);
end;

destructor TImgDragObject.Destroy;
begin
FImage.Free;
inherited;
end;

function TImgDragObject.GetControlAtMousePos: TControl;
var
P: TPoint;
Wnd: HWND;
WinControl: TWinControl;
begin
Result:=nil;
GetCursorPos(P);
Wnd:=WindowFromPoint(P);
if Wnd <> 0 then
begin
WinControl:=FindControl(Wnd);
if WinControl <> nil then
begin
P:=WinControl.ScreenToClient(P);
Result:=WinControl.ControlAtPos(P, true, false);
if Result = nil then Result:=WinControl;
end;
end;
end;

type
TXControl = class(TControl);

function TImgDragObject.GetDragCursor(Accepted: Boolean; X,
Y: Integer): TCursor;
begin
if Accepted then Result:=TXControl(FControl).DragCursor
else Result:=crNoDrop;
end;

function TImgDragObject.GetDragImages: TDragImageList;
begin
Result:=FImage;
end;

procedure TImgDragObject.HideDragImage;
begin
if FImage <> nil then FImage.HideDragImage;
end;

procedure TImgDragObject.ShowDragImage;
begin
if FImage <> nil then FImage.ShowDragImage;
end;

procedure TImgDragObject.WndProc(var Msg: TMessage);
var
Control: TControl;
Stl: TControlStyle;
begin
if Msg.Msg = WM_MOUSEMOVE then
begin
Control:=GetControlAtMousePos;
try
if Control <> nil then
begin
Stl:=Control.ControlStyle;
Control.ControlStyle:=Stl + [csDisplayDragImage];
end;
inherited;
finally
if Control <> nil then Control.ControlStyle:=Stl;
end;
end else
inherited;
end;

{ TLBDragObject }

constructor TLBDragObject.Create(AControl: TListBox;
Index: Integer; AsImage: boolean = false);
var
Bmp: TBitmap;
R: TRect;
begin
inherited Create(AControl);
FInd:=Index;
FSelInd:=Index;
FOldSel:=-1;
if AsImage then
begin
Bmp:=TBitmap.Create;
with Bmp, Canvas do
try
R:=AControl.ItemRect(Index);
Width:=R.Right - R.Left + 1;
Height:=R.Bottom - R.Top + 1;
TextOut(2, 2, AControl.Items[Index]);
DrawFocusRect(Rect(0, 0, Width, Height));
DragImage.Width:=Width;
DragImage.Height:=Height;
DragImage.Add(Bmp, nil);
DragImage.SetDragImage(0, 2, Height-2);
DragImage.DragCursor:=crDrag;
finally
Bmp.Destroy;
end;
end;
end;

destructor TLBDragObject.Destroy;
begin
if Control <> nil then with TListBox(Control) do
begin
if FOldSel > -1 then
Canvas.DrawFocusRect(ItemRect(FOldSel));
ItemIndex:=FSelInd;
Invalidate;
end;
inherited;
end;

procedure TLBDragObject.DrawRect(X, Y: integer);
var
n: integer;
begin
if DragImage <> nil then Exit;
with TListBox(Control) do
begin
n:=ItemAtPos(Point(x,y), false);
if n >= Items.Count then n:=Pred(Items.Count);
if n = FOldSel then Exit;
if FOldSel > -1 then Canvas.DrawFocusRect(ItemRect(FOldSel));
FOldSel:=-1;
if n > -1 then Canvas.DrawFocusRect(ItemRect(n));
FOldSel:=n;
end;
end;

procedure TLBDragObject.MoveDropped(X, Y: integer);
var
n: integer;
begin
with TListBox(Control) do
begin
n:=ItemAtPos(Point(X, Y), false);
if n >= Items.Count then n:=Pred(Items.Count)
else if n < 0 then n:=0;
Items.Move(FInd, n);
FSelInd:=n;
end;
end;

А так типа использовать:
procedure TForm1.ListBox1StartDrag(Sender: TObject;
var DragObject: TDragObject);
begin
DragObject:=TLBDragObject.Create(ListBox1, ListBox1.ItemIndex, true);
end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
TLBDragObject(Source).MoveDropped(X, Y);
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept:=Source is TLBDragObject;
if Accept then TLBDragObject(Source).DrawRect(X, Y);
end;


---

← →
Ык   (2003-09-02 21:06) [3]

Ну как водится забыл поправить, осел:)
constructor TImgDragObject.Create(AControl: TControl; DragImage: TDragImageList);
begin
FControl:=AControl;
FImage:=DragImage;
end;

constructor TLBDragObject.Create(AControl: TListBox;
Index: Integer; AsImage: boolean = false);
var
Bmp: TBitmap;
R: TRect;
begin
if AsImage then inherited Create(AControl, TDragImageList.Create(nil))
else inherited Create(AControl, nil);
FInd:=Index;
FSelInd:=Index;
...

---

← →
Alibaba   (2003-09-08 12:54) [4]

На такое даже смотреть страшно... :)

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.09.18;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.008 c