如何向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流式传输之后需要在代码中更新属性,或者甚至只是在设计时更新).只需确保让他们检查ComponentState属性的csLoading标志,以便他们不会Glyph在DFM流式传输期间更新,因为它Loaded()会处理.

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

试试这个:

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.