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

How to add a property to TSpeedButton (Delphi)

我需要向 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.

您无法从组件的 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;

除了 KenWhite 所说的之外,两个 属性 setter 应该更新 Glyph(以防在 DFM 流式处理后需要在代码中更新属性,或者甚至只是在设计时-时间)。只需确保让他们检查 ComponentState 属性 中的 csLoading 标志,这样他们就不会在 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.