Partie II : Améliorer un composant par héritage

unit DropImg;

interface

uses
  Windows, SysUtils, Classes, Controls, ExtCtrls;

type
  TDropEvent = procedure(Sender : TObject; X, Y : integer) of object;

  TDropImage = class(TImage)
  private
    FClone : TImage;

    FDropControl : TControl;
    FOnDrop : TDropEvent;

    procedure SetDropControl(New : TControl);

    procedure CalcClonePos(X, Y : integer);
  protected
    procedure Notification(AComponent : TComponent; Operation : TOperation); override;
    procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : integer); override;
    procedure MouseMove(Shift : TShiftState; X, Y : integer); override;
    procedure MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : integer); override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property DropControl : TControl read FDropControl write SetDropControl;
    property OnDrop : TDropEvent read FOnDrop write FOnDrop;
  end;

implementation

constructor TDropImage.Create(AOwner : TComponent);
begin
  inherited;
  FClone := nil;
  FDropControl := nil;
  FOnDrop := nil;
end;

destructor TDropImage.Destroy;
begin
  DropControl := nil;
  if FClone <> nil then
    FClone.Free;
  inherited;
end;

procedure TDropImage.SetDropControl(New : TControl);
begin
  if New = FDropControl then exit;
  if Assigned(FDropControl) and (not (csDestroying in FDropControl.ComponentState)) then
    FDropControl.RemoveFreeNotification(Self);
  FDropControl := New;
  if Assigned(FDropControl) then
    FDropControl.FreeNotification(Self);
end;

procedure TDropImage.CalcClonePos(X, Y : integer);
var Pt : TPoint;
begin
  Pt := ClientToParent(Point(X, Y));
  FClone.Left := Pt.X - Width  div 2;
  FClone.Top  := Pt.Y - Height div 2;
end;

procedure TDropImage.Notification(AComponent : TComponent; Operation : TOperation);
begin
  if (AComponent = FDropControl) and (Operation = opRemove) then
    FDropControl := nil;
end;

procedure TDropImage.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : integer);
begin
  inherited;
  if (not Enabled) or (Button <> mbLeft) then exit;
  if FClone <> nil then // par précaution, mais ne devrait jamais arriver
    FClone.Free;

  // Création du clone
  FClone := TImage.Create(Self);
  FClone.Parent := Parent;
  FClone.Width := Width;
  FClone.Height := Height;
  FClone.Stretch := Stretch;
  FClone.Picture.Assign(Picture);

  // Calcul de la position initiale du clone
  CalcClonePos(X, Y);
end;

procedure TDropImage.MouseMove(Shift : TShiftState; X, Y : integer);
begin
  inherited;
  if FClone <> nil then
    CalcClonePos(X, Y);
end;

procedure TDropImage.MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : integer);
var Pt : TPoint;
begin
  inherited;
  if FClone = nil then exit;

  // Destruction du clone
  FreeAndNil(FClone);

  // Calcul des coordonnées à envoyer à l'événement OnDrop
  if not Assigned(FOnDrop) then exit;
  Pt := Point(X, Y);
  if FDropControl = nil then Pt := ClientToParent(Pt) else
  begin
    Pt := FDropControl.ScreenToClient(ClientToScreen(Pt));

    // Dans ce cas on vérifie que l'on a bien déposé sur le contrôle DropControl
    if not PtInRect(Rect(0, 0, DropControl.Width, DropControl.Height), Pt) then
      exit;
  end;
  FOnDrop(Self, Pt.X, Pt.Y);
end;

end.