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


précédentsommairesuivant

VIII. Code complet du composant TDropImage

DropImg.pas
Sélectionnez

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.
			

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.