Adicionar propriedade num componente Timage

TMinhaImg = class(TImage)

private
FMinhaProp: String;

public

published

property MinhaProp: String read FMinhaProp write FMinhaProp;

end;

unit ImageL;


interface


uses
  Classes, Controls, Graphics, Vcl.ExtCtrls, Vcl.ImgList, System.Types, System.SysUtils;


type
  TImageL = class(TImage)
  private
    { Private declarations }
    FImages: TCustomImageList;
    FImageIndex: TImageIndex;
    FImageChangeLink: TChangeLink;
    procedure SetImages(const Value: TCustomImageList);
    procedure SetImageIndex(const Value: TImageIndex);
    procedure ImageListChange(Sender: TObject);
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Images: TCustomImageList read FImages write SetImages;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
  end;


procedure Register;


implementation


{ TMHLStaticTip }


procedure Register;
begin
  RegisterComponents('Standard', [TImageL]);
end;


constructor TImageL.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FImageIndex := -1;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
end;


destructor TImageL.Destroy;
begin
  FreeAndNil(FImageChangeLink);
  inherited Destroy;
end;


procedure TImageL.Paint;
var
  Rect: TRect;
  ImageWidth, ImageHeight: Integer;
  ImageTop, ImageLeft: Integer;
begin
  inherited;
  Rect := ClientRect;
  if Assigned(Images) and (FImageIndex >= 0) then
  begin
    ImageWidth := FImages.Width;
    ImageHeight := FImages.Height;


    ImageLeft := Rect.Left;
    ImageTop := Rect.Top + ((Height - ImageHeight) div 2);


    Images.Draw(Canvas, ImageLeft, ImageTop, FImageIndex);
  end;


end;


procedure TImageL.SetImages(const Value: TCustomImageList);
begin
   if Value <> FImages then
  begin
    if Assigned(FImages) then
    begin
      FImages.UnRegisterChanges(FImageChangeLink);
      FImages.RemoveFreeNotification(Self);
    end;


    FImages := Value;


    if Assigned(FImages) then
    begin
      FImages.RegisterChanges(FImageChangeLink);
      FImages.FreeNotification(Self);
    end;


    Invalidate;
  end;
end;


procedure TImageL.SetImageIndex(const Value: TImageIndex);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    Invalidate;
  end;
end;


procedure TImageL.ImageListChange(Sender: TObject);
begin
  if Sender = Images then
    Self.Paint;
end;


end.