RealICQClient/Includes/DragDropHelper/DragDropHelper.pas

{*****************************************************************************
  Name           : DragDropHelper
  Author         : Perevoznyk Serhiy
  Description    : Drag & Drop Helper component provides an images that are
                 : displayed during drag and drop operations
  History        :

  Date         By                   Description
  ----         --                   -----------
  30-07-2004      Perevoznyk Serhiy     Initial creation of the Unit.
 *****************************************************************************}

unit DragDropHelper;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TInternalDragImageObject = class(TBaseDragControlObject)
  protected
    FHelper : TComponent;
    FImageList: TDragImageList;
    FBitmap : TBitmap;
    FMaskColor: TColor;
    function GetDragImages: TDragImageList; override;
    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
    procedure SetBitmap(ABitmap: TBitmap);
  public
    constructor Create(AControl: TControl); override;
    destructor  Destroy; override;
    property    Bitmap: TBitmap read FBitmap write SetBitmap;
    property    MaskColor: TColor read FMaskColor write FMaskColor;
    end;

  TOnGetDragImage = procedure(Sender : TObject; AControl : TControl; ABitmap : TBitmap) of object;
  TOnGetHotSpot = procedure(Sender : TObject; var X : integer; var Y : integer) of object;
  TOnGetDragCursor = procedure(Sender : TObject; Accepted : boolean; X, Y : integer; var ACursor : TCursor) of object;

  TDragDropHelper = class(TComponent)
  private
    FOnGetDragImage : TOnGetDragImage;
    FDragObject : TInternalDragImageObject;
    FMaskColor : TColor;
    FBitmap : TBitmap;
    FOnGetHotSpot : TOnGetHotSpot;
    FOnGetDragCursor : TOnGetDragCursor;
    procedure SetBitmap(const Value: TBitmap);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    function GetDragObject(AControl : TControl) : TDragObject;
  published
    property OnGetDragImage : TOnGetDragImage read FOnGetDragImage write FOnGetDragImage;
    property MaskColor : TColor read FMaskColor write FMaskColor default clFuchsia;
    property Bitmap : TBitmap read FBitmap write SetBitmap;
    property OnGetHotSpot : TOnGetHotSpot read FOnGetHotSpot write FOnGetHotSpot;
    property OnGetDragCursor : TOnGetDragCursor read FOnGetDragCursor write FOnGetDragCursor;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional', [TDragDropHelper]);
end;



constructor TInternalDragImageObject.Create(AControl: TControl);
begin
  inherited Create(AControl);
  FBitmap:=nil;
  FImageList:=TDragImageList.CreateSize(10, 10);
  FMaskColor:= clFuchsia;
end;

procedure TInternalDragImageObject.SetBitmap(ABitmap: TBitmap);
var
  XBitMap: TBitMap;
  X, Y : integer;
begin
  X := 0;
  Y := 0;
  FImageList.Clear;
  if Assigned(ABitmap) then
  begin
    FBitmap:=ABitmap;
    XBitMap:=TBitMap.Create;
    try
      XBitMap.Width:= ABitmap.Width;
      XBitMap.Height:=ABitmap.Height;
      XBitMap.Canvas.Draw(0, 0, ABitmap);
      FImageList.Width:= XBitMap.Width;
      FImageList.Height:=XBitMap.Height;
      FImageList.AddMasked(XBitMap, FMaskColor);
      if Assigned(FHelper) then
       begin
         if Assigned(TDragDropHelper(FHelper).OnGetHotSpot) then
          begin
           TDragDropHelper(FHelper).OnGetHotSpot(Self, X, Y);
           FImageList.SetDragImage(0, X, Y);
          end;
       end;
    finally
      XBitMap.Free;
      end;
    end;
end;

destructor TInternalDragImageObject.Destroy;
begin
  FImageList.Free;
  FImageList:=nil;
  inherited;
end;

function TInternalDragImageObject.GetDragImages: TDragImageList;
begin
  Result:=FImageList;
end;

function TInternalDragImageObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor;
begin
  Result:=inherited GetDragCursor(Accepted, X, Y);
  if Assigned(TDragDropHelper(FHelper).FOnGetDragCursor) then
   TDragDropHelper(FHelper).FOnGetDragCursor(Self, Accepted, X, Y, Result);
  if Assigned(DragTarget) and not (csDisplayDragImage in TControl(DragTarget).ControlStyle) then
    TControl(DragTarget).ControlStyle:= TControl(DragTarget).ControlStyle + [csDisplayDragImage];
end;



{ TDragDropHelper }

constructor TDragDropHelper.Create(AOwner: TComponent);
begin
  inherited;
  FDragObject := nil;
  FMaskColor := clFuchsia;
  FBitmap := TBitmap.Create;
end;

destructor TDragDropHelper.Destroy;
begin
  if Assigned(fDragObject) then
    FDragObject.Free;
  FDragObject := nil;
  FBitmap.Free;
  inherited;
end;

function TDragDropHelper.GetDragObject(AControl: TControl): TDragObject;
var
 XBitmap : TBitmap;
begin
  if not Assigned(AControl) then
   begin
     Result := nil;
     Exit;
   end;
  if not Assigned(FDragObject) then
   FDragObject := TInternalDragImageObject.Create(nil);
  FDragObject.Control := AControl;
  FDragObject.FHelper := Self;
  FDragObject.FMaskColor := Self.FMaskColor;
  XBitmap := TBitmap.Create;
  if (Assigned(FBitmap)) then
   begin
     if not FBitmap.Empty
       then
         XBitmap.Assign(FBitmap)
          else
            if Assigned(FOnGetDragImage) then
              FOnGetDragImage(Self, AControl, XBitmap);

   end
     else
       begin
         if Assigned(FOnGetDragImage) then
           FOnGetDragImage(Self, AControl, XBitmap);
       end;
  FDragObject.Bitmap := XBitmap;
  XBitmap.Free;
  Result := FDragObject;
end;

procedure TDragDropHelper.SetBitmap(const Value: TBitmap);
begin
  FBitmap.Assign(Value);
end;

end.