Delphi Drag изображений вызов - PullRequest
Новая
       28

Delphi Drag изображений вызов

1 голос
/ 19 марта 2009

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

Моя проблема в том, что я не хочу показать перетаскиваемое изображение мгновенно, когда начинается перетаскивание, я хочу, чтобы изображение отображалось , когда мышь находится на определенных границах контроль - например в правой половине этикетки.

До сих пор я не смог найти решение для этого - изображение просто отображается мгновенно (если я не изменю источник 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 ]

1 голос
/ 10 сентября 2009

Сделать TBitmap с именем b глобальной переменной и удалить строку

ImageList1.Add (b, nil);

из процедуры Label1StartDrag и поместите ее в OnDragOverProcedure. Это позволит ImageList1 оставаться пустым, пока мышь не переместит четыре пикселя, указанных в

Label1.BeginDrag (False, 4);

0 голосов
/ 06 апреля 2009

Поскольку молчание по теме подразумевает, я полагаю, что то, что я хочу, немного превосходит стандартные утилиты перетаскивания 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;
0 голосов
/ 19 марта 2009

Label1.DragMode: = dmAutomatic;

Вы пытались использовать dmManual? Вы должны написать еще немного кода, но вы можете изменить больше процесса.

Кстати, а почему вы хотите изменить стандартное поведение? Ваши пользователи, вероятно, ожидают стандарт и могут расстроиться, если программа будет вести себя по-другому.

...