Задача Delphi по перетаскиванию изображений
-
20-08-2019 - |
Вопрос
Код ниже позволяет элементу управления (например, метке) отображать изображения перетаскивания во время операции перетаскивания.
Моя проблема в том, что я делаю нет хочу, чтобы изображение перетаскивания отображалось сразу же, когда начинается перетаскивание, я хочу, чтобы изображение отображалось когда мышь находится на определенных границах элемента управления, например.в правой половине этикетки.
До сих пор мне не удалось найти решение этой проблемы — изображение просто отображается мгновенно (если я не изменю источник VCL).На этом этапе я ценю любые уловки, позволяющие добиться желаемого поведения, прежде чем отказываться от утилит перетаскивания VCL и использовать специальную утилиту, захватывающую мышь.
Вот пример псевдокода, позволяющий перетаскивать изображения для метки.
{ turn on dragging }
Label1.DragMode := dmManual;
Label1.ControlStyle := Label1.ControlStyle + [csDisplayDragImage];
type
// VCL needs this for getting drag images..
TMyDragObject = class(TDragControlObject)
protected
function GetDragImages: TDragImageList; override;
end;
function TMyDragObject.GetDragImages: TDragImageList;
begin
Result := Form1.ImageList1;
end;
procedure TForm1.Label1MouseDown(...);
begin
{ start the dragging manually }
Label1.BeginDrag(False, 4); // the problem area! image is shown instantly at here!
end;
procedure TForm1.Label1StartDrag(Sender: TObject; var DragObject: TDragObject);
var b : TBitmap;
begin
ImageList1.Clear;
DragObject := TMyDragObject.Create(self);
b := TBitmap.Create;
try
b.Width := ImageList1.Width;
b.Height := ImageList1.Height;
b.LoadFromFile('/path/to/image');
ImageList1.Add(b, nil);
finally
b.Free;
end;
end;
procedure TForm1.Label1MouseMove(...);
begin
if X > Label1.Width div 2 then // right half
// ??? - do show the drag image
else
// ??? - no drage image should be shown
end;
Решение 3
Поскольку молчание по этой теме подразумевает, я полагаю, что я хочу немного переборщить со стандартными утилитами перетаскивания VCL.
В любом случае, чтобы получить желаемый эффект, то есть иметь больший контроль над операцией перетаскивания, есть способ, который предполагает захват мыши и обработку сообщений вручную:
SetCapture(Handle);
try
while GetCapture = Handle do
{ Process messages like mouse move, click, etc..
ie. Change the drag image when the control under cursor changes.. }
finally
if Handle = GetCapture then
ReleaseCapture;
end;
Другие советы
Сделайте TBitmap с именем b глобальной переменной и удалите строку
ImageList1.Add(б, ноль);
из процедуры Label1StartDrag и поместите его в OnDragOverProcedure.Это позволит ImageList1 оставаться пустым до тех пор, пока мышь не переместит четыре пикселя, указанные в
Label1.BeginDrag(False, 4);
Label1.DragMode := dmAutomatic;
Вы пробовали использовать dmManual?Вам следует написать еще немного кода, но вы можете изменить большую часть процесса.
Кстати, а почему вы хотите изменить стандартное поведение?Ваши пользователи, вероятно, ожидают стандарта и могут расстроиться, если программа будет вести себя иначе.