Komponente erstellen und Ereignis zuweisen

[Stevie]

Entweder so:

Delphi-Quellcode:

unit MyImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics;

type
  TMyImage = class(TImage)
  private
    FPicture1: TPicture;
    FPicture2: TPicture;
    FPicture3: TPicture;
    procedure SetPicture1(const Value: TPicture);
    procedure SetPicture2(const Value: TPicture);
    procedure SetPicture3(const Value: TPicture);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Picture1: TPicture read FPicture2 write SetPicture2;
    property Picture2: TPicture read FPicture3 write SetPicture3;
    property Picture3: TPicture read FPicture4 write SetPicture4;
  end;

procedure Register;

implementation

{ TMyImage }
constructor TMyImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPicture1 := TPicture.Create;
  FPicture2 := TPicture.Create;
  FPicture3 := TPicture.Create;
end;

destructor TMyImage.Destroy;
begin
  FPicture1.Free;
  FPicture2.Free;
  FPicture3.Free;
  inherited Destroy;
end;

procedure TMyImage.SetPicture1(const Value: TPicture);
begin
  FPicture1.Assign(Value);
end;

procedure TMyImage.SetPicture2(const Value: TPicture);
begin
  FPicture2.Assign(Value);
end;

procedure TMyImage.SetPicture3(const Value: TPicture);
begin
  FPicture3.Assign(Value);
end;

procedure Register;
begin
  RegisterComponents('Beispiele', [TMyImage]);
end;

end.

und dann weist du der Eigenschaft Picture eins von den 3 Pictures zu.

Oder:

Delphi-Quellcode:

unit MyImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics;

type
  TMyPicture = class(TCollectionItem)
  private
    FPicture: TPicture;
    procedure SetPicture(const Value: TPicture);
  protected
  public
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;
  published
    property Picture: TPicture read FPicture write SetPicture;
  end;

  TMyPictures = class(TOwnedCollection)
  private
    function GetItems(AIndex: Integer): TMyPicture;
    procedure SetItems(AIndex: Integer; const Value: TMyPicture);
    function GetOwnedBy: TPersistent;
  protected
  public
    function Add: TMyPicture;
    constructor Create(AOwner: TPersistent); reintroduce;
    property Items[AIndex: Integer]: TMyPicture read GetItems write SetItems;
    property OwnedBy: TPersistent read GetOwnedBy;
  published
  end;

  TMyImage = class(TImage)
  private
    FIndex: Integer;
    FPictures: TMyPictures;
    procedure SetIndex(const Value: Integer);
    procedure SetPictures(const Value: TMyPictures);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Pictures: TMyPictures read FPictures write SetPictures;
    property Index: Integer read FIndex write SetIndex;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Beispiele', [TMyImage]);
end;

{ TMyPicture }

constructor TMyPicture.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);
  FPicture := TPicture.Create;
end;

destructor TMyPicture.Destroy;
begin
  inherited Destroy;
end;

procedure TMyPicture.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;

{ TMyPictures }

function TMyPictures.Add: TMyPicture;
begin
  Result := TMyPicture(inherited Add);
end;

constructor TMyPictures.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TMyPicture);
end;

function TMyPictures.GetItems(AIndex: Integer): TMyPicture;
begin
  Result := TMyPicture(inherited Items[AIndex]);
end;

function TMyPictures.GetOwnedBy: TPersistent;
begin
  Result := GetOwner;
end;

procedure TMyPictures.SetItems(AIndex: Integer; const Value: TMyPicture);
begin
  inherited SetItem(AIndex, Value);
end;

{ TMyImage }

constructor TMyImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIndex := -1;
  FPictures := TMyPictures.Create(Self);
end;

destructor TMyImage.Destroy;
begin
  FPictures.Free;
  inherited Destroy;
end;

procedure TMyImage.SetIndex(const Value: Integer);
begin
  if (Value > -1) then
  begin
    if (Value < (FPictures.Count)) then
      FIndex := Value
    else
      FIndex := Pred(FPictures.Count);
    Picture.Assign(FPictures.Items[FIndex].FPicture);
  end
  else
  begin
    FIndex := -1;
    Picture.Assign(nil);
  end;
end;

procedure TMyImage.SetPictures(const Value: TMyPictures);
begin
  FPictures.Assign(Value);
end;

end.

Die meiner Meinung nach beste Lösung ist aber:

Delphi-Quellcode:

unit MyImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics;

type
  TMyImage = class(TImage)
  private
    FIndex: Integer;
    FImageList: TImageList;
    procedure SetIndex(const Value: Integer);
    procedure SetImageList(const Value: TImageList);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ImageList: TImageList read FImageList write SetImageList;
    property Index: Integer read FIndex write SetIndex;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Beispiele', [TMyImage]);
end;

{ TMyImage }

constructor TMyImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIndex := -1;
  FImageList := nil;
end;

destructor TMyImage.Destroy;
begin
  FreeAndNil(FImageList);
  inherited Destroy;
end;

procedure TMyImage.SetImageList(const Value: TImageList);
begin
  FImageList := Value;
end;

procedure TMyImage.SetIndex(const Value: Integer);
var
  ABitmap: TBitmap;
  APicture: TPicture;
begin
  ABitmap := TBitmap.Create;
  APicture := TPicture.Create;
  if (Value > -1) and Assigned(FImageList) then
  begin
    if (Value < (FImageList.Count)) then
      FIndex := Value
    else
      FIndex := Pred(FImageList.Count);
    FImageList.GetBitmap(FIndex, ABitmap);
    APicture.Bitmap.Assign(ABitmap);
    Picture.Assign(APicture);
  end
  else
  begin
    FIndex := -1;
    Picture.Assign(nil);
  end;
  ABitmap.Free;
  APicture.Free;
end;

end.

Aber solche Komponenten gibt es ja schon...