Перетащите изменение изображения при перетаскивании по сетке

Question

Я создаю экземпляр моего собственного DragObject в StartDrag:

procedure TForm1.GridStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  DragObject := TMyDragControlObject.Create(Sender as TcxGridSite);
end;

В последнее время в другой сетке в DragOver:

procedure TForm1.SecondGridDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := False;
  if Source is TMyDragControlObject then
    with TMyDragControlObject(Source) do
      // using TcxGrid
      if (Control is TcxGridSite) or (Control is TcxGrid) then begin
          Accept := True            

          // checking the record value on grid
          // the label of drag cursor will be different
          // getting the record value works fine!
          if RecordOnGrid.Value > 5 then
            DragOverPaint(FImageList, 'You can drop here!');
          else begin
            Accept := false;
            DragOverPaint(FImageList, 'You can''t drop here!');
          end 
      end;
end;

Моя процедура DragOverPaint:

procedure TForm1.DragOverPaint(ImageList: TImageList; AValue: string);
var ABmp: TBitmap;
begin
  if not Assigned(ImageList) then Exit;

  ABmp := TBitmap.Create();
  try
    with ABmp.Canvas do begin
      ABmp.Width  := TextWidth(AValue);
      ABmp.Height := TextHeight(AValue);
      TextOut(0, 0, AValue);
    end;

    ImageList.BeginUpdate;
    ImageList.Clear;
    ImageList.Width  := ABmp.Width;
    ImageList.Height := ABmp.Height;
    ImageList.AddMasked(ABmp, clNone);
    ImageList.EndUpdate;
  finally
    ABmp.Free();
  end;

  Repaint;
end;

Я хочу перерисовать DragImageList в зависимости от значения записи сетки, но список изображений не обновляется, когда он уже нарисован.

Answer 1

Как только ImageList начал перетаскивать, вы не можете изменить изображение перетаскивания, изменив ImageList, потому что Windows создает другой временно смешанный ImageList специально для перетаскивания.Таким образом, вы должны завершить, изменить и снова запустить перетаскивание ImageList (это не равно завершению и запуску полной операции перетаскивания VCL, только WinAPI ImageList).Результатом / недостатком является легкое дрожание при переходе изображений.

Момент изменения изображений наступает, когда изменяется Accepted (в данном конкретном случае).С этим можно справиться в OnDragOver, но поскольку вы уже создаете собственный DragObject, вы также можете переопределить разработанные для него методы TDragObject:

type
  TControlAccess = class(TControl);

  TMyDragControlObject = class(TDragControlObjectEx)
  private
    FDragImages: TDragImageList;
    FPrevAccepted: Boolean;
  protected
    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
    function GetDragImages: TDragImageList; override;
  public
    destructor Destroy; override;
  end;

{ TMyDragControlObject }

destructor TMyDragControlObject.Destroy;
begin
  FDragImages.Free;
  inherited Destroy;
end;

function TMyDragControlObject.GetDragCursor(Accepted: Boolean; X,
  Y: Integer): TCursor;
begin
  if FPrevAccepted <> Accepted then
    with FDragImages do
    begin
      EndDrag;
      SetDragImage(Ord(Accepted), 0, 0);
      BeginDrag(GetDesktopWindow, X, Y);
    end;
  FPrevAccepted := Accepted;
  Result := inherited GetDragCursor(Accepted, X, Y);
end;

function TMyDragControlObject.GetDragImages: TDragImageList;
const
  SNoDrop = 'You can''t drop here!!';
  SDrop = 'You can drop here.';
  Margin = 20;
var
  Bmp: TBitmap;
begin
  if FDragImages = nil then
  begin
    FDragImages := TDragImageList.Create(nil);
    Bmp := TBitmap.Create;
    try
      Bmp.Canvas.Font.Assign(TControlAccess(Control).Font);
      Bmp.Width := Bmp.Canvas.TextWidth(SNoDrop) + Margin;
      Bmp.Height := Bmp.Canvas.TextHeight(SNoDrop);
      Bmp.Canvas.TextOut(Margin, 0, SNoDrop);
      FDragImages.Width := Bmp.Width;
      FDragImages.Height := Bmp.Height;
      FDragImages.Add(Bmp, nil);
      Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
      Bmp.Canvas.TextOut(Margin, 0, SDrop);
      FDragImages.Add(Bmp, nil);
      FDragImages.SetDragImage(0, 0, 0);
    finally
      Bmp.Free;
    end;
  end;
  Result := FDragImages;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Grid1.ControlStyle := Grid1.ControlStyle + [csDisplayDragImage];
  Grid2.ControlStyle := Grid2.ControlStyle + [csDisplayDragImage];
end;

procedure TForm1.Grid1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
  DragObject := TMyDragControlObject.Create(Sender as TStringGrid);
end;

procedure TForm1.Grid2DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := False;
  if IsDragObject(Source) then
    with TMyDragControlObject(Source) do
      if Control is TGrid then
        { Just some condition for testing }
        if Y > Control.Height div 2 then
          Accept := True;
end;

Answer 2

Как указывалось в NGLN , причина того, что изменение не вступает в силу, заключается в том, что Windows создает временный список изображений при перетаскивании.Как немного другое решение, вы можете напрямую изменить изображение в этом временном списке.

Ниже приведено изменение DragOverPaint соответственно.Обратите внимание, что вы все равно должны использовать какой-то флаг, чтобы не заполнять список при каждом движении мыши, как в ответе NGLN.

procedure TForm1.DragOverPaint(ImageList: TImageList; AValue: string);
var 
  ABmp: TBitmap;

  ImgList: HIMAGELIST;    // <- will get the temporary image list
begin
  if not Assigned(ImageList) then Exit;

  ABmp := TBitmap.Create();
  try
    with ABmp.Canvas do begin
      ABmp.Width  := TextWidth(AValue);
      ABmp.Height := TextHeight(AValue);
      TextOut(0, 0, AValue);
    end;

//    ImageList.BeginUpdate;        // do not fiddle with the image list,
//    ImageList.Clear;              // it's not used while dragging
//    ImageList.Width  := ABmp.Width;
//    ImageList.Height := ABmp.Height;
//    ImageList.AddMasked(ABmp, clNone);
//    ImageList.EndUpdate;

    // get the temporary image list
    ImgList := ImageList_GetDragImage(nil, nil);
    // set the dimensions for images and empty the list
    ImageList_SetIconSize(ImgList, ABmp.Width, ABmp.Height);
    // add the text as the first image
    ImageList_AddMasked(ImgList, ABmp.Handle, ColorToRGB(clWhite));

  finally
    ABmp.Free();
  end;

//  Repaint;   // <- No need to repaint the form
end;