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


précédentsommairesuivant

V. Constructeur et destructeur

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

 
Sélectionnez

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;
			

VI. Implémentation du glisser-déposer

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) :

 
Sélectionnez

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 un méthode privée (private) qui s'occupera de cette tâche :

 
Sélectionnez

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 :

 
Sélectionnez

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 :

 
Sélectionnez

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.

VII. Sécuriser la destruction du contrôle DropControl

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) :

 
Sélectionnez

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;
			

La vérification concernant la présence du drapeau csDestroying dans l'ensemble FDropControl.ComponentState sert à éviter de modifier la liste de notifications du contrôle pendant que celui-ci la lit, ce qu'il ne fait qu'une fois que csDestroying est ajouté à cet ensemble.

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 :

 
Sélectionnez

DropControl := nil;
			

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

 
Sélectionnez

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

Implémentez cette méthode comme suit :

 
Sélectionnez

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.


précédentsommairesuivant

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

Tutoriels
Les génériques avec Delphi 2009 Win32 (English version) - également disponible en espagnol et en russe
Réaliser un plug-in comportant un composant
Construire une procédure pointant sur une méthode
Création de composants - en 4 parties
Refactoring avec Delphi 2007
Prise en main de Delphi 2005
Analyseurs syntaxiques - Leur fonctionnement par l'exemple
Créer un fichier d'aide HLP
Pourquoi un paramètre const change-t-il mystérieusement de valeur ?
Sources
SJRDUnits - Routines et classes diverses
SJRDComps - Quelques composants
Projet Sepi
Présentation
FAQ Sepi
Programmes
FunLabyrinthe - Jeu de labyrinthe très spécial et très fun
TrickTakingGame - Jeux de cartes à plis en ligne
MultiAgenda - Agenda multi-répertoires
DecodeFormulaires - Décode les formulaires
Excel --> HTML - Convertisseur de tableaux Excel en HTML
AddressLinks - Lie les adresses Internet et e-mail d'un document HTML
Vipion - Tic Tac Toe sur 4x4 cases avec jeu de l'ordinateur
BigCalc - Calculatrice de haut niveau
Espace paroissial Astérion de Watermael-Boitsfort
  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2005 Sébastien Doeraene. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.