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

Question

我已经实现了自定义拖动图像，没有任何问题。

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

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

有没有办法改变dragobject的这种行为？

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，但捕获软件使用默认光标。）

如果您想查看系统对图片的真实作用，请更改上述{​​{1}}来电以保护热点，例如

ImageList_SetDragCursorImage

现在，您可以同时看到半透明和不透明的图像。