Making a custom drag image opaque in Delphi - 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.