Making a custom drag image opaque in Delphi

Question

I've implemented custom drag images with no problem.

I inherite a class from TDragControlObject and override its GetDragImages function and add bitmap to TDragImageList, making the white pixels transparent.

It works, white pixels are invisible (transparent) but the remaining bitmap is not opaque.

Is there a way to change this behavior of dragobject?

Answer 1

You can use ImageList_SetDragCursorImage. This is normally used to provide a merged image of the drag image with a cursor image, and then, normally, you hide the real cursor to prevent confusion (showing two cursors).

The system does not blend the cursor image with the background as it does with the drag image. So, if you provide the same drag image as the cursor image, at the same offset, and do not hide the actual cursor, you'll end up with an opaque drag image with a cursor. (Similarly, an empty drag image could be used but I find the former design easier to implement.)

The below sample code (XE2) is tested with W7x64 and in a VM with XP.

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.

Screen shot for above code:

(Note that the actual cursor was crNoDrop but the capture software used the default one.)

If you want to see what the system really does with the images, change the above ImageList_SetDragCursorImage call to proide a hot spot, e.g.

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

now you'll be able to see both the semi-transparent and opaque images at the same time.