delphi 组件属性：TObjectList<TPicture>

Question

我正在尝试创建一个 VCL 组件，它允许您插入多个不同大小的 TImage 作为属性。我被告知最好使用 TObjectList ( )，但现在我正在努力使单个 TPictures 可在属性编辑器.[=15 中分配=]

我现在有什么：（编译）

unit ImageMultiStates;

interface

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

type

  TImageMultiStates = class(TImage)
  private
    FPictures: TObjectList<TPicture>;
    procedure SetPicture(Which: Integer; APicture: TPicture);
    function GetPicture(Which: Integer): TPicture;
  public
    Count: integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Activate(Which: Integer);
  published
    // property Pictures: TObjectList<TPicture> read GetPicture write SetPicture;
    // property Pictures[Index: Integer]: TObjectList<TPicture> read GetPicture write SetPicture;
    property Pictures: TObjectList<TPicture> read FPictures write FPictures;
  end;

procedure Register;

implementation

constructor TImageMultiStates.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPictures := TObjectList<TPicture>.Create;
end;

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

procedure TImageMultiStates.SetPicture(Which: Integer; APicture: TPicture);
begin
  FPictures[Which] := APicture;
  if Which=0 then
    Picture.Assign(APicture);
end;

function TImageMultiStates.GetPicture(Which: Integer): TPicture;
begin
  Result := FPictures[Which];
end;

procedure TImageMultiStates.Activate(Which: Integer);
begin
  Picture.Assign(FPictures[Which]);
end;

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

end.

属性编辑器中的最终结果不起作用。它显示了一个名为 "Pictures" 的项目，其值为“(TObjectList)”。单击它没有任何作用，我没有找到合适的编辑器。有关行的其他想法已被注释掉，它们带来了其他错误：第一个抛出编译器错误 "E2008 Incompatible Types"，第二个抛出 "Published property 'Pictures' can not be of type ARRAY".

Answer 1

IDE 不知道如何在设计时编辑 TObjectList，并且 DFM 流系统不知道如何流式传输 TObjectList。您将必须实施自定义属性编辑器和自定义流式处理逻辑。虽然这当然可能，但需要大量工作。

使用 System.Classes.TCollection 可以更好地处理您正在尝试做的事情。 IDE 和 DFM 流式传输系统都内置支持自动为您处理 TCollection 编辑和流式传输。

试试像这样的东西：

unit ImageMultiStates;

interface

uses
  System.Classes, Vcl.Controls, Vcl.ExtCtrls, Vcl.Graphics;

type
  TImagePictureItem = class(TCollectionItem)
  private
    FPicture: TPicture;
    procedure PictureChanged(Sender: TObject);
    procedure SetPicture(Value: TPicture);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property Picture: TPicture read FPicture write SetPicture;
  end;

  TImagePictureEvent = procedure(Sender: TObject; Index: Integer) of object; 

  TImagePictures = class(TOwnedCollection)
  private
    FOnPictureChange: TImagePictureEvent;
    function GetPicture(Index: Integer): TImagePictureItem;
    procedure SetPicture(Index: Integer; Value: TImagePictureItem);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(Owner: TComponent); reintroduce;
    property Pictures[Index: Integer]: TImagePictureItem read GetPicture write SetPicture; default;
    property OnPictureChange: TImagePictureEvent read FOnPictureChange write FOnPictureChange;
  end;

  TImageMultiStates = class(TImage)
  private
    FActivePicture: Integer;
    FPictures: TImagePictures;
    function GetPicture(Index: Integer): TPicture;
    procedure PictureChanged(Sender: TObject; Index: Integer);
    procedure SetActivePicture(Index: Integer);
    procedure SetPicture(Index: Integer; Value: TPicture);
    procedure SetPictures(Value: TImagePictures);
  protected
    procedure Loaded; override;
  public
    constructor Create(Owner: TComponent); override;
    function Count: integer;
    property Pictures[Index: Integer]: TPicture read GetPicture write SetPicture;
  published
    property ActivePicture: Integer read FActivePicture write SetActivePicture default -1;
    property Picture stored False;
    property Pictures: TImagePictures read FPictures write SetPictures;
  end;

procedure Register;

implementation

{ TImagePictureItem }

constructor TImagePictureItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
end;

destructor TImagePictureItem.Destroy;
begin
  FPicture.Free;
  inherited;
end;

procedure TImagePictureItem.PictureChanged(Sender: TObject);
begin
  Changed(False);
end;

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

{ TImagePictures }

constructor TImagePictures.Create(Owner: TComponent);
begin
  inherited Create(Owner, TImagePictureItem);
end;

function TImagePictures.GetPicture(Index: Integer): TImagePictureItem;
begin
  Result := TImagePictureItem(inherited GetItem(Index));
end;

procedure TImagePictures.SetPicture(Index: Integer; Value: TImagePictureItem);
begin
  inherited SetItem(Index, Value);
end;

procedure TImagePictures.Update(Item: TCollectionItem);
begin
  if Assigned(FOnPictureChange) then
  begin
    if Item <> nil then
      FOnPictureChange(Self, Item.Index)
    else
      FOnPictureChange(Self, -1);
  end;
end;

{ TImageMultiStates }

constructor TImageMultiStates.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  FPictures := TImagePictures.Create(Self);
  FPictures.OnPictureChange := PictureChanged;
  FActivePicture := -1;
end;

procedure TImageMultiStates.Loaded;
begin
  inherited;
  PictureChanged(nil, FActivePicture);
end;

function TImageMultiStates.Count: Integer;
begin
  Result := FPictures.Count;
end;

procedure TImageMultiStates.PictureChanged(Sender: TObject; Index: Integer);
begin
  if (FActivePicture <> -1) and ((Index = -1) or (Index = FActivePicture)) then
    Picture.Assign(GetPicture(FActivePicture));
end;

function TImageMultiStates.GetPicture(Index: Integer): TPicture;
begin
  Result := FPictures[Index].Picture;
end;

procedure TImageMultiStates.SetPicture(Index: Integer; Value: TPicture);
begin
  FPictures[Index].Picture.Assign(Value);
end;

procedure TImageMultiStates.SetActivatePicture(Value: Integer);
begin
  if FActivePicture <> Value then
  begin
    if ComponentState * [csLoading, csReading] = [] then
      Picture.Assign(GetPicture(Value));
    FActivePicture := Value;
  end;
end;

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

  // the inherited TImage.Picture property is published, and you cannot
  // decrease the visibility of an existing property.  However, if you move
  // this procedure into a separate design-time package, you can then use
  // DesignIntf.UnlistPublishedProperty() to hide the inherited
  // Picture property at design-time, at least:
  //
  // UnlistPublishedProperty(TImageMultiStates, 'Picture');
  //
  // Thus, users are forced to use the TImageMultiStates.Pictures and
  // TImageMultiStates.ActivePicture at design-time.  The inherited
  // Picture property will still be accessible in code at runtime, though...
end;

end.

delphi 组件属性：TObjectList<TPicture>

delphi component property: TObjectList<TPicture>

delphi

vcl

delphi 组件 属性：TObjectList<TPicture>

delphi component property: TObjectList<TPicture>

delphi

vcl

delphi 组件属性：TObjectList<TPicture>