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

Les constructeur et destructeur sont très simples. Le destructeur se charge juste de libérer le clone s’il est alloué.

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

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

Pour implémenter le glisser-déposer, nous devrons intercepter trois événements : OnMouseDown, OnMouseMove et OnMouseUp.

Cependant, il n'est pas question ici d'utiliser les événements pour les intercepter, sinon un programme utilisant notre composant ne pourrait plus réagir à ces événements.

Heureusement, la VCL est bien faite et il existe des méthodes dynamiques protégées (protected) qui sont appelées lorsque la majorité des événements sont interceptés.

Nous allons donc surcharger les trois méthodes MouseDown, MouseMove et MouseUp déclarées dans TControl (nous les déclarerons dans la section protected) :

protected
  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;

La première devra créer le clone et le positionner de façon centrée par rapport à la souris. La deuxième devra, si un clone existe, le déplacer à la nouvelle position de la souris. La troisième devra - de nouveau seulement si un clone existe - le détruire et envoyer un événement OnDrop en fonction de la position de la souris.

Puisque deux routines doivent positionner le clone de la même façon, nous créerons une méthode privée (private) qui s'occupera de cette tâche :

private
  procedure CalcClonePos(X, Y : integer);

Il reste un petit point à éclaircir : le clone ayant pour parent le parent du TDropImage, et les coordonnées reçues étant en rapport avec le TDropImage, nous devons trouver un moyen de calculer les coordonnées par rapport au parent. Cela peut être fait avec la méthode ClientToParent de TControl.

De même, nous utiliserons cette méthode pour calculer les coordonnées où l'on a déposé l'image si la propriété DropControl est à nil, et une combinaison des méthodes ClientToScreen et ScreenToClient dans le cas contraire.

Voici donc l'implémentation de ces quatre méthodes :

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.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;

Un petit bout de ce code peut paraître étrange :

if FClone <> nil then // par précaution, mais ne devrait jamais arriver
  FClone.Free;

Normalement, puisqu'on libère le clone dans la méthode MouseUp, FClone devrait toujours valoir nil à ce moment. Cependant, il se peut, et cela est indépendant de notre volonté, que l'événement de relâchement de la souris se perde, par exemple si une autre application apparaît devant la nôtre. Donc, on libère le clone par précaution, bien qu'en théorie nous ne devrions pas le faire.

Un gros problème de sécurité s'est glissé dans la création du TDropImage : que se passera-t-il en effet si le contrôle référencé par DropControl est détruit ?

En exécution, rien de bien exceptionnel : vous obtiendrez une erreur de type EAccessViolation au moment de lâcher l'image.

En conception par contre, c'est Delphi qui se crache : plus moyen de faire quoi que ce soit, il est trop tard pour enregistrer, vous devez fermer Delphi, ou pire, le killer !

Pourtant, si par exemple vous ajoutez un TActionList et un TImageList, et que vous associer ImageList1 à ActionList1.Images, avant de supprimer ImageList1, il ne se passe rien de grave et mieux : la référence est automatiquement supprimée !

Pour faire cela, le TActionList se base sur le système de notification de destruction. Chaque composant possède une liste de notification de destruction, et au moment d'être détruit, il appelle la méthode Notification déclarée dans TComponent avec comme paramètre Operation la valeur opRemove.

Pour s'ajouter dans la liste de notification d'un composant, il faut appeler sa méthode FreeNotification avec Self en paramètre. Pour s'en retirer, il faut appeler la méthode RemoveFreeNotification.

Ajoutez donc une méthode privée SetDropControl qui servira de méthode d'accès en écriture à la propriété DropControl (n'oubliez pas de modifier la clause write en conséquence) :

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;

Comme vous pouvez le constater, cette méthode se charge de se supprimer de la liste de notification de destruction de l'ancien DropControl, puis s'ajoute à celle du nouveau.

Pour s'assurer qu'on ne laissera pas de trace dans la liste de notification du dernier DropControl après la destruction, nous ajouterons cette ligne de code au destructeur de TDropImage :

DropControl := nil;

Finalement, nous devons encore surcharger la méthode Notification pour passer FDropControl à nil le cas échéant :

protected
  procedure Notification(AComponent : TComponent; Operation : TOperation); override;

Implémentez cette méthode comme suit :

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

La méthode Notification héritée de TComponent appelle cette même méthode récursivement pour tous les composants qu'il possède (propriété Components).

Voici donc ce qui se passera lorsque le composant recensé par la propriété DropControl sera détruit :

1. Ce contrôle ajoute l'indicateur csDestroying à sa propriété ComponentState ;
2. Il appelle la méthode Notification que nous avons surchargée ;
3. Celle-ci passe à nil la propriété DropControl ;
4. SetDropControl, voyant l'indicateur csDestroying, n'appelle pas RemoveFreeNotification, mais la référence est bien supprimée.

Nous avons maintenant terminé la création du composant TDropImage.