Einzelnen Beitrag anzeigen

hzzm

Registriert seit: 8. Apr 2016
103 Beiträge
 
Delphi 10 Seattle Professional
 
#1

Räumt diese Komponente hinter sich auf?

  Alt 3. Aug 2018, 06:06
Delphi-Version: 10 Seattle
Guten Morgen,

räumt diese Komponente hinter sich auf (sind die Destruktoren korrekt)?

Delphi-Quellcode:
unit ImageMultiStates;

    interface

    uses
      Vcl.Graphics, Vcl.StdCtrls, System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Forms, Generics.Collections;

    type

      TPic = class(TCollectionItem)
      private
        FPicture: TPicture;
        procedure SetPicture(const value: TPicture);
      protected
        function GetDisplayName: String; override;
      public
        procedure Assign(Source: TPersistent); override;
        constructor Create(Collection: TCollection); override;
      published
        property Picture: TPicture read FPicture write SetPicture;
      end;

      TPictures = class(TOwnedCollection)
      private
        function GetPic(Index: Integer): TPic;
        procedure SetPic(Index: Integer; Value: TPic);
      public
        constructor Create(AOwner: TComponent);
        destructor Destroy;
        property Picture[Index: Integer]: TPic read GetPic write SetPic;
      end;

      TImageMultiStates = class(TImage)
      private
        FPictures: TPictures;
        FOnMouseDownPic: Integer;
        FOnMouseUpPic: Integer;
        procedure SetPictures(const Value: TPictures);
      public
        ActivePic: Integer;
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure ActivatePic(Index: Integer);
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
        procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
      published
        property Pictures: TPictures read FPictures write SetPictures;
        property OnMouseDownPic: Integer read FOnMouseDownPic write FOnMouseDownPic;
        property OnMouseUpPic: Integer read FOnMouseUpPic write FOnMouseUpPic;
      end;

    procedure Register;

    implementation

    constructor TPic.Create(Collection: TCollection);
    begin
      inherited;
      FPicture := TPicture.Create;
    end;

    procedure TPic.Assign(Source: TPersistent);
    begin
      if Source is TPic then
        FPicture := TPic(Source).FPicture
      else
        inherited;
    end;

    procedure TPic.SetPicture(const Value: TPicture);
    begin
      FPicture.Assign(Value);
      if Index=0 then
        TImageMultiStates(TPictures(GetOwner).GetOwner).Picture.Assign(Value);
    end;

    function TPic.GetDisplayName;
    begin
      Result := Format('Picture %d',[Index]);
    end;


    constructor TPictures.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner, TPic);
    end;

    destructor TPictures.Destroy;
    begin
      inherited Destroy;
    end;

    procedure TPictures.SetPic(Index: Integer; Value: TPic);
    begin
      inherited SetItem(Index, Value);
    end;

    function TPictures.GetPic(Index: Integer): TPic;
    begin
      Result := inherited GetItem(Index) as TPic;
    end;


    constructor TImageMultiStates.Create(AOwner: TComponent);
    begin
      inherited;
      FOnMouseDownPic := -1;
      FOnMouseUpPic := -1;
      FPictures := TPictures.Create(AOwner);
    end;

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

    procedure TImageMultiStates.SetPictures(const Value: TPictures);
    begin
      FPictures.Assign(Value);
    end;

    procedure TImageMultiStates.ActivatePic(Index: Integer);
    begin
      if (Index < FPictures.Count) and (Index >= 0) then
      begin
        ActivePic := Index;
        Picture.Assign(TPic(FPictures.Items[Index]).FPicture);
      end
      else
      begin
        ActivePic := -1;
        Picture.Assign(nil);
      end;
    end;

    procedure TImageMultiStates.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      if FOnMouseDownPic<>-1 then
        Picture.Assign(TPic(FPictures.Items[FOnMouseDownPic]).FPicture);
      inherited;
    end;

    procedure TImageMultiStates.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      if FOnMouseUpPic<>-1 then
        Picture.Assign(TPic(FPictures.Items[FOnMouseUpPic]).FPicture);
      inherited;
    end;

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

    end.
  Mit Zitat antworten Zitat