Question

我正在StartDrag上创建自定义DragObject的实例：

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）。结果/缺点是图像转换时略微颤动。

更改图像的时刻是“已接受”更改（在此特定情况下）。可以在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 pointed out，更改未生效的原因是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;

拖动网格时拖动图像更改

2 个答案: