在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,但捕获软件使用的是默认光标.)

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

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

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