delphi - 在 Delphi 中使自定义拖动图像不透明

Question

我已经毫无问题地实现了自定义拖动图像。

我从TDragControlObject继承了一个类并覆盖了它的GetDragImages函数并将位图添加到TDragImageList，使白色像素透明。

它可以工作，白色像素是不可见的（透明的），但剩余的位图不是不透明的。

有没有办法改变拖动对象的这种行为？

Answer 1

您可以使用ImageList_SetDragCursorImage. 这通常用于提供拖动图像与光标图像的合并图像，然后通常隐藏真实光标以防止混淆（显示两个光标）。

系统不会像拖动图像那样将光标图像与背景混合。因此，如果您提供与光标图像相同的拖动图像，在相同的偏移量处，并且不隐藏实际的光标，您最终会得到一个带有光标的不透明拖动图像。（类似地，可以使用一个空的拖动图像，但我发现前一种设计更容易实现。）

下面的示例代码 (XE2) 使用 W7x64 并在带有 XP 的 VM 中进行了测试。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2StartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure Button2EndDrag(Sender, Target: TObject; X, Y: Integer);
  private
    FDragObject: TDragObject;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  commctrl;

{$R *.dfm}

type
  TMyDragObject = class(TDragObjectEx)
  private
    FDragImages: TDragImageList;
    FImageControl: TWinControl;
  protected
    function GetDragImages: TDragImageList; override;
  public
    constructor Create(ImageControl: TWinControl);
    destructor Destroy; override;
  end;

constructor TMyDragObject.Create(ImageControl: TWinControl);
begin
  inherited Create;
  FImageControl := ImageControl;
end;

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

function TMyDragObject.GetDragImages: TDragImageList;
var
  Bmp: TBitmap;
  Pt: TPoint;
begin
  if not Assigned(FDragImages) then begin
    Bmp := TBitmap.Create;
    try
      Bmp.PixelFormat := pf32bit;
      Bmp.Canvas.Brush.Color := clFuchsia;

      // 2px margin at each side just to show image can have transparency.
      Bmp.Width := FImageControl.Width + 4;
      Bmp.Height := FImageControl.Height + 4;
      Bmp.Canvas.Lock;
      FImageControl.PaintTo(Bmp.Canvas.Handle, 2, 2);
      Bmp.Canvas.Unlock;

      FDragImages := TDragImageList.Create(nil);
      FDragImages.Width := Bmp.Width;
      FDragImages.Height := Bmp.Height;
      Pt := Mouse.CursorPos;
      MapWindowPoints(HWND_DESKTOP, FImageControl.Handle, Pt, 1);
      FDragImages.DragHotspot := Pt;
      FDragImages.Masked := True;
      FDragImages.AddMasked(Bmp, clFuchsia);
    finally
      Bmp.Free;
    end;
  end;
  Result := FDragImages;
end;

//--

procedure TForm1.Button2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  (Sender as TWinControl).BeginDrag(False);

  // OnStartDrag is called during the above call so FDragImages is
  // assigned now.
  // The below is the only difference with a normal drag image implementation.
  ImageList_SetDragCursorImage(
      (FDragObject as TMyDragObject).GetDragImages.Handle, 0, 0, 0);
end;

procedure TForm1.Button2StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
  DragObject := TMyDragObject.Create(Sender as TWinControl);
  DragObject.AlwaysShowDragImages := True;
  FDragObject := DragObject;
end;

end.

上述代码的屏幕截图：

（请注意，实际光标是 crNoDrop，但捕获软件使用的是默认光标。）

如果您想查看系统对图像的真正作用，请更改上述ImageList_SetDragCursorImage调用以提供热点，例如

ImageList_SetDragCursorImage(
    (FDragObject as TMyDragObject).GetDragImages.Handle, 0, 15, 15);
// ShowCursor(False); // optional

现在您将能够同时看到半透明和不透明的图像。