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属性，这样他们就不会在DFM流式传输期间更新Glyph，因为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.

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;

如何向TSpeedButton（Delphi）添加属性

2 个答案: