完整的代码如下:
————————————————————————————
unit nmDragEngine;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs;
type
EnmDragManagerError = class(Exception);
EnmDragManagerNowDragging = class(EnmDragManagerError);
TnmDragManagerDragMove = procedure( TargetControl: TControl; Accepted: Boolean; X, Y: Integer;
var ImageIndex: Integer; var Cursor: TCursor ) of Object;
TnmDragObj = class;
TnmDragManager = class(TComponent)
private
FDragImages: TImageList;
FDragObj: TnmDragObj;
FHotSpot: TPoint;
FOnDragMove: TnmDragManagerDragMove;
ImageIndex: Integer;
procedure Private_SetDisplayDragImage( obj: TWinControl );
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
destructor destroy; override;
function BeginDrag(AControl: TControl): TDragObject;
procedure RegisterAllcsDisplayImage( obj: TWinControl );
published
property DragImages: TImageList read FDragImages write FDragImages;
property HotSpotX: Integer read FHotSpot.x write FHotSpot.x;
property HotSpotY: Integer read FHotSpot.y write FHotSpot.y;
property OnDragMove: TnmDragManagerDragMove read FOnDragMove write FOnDragMove;
end;
TnmDragObj = class(TDragCOntrolObject)
private
Manager: TnmDragManager;
public
constructor Create( AControl: TControl; AManager: TnmDragManager );
function GetDragImages: TCustomImageList; override;
procedure HideDragImage; override;
procedure ShowDragImage; override;
function GetDragCursor( Accepted: Boolean; X, Y: Integer ): TCursor; override;
procedure Finished( Target: TObject; X, Y: Integer; Accepted: Boolean ); override;
end;
procedure Register;
implementation
destructor TnmDragManager.Destroy;
begin
if ( FDragObj <> Nil ) then FDragObj.Free;
inherited;
end;
function TnmDragManager.BeginDrag;
begin
if FDragObj <> Nil then
raise EnmDragManagerNowDragging.Create( 'TnmDragManager.GetDragObject: Under Dragging');
FDragObj := TnmDragObj.Create( AControl, Self );
if (FDragImages <> Nil) then
FDragImages.SetDragImage(ImageIndex, FHotSpot.x, FHotSpot.y);
Result := FDragObj;
end;
procedure TnmDragManager.Notification;
begin
if (Operation = opRemove) and (FDragImages = AComponent) then FDragImages := Nil;
end;
procedure TnmDragManager.Private_SetDisplayDragImage( obj: TWinControl );
var
i: Integer;
begin
obj.ControlStyle := obj.ControlStyle + [csDisplayDragImage];
for i:=0 to obj.ControlCount-1 do begin
if ( obj.Controls is TWinControl ) then Private_SetDisplayDragImage( obj.Controls as TWinControl )
else obj.Controls.ControlStyle := obj.Controls.ControlStyle + [csDisplayDragImage];
end;
end;
procedure TnmDragManager.RegisterAllcsDisplayImage( obj: TWinControl );
begin
Private_SetDisplayDragImage( obj );
end;
constructor TnmDragObj.Create;
begin
inherited Create(AControl);
Manager := AManager;
end;
function TnmDragObj.GetDragImages;
begin
Result := Manager.FDragImages;
end;
procedure TnmDragObj.HideDragImage;
begin GetDragImages.HideDragImage; end;
procedure TnmDragObj.ShowDragImage;
begin GetDragImages.ShowDragImage; end;
function TnmDragObj.GetDragCursor;
var
ImageIndex: Integer;
Cursor: TCursor;
Images: TCustomImageList;
ctl: TControl;
begin
ImageIndex := Manager.ImageIndex;
if Accepted then Cursor := crDrag
else Cursor := crNoDrop;
if Assigned( Manager.OnDragMove ) then begin
ctl := FindDragTarget( Point(X,Y), False );
Manager.OnDragMove( ctl, Accepted, X, Y, ImageIndex, Cursor );
end;
if Manager.ImageIndex <> ImageIndex then begin
Images := GetDragImages;
if Images <> Nil then begin
Images.EndDrag;
Images.SetDragImage( ImageIndex, Manager.FHotSpot.X, Manager.FHotSpot.Y );
Images.BeginDrag( GetDesktopWIndow, X, Y );
end;
Manager.ImageIndex := ImageIndex;
end;
Result := Cursor;
end;
procedure TnmDragObj.Finished;
begin
try
inherited;
finally
Manager.FDragObj := Nil;
Free;
end;
end;
procedure Register;
begin
RegisterComponents('NM Vcl', [TnmDragManager]);
end;
end.