3

这是我创建的一个类,用于将 TLabel 添加到 TTrackBar。标签在拖动时显示轨迹栏的值,然后淡出。在运行时创建一个实例,并将父级设置为表单。它工作正常,但如果跟踪栏仍然存在,则在关闭应用程序时会出错。但是,如果在运行时释放轨迹栏然后关闭应用程序,则没有问题。当应用程序关闭时调试该行时(FLabel.Free;)我看到 FLabel 和其中的数据仍然存在,但它仍然给出了那个错误。我担心如果我只是删除该行,那么在运行时释放对象时会出现内存泄漏。我尝试将其更改为 if Assigned(FLabel) then FLabel.Free; 但没有变化。我知道这一定与标签的父级已设置有关。

unit TrackBarLabelUnit;

interface

uses
  System.Types, System.Classes, System.SysUtils, FMX.Types, FMX.StdCtrls,
  FMX.Controls;

type
  TValueToString = function(AValue : Single) : String of object;

  TTrackBarLabel = class(TTrackBar)
  private
    FLabel : TLabel;
    FSuffix : String;
    FTimer : TTimer;
    FOffset : Integer;
    FValueToString : TValueToString;

    procedure TimerTimer(Sender: TObject);
  protected
    procedure ParentChanged; override;
    procedure DoTracking; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Suffix : String read FSuffix write FSuffix;
    property LabelOffset : Integer read FOffset write FOffset;
    property ValueToString : TValueToString write FValueToString;
  end;

implementation

constructor TTrackBarLabel.Create(AOwner: TComponent);
begin
  inherited;
  FLabel := TLabel.Create(nil);
  FLabel.Visible := False;
  FTimer := TTimer.Create(nil);
  FTimer.Interval := 100;
  FTimer.Enabled := False;
  FTimer.OnTimer := TimerTimer;
  FSuffix := '';
  FOffset := 22;
end;

destructor TTrackBarLabel.Destroy;
begin
  FLabel.Free; // EInvalidPointer error here when application is closed
  FTimer.Free;
  inherited Destroy;
end;

procedure TTrackBarLabel.ParentChanged;
begin
  inherited;
  FLabel.Parent := Parent;
end;

procedure TTrackBarLabel.DoTracking;
begin
  inherited;

  if not Assigned(Thumb) then Exit;

  FLabel.Visible := True;
  FLabel.Tag := 10;
  FLabel.Opacity := 1;

  if Assigned(FValueToString) then
    FLabel.Text := FValueToString(Value) + FSuffix
  else
    FLabel.Text := FloatToStrF(Value, ffFixed, 12, 1) + FSuffix;

  if Orientation = TOrientation.Horizontal then begin
    FLabel.Position.X := Position.X + Thumb.Position.X +
                         (Thumb.Width - FLabel.Width) * 0.5;
    FLabel.Position.Y := Position.Y + FOffset;
    FLabel.TextSettings.HorzAlign := TTextAlign.Center;
  end else begin
    FLabel.Position.X := Position.X + FOffset;
    FLabel.Position.Y := Position.Y + Thumb.Position.Y - 2;
    FLabel.TextSettings.HorzAlign := TTextAlign.Leading;
  end;

  FTimer.Enabled := False;
  FTimer.Enabled := True;
end;

procedure TTrackBarLabel.TimerTimer(Sender: TObject);
begin
  FLabel.Tag := FLabel.Tag - 1;
  FLabel.Opacity := FLabel.Tag * 0.2;
  if FLabel.Tag < 0 then begin
    FLabel.Visible := False;
    FTimer.Enabled := False;
  end;
end;

end.
4

1 回答 1

7

大多数情况下,无效指针异常意味着您尝试释放一个对象两次。

在这种情况下,问题是控件在释放时释放其级。因此,当表单被释放时,它也会释放TLabel. 因此,当你TTrackBarLabel.Destroy被执行时,你FLabel是一个悬空指针,你不能这样做FLabel.Free

所有 Delphi 开发人员都知道,当一个组件被释放时,它会释放它拥有的组件。一个鲜为人知的事实是,控件也会释放其子级。

在您的情况下,您可以简单地删除FLabel.Free. 但是,如果您从未设置FLabel'Parent属性,这将导致内存泄漏。

为确保在跟踪栏存在时自动释放标签,请将跟踪栏设为标签的所有者

  FLabel := TLabel.Create(Self);

顺便说一句,你的建议

if Assigned(FLabel) then
  FLabel.Free;

不会有帮助,因为FLabel发生错误时是一个悬空指针(它不是nil)。

另外,在 Delphi 中,你永远不会

if Assigned(FLabel) then
  FLabel.Free;

因为TObject.Free基本上可以if Assigned then Destroy,所以

if Assigned(FLabel) then
  FLabel.Free;

方法

if Assigned(FLabel) then
  if Assigned(FLabel) then
    FLabel.Destroy;

这很愚蠢。

于 2020-12-22T13:02:20.273 回答