Files
HeidiSQL/components/virtualtreeview/Source/VirtualTrees.DragImage.pas

140 lines
5.1 KiB
ObjectPascal

unit VirtualTrees.DragImage;
interface
uses
WinApi.Windows,
WinApi.ActiveX,
System.Types,
Vcl.Controls,
Vcl.Graphics;
{$MINENUMSIZE 1, make enumerations as small as possible}
type
// Drag image support for the tree.
TVTTransparency = 0 .. 255;
// Simple move limitation for the drag image.
TVTDragMoveRestriction = (
dmrNone,
dmrHorizontalOnly,
dmrVerticalOnly
);
TVTDragImageStates = set of (
disHidden, // Internal drag image is currently hidden (always hidden if drag image helper interfaces are used).
disInDrag, // Drag image class is currently being used.
disPrepared // Drag image class is prepared.
);
// Class to manage header and tree drag image during a drag'n drop operation.
TVTDragImage = class
private
FOwner : TCustomControl;
FBackImage, // backup of overwritten screen area
FAlphaImage, // target for alpha blending
FDragImage : TBitmap; // the actual drag image to blend to screen
FRestriction : TVTDragMoveRestriction; // determines in which directions the drag image can be moved
FColorKey : TColor; // color to make fully transparent regardless of any other setting
FStates : TVTDragImageStates; // Determines the states of the drag image class.
public
constructor Create(AOwner : TCustomControl);
destructor Destroy; override;
procedure EndDrag;
procedure PrepareDrag(DragImage : TBitmap; HotSpot : TPoint; const DataObject: IDataObject; pColorKey: TColor = clWindow);
property MoveRestriction : TVTDragMoveRestriction read FRestriction write FRestriction default dmrNone;
end;
implementation
uses
WinApi.ShlObj,
WinApi.Messages,
System.SysUtils,
System.Math,
VirtualTrees.DragnDrop,
VirtualTrees.Types,
VirtualTrees.Utils,
VirtualTrees.BaseTree;
//----------------- TVTDragImage ---------------------------------------------------------------------------------------
constructor TVTDragImage.Create(AOwner : TCustomControl);
begin
FOwner := AOwner;
FRestriction := dmrNone;
FColorKey := clNone;
end;
//----------------------------------------------------------------------------------------------------------------------
destructor TVTDragImage.Destroy;
begin
EndDrag;
inherited;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTDragImage.EndDrag;
begin
FStates := FStates - [disInDrag, disPrepared];
FBackImage.Free;
FBackImage := nil;
FDragImage.Free;
FDragImage := nil;
FAlphaImage.Free;
FAlphaImage := nil;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTDragImage.PrepareDrag(DragImage : TBitmap; HotSpot : TPoint; const DataObject : IDataObject; pColorKey: TColor = clWindow);
// Creates all necessary structures to do alpha blended dragging using the given image.
// ImagePostion and HotSpot are given in screen coordinates. The first determines where to place the drag image while
// the second is the initial mouse position.
// This method also determines whether the system supports drag images natively. If so then only minimal structures
// are created.
var
Width, Height : Integer;
DragSourceHelper : IDragSourceHelper;
DragInfo : TSHDragImage;
lDragSourceHelper2 : IDragSourceHelper2; // Needed to get Windows Vista+ style drag hints.
lNullPoint : TPoint;
begin
Width := DragImage.Width;
Height := DragImage.Height;
FColorKey := pColorKey;
// Determine whether the system supports the drag helper interfaces.
if Assigned(DataObject) and Succeeded(CoCreateInstance(CLSID_DragDropHelper, nil, CLSCTX_INPROC_SERVER, IDragSourceHelper, DragSourceHelper)) then
begin
lNullPoint := Point(0, 0);
if Supports(DragSourceHelper, IDragSourceHelper2, lDragSourceHelper2) then
lDragSourceHelper2.SetFlags(DSH_ALLOWDROPDESCRIPTIONTEXT); // Show description texts
// First let the system try to initialze the DragSourceHelper, this works fine for file system objects (CF_HDROP)
StandardOLEFormat.cfFormat := CF_HDROP;
if not Succeeded(DataObject.QueryGetData(StandardOLEFormat)) or not Succeeded(DragSourceHelper.InitializeFromWindow(0, lNullPoint, DataObject)) then
begin
// Supply the drag source helper with our drag image.
DragInfo.sizeDragImage.cx := Width;
DragInfo.sizeDragImage.cy := Height;
DragInfo.ptOffset := HotSpot;
DragInfo.hbmpDragImage := CopyImage(DragImage.Handle, IMAGE_BITMAP, Width, Height, LR_COPYRETURNORG);
DragInfo.crColorKey := ColorToRGB(FColorKey);
if not Succeeded(DragSourceHelper.InitializeFromBitmap(@DragInfo, DataObject)) then
begin
DeleteObject(DragInfo.hbmpDragImage);
end;
end;
end;
end;
end.