Drag image change while drag over grid

Question

I'm creating an instance of my custom DragObject on StartDrag:

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

Lately on another grid on 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;

My DragOverPaint procedure:

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;

I want it to repaint DragImageList depending on the grid record value, but the image list doesn't refresh when it's already painted.

Answer 1

Once the ImageList has started dragging, you cannot change the drag image by changing the ImageList because Windows creates another temporarily blended ImageList specially for the dragging. So you have to end, change and start the ImageList dragging again (this is not equal to ending and starting the complete VCL dragging operation, just the WinAPI ImageList). The result/downside is a slight quiver at the transition of the images.

The moment of changing the images is when Accepted changes (in this specific case). It is possible to deal with this in OnDragOver, but since you create an own DragObject already, you can also override the therefor designed methods of 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;