Drag image change while drag over grid

问题

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.

回答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;

回答2:

As NGLN pointed out, the reason for the change not taking effect is that Windows creates a temporary image list while dragging. As a slightly different solution, you can directly change the image in this temporary list.

The below is the modified DragOverPaint accordingly. Note that you should still make use of some kind of a flag for not repopulating the list with every mouse move as in NGLN's answer.

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;

来源：https://stackoverflow.com/questions/6611522/drag-image-change-while-drag-over-grid