如何将属性添加到 TSpeedButton (Delphi)

Question

我需要向 TSpeedButton 添加 2 个新属性。 尽管属性在对象检查器中正确显示并且其值存储在 DFM 文件中，但运行时的“create”方法始终将属性获取为“nil”。

怎么了？

自定义组件代码如下：

unit ulbSpeedButton;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.Graphics,
      Vcl.StdCtrls, Vcl.ExtCtrls, Winapi.CommCtrl, Vcl.ImgList,
      Vcl.Themes, System.Generics.Collections, Vcl.Buttons;

    type
      tlbSpeedButton = class(TSpeedButton)
      private
        fImageList : TImageList;
        fImageIndex : Integer;
        function GetImageIndex:Integer;
        function GetImageList:TImageList;
        procedure SetImageIndex(aIndex:Integer);
        procedure SetImageList(aImageList:TImageList);
      protected

      public
        constructor Create(AOwner: TComponent); override;
      published
        property ImgIndex : Integer read fImageIndex write SetImageIndex;
        property ImgList : TImageList read GetImageList write SetImageList;
      end;

    procedure Register;

    implementation

    procedure Register;
    begin
      RegisterComponents('Leo Bruno', [tlbSpeedButton]);
    end;

    { tlbSpeedButton }

    constructor tlbSpeedButton.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);

      if ((Assigned(fImageList)) and (fImageList.Count > 0)) then
        fImageList.GetBitmap(fImageIndex,Self.Glyph);
    end;

    function tlbSpeedButton.GetImageIndex: Integer;
    begin
      Result := fImageIndex;
    end;

    function tlbSpeedButton.GetImageList: TImageList;
    begin
      Result := fImageList;
    end;

    procedure tlbSpeedButton.SetImageIndex(aIndex: Integer);
    begin
      if fImageIndex <> aIndex then
      begin
        fImageIndex := aIndex;
        Invalidate;
      end;
    end;

    procedure tlbSpeedButton.SetImageList(aImageList: TImageList);
    begin
      if fImageList <> aImageList then
      begin
        fImageList := aImageList;
        Invalidate;
      end;
    end;

    end.

Answer 1

除了 KenWhite 所说的之外，两个属性设置器应该更新Glyph（以防在 DFM 流式传输之后需要在代码中更新属性，或者甚至只是在设计时更新）。只需确保让他们检查csLoading 标志的ComponentState 属性，这样他们就不会在DFM 流式传输期间更新Glyph，因为Loaded() 会处理这个问题。

并且不要忘记在分配的TImageList 上调用FreeNotification()，因为它在按钮外部并且可能在按钮被释放之前被释放。

试试这个：

unit ulbSpeedButton;

interface

uses
  Winapi.Windows, Winapi.Messages, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.Graphics,
  Vcl.StdCtrls, Vcl.ExtCtrls, Winapi.CommCtrl, Vcl.ImgList,
  Vcl.Themes, System.Generics.Collections, Vcl.Buttons;

type
  tlbSpeedButton = class(TSpeedButton)
  private
    fImageList : TCustomImageList;
    fImageIndex : Integer;
    procedure SetImageIndex(aIndex: Integer);
    procedure SetImageList(aImageList: TCustomImageList);
    procedure UpdateGlyph;
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ImgIndex : Integer read fImageIndex write SetImageIndex default -1;
    property ImgList : TCustomImageList read fImageList write SetImageList;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Leo Bruno', [tlbSpeedButton]);
end;

{ tlbSpeedButton }

constructor tlbSpeedButton.Create(AOwner: TComponent);
begin
  inherited;
  fImageIndex := -1;
end;

procedure tlbSpeedButton.Loaded;
begin
  inherited;
  UpdateGlyph;
end;

procedure tlbSpeedButton.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = fImageList) then
  begin
    fImageList := nil;
    UpdateGlyph;
  end;
end;

procedure tlbSpeedButton.UpdateGlyph;
begin
  if csLoading in ComponentState then Exit;
  if Assigned(fImageList) and (fImageIndex >= 0) and (fImageIndex < fImageList.Count) then
    fImageList.GetBitmap(fImageIndex, Self.Glyph)
  else
    Self.Glyph := nil;
  Invalidate;
end;

procedure tlbSpeedButton.SetImageIndex(aIndex: Integer);
begin
  if fImageIndex <> aIndex then
  begin
    fImageIndex := aIndex;
    UpdateGlyph;
  end;
end;

procedure tlbSpeedButton.SetImageList(aImageList: TImageList);
begin
  if fImageList <> aImageList then
  begin
    if Assigned(fImageList) then fImageList.RemoveFreeNotification(Self);
    fImageList := aImageList;
    if Assigned(fImageList) then fImageList.FreeNotification(Self);
    UpdateGlyph;
  end;
end;

end.

Answer 2

您无法从组件的Create 事件中访问图像列表；它发生在其他内容从 .DFM 文件流入之前。必须先创建按钮，然后才能设置其属性，并且此时会发生 Create 事件。

您需要将访问图像列表的代码移动到重写的 Loaded 方法，这发生在整个内容都已流式传输之后。

type
  tlbSpeedButton = class(TSpeedButton)
  private
    fImageList : TImageList;
    fImageIndex : Integer;
    function GetImageIndex:Integer;
    function GetImageList:TImageList;
    procedure SetImageIndex(aIndex:Integer);
    procedure SetImageList(aImageList:TImageList);
  protected
    procedure Loaded; virtual; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ImgIndex : Integer read fImageIndex write SetImageIndex;
    property ImgList : TImageList read GetImageList write SetImageList;
  end;

implementation

  constructor Create(AOwner: TComponent);
  begin
    inherited;
  end;

  procedure TlbSpeedButton.Loaded;
  begin
    inherited;
    if Asssigned(fImageList) and (fImageList.Count > 0) and
       (fImageIndex > -1)  then
      fImageList.GetBitmap(fImageIndex, Self.Glyph);
  end;  

  // The rest of your code
end;