delphi - 如何向 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 所说的之外，两个属性 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.