Xyl*_*low 3 delphi firemonkey delphi-10.4-sydney
这是我创建的一个类,用于将 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.
Run Code Online (Sandbox Code Playgroud)
大多数情况下,无效指针异常意味着您尝试两次释放对象。
这种情况下的问题是,当控件被释放时,它会释放它的子控件。所以当表单被释放时,它也会释放TLabel. 因此,当你TTrackBarLabel.Destroy被执行时,你FLabel是一个悬空指针,你不能这样做FLabel.Free。
所有 Delphi 开发人员都知道,组件在被释放时会释放其拥有的组件。一个鲜为人知的事实是,控件也会释放其子项。
在您的情况下,您可以简单地删除FLabel.Free. 但是,如果您从未设置FLabel'sParent属性,这将导致内存泄漏。
要确保在轨迹栏出现时自动释放标签,请将轨迹栏设为标签的所有者:
FLabel := TLabel.Create(Self);
Run Code Online (Sandbox Code Playgroud)
顺便说一句,你的建议
if Assigned(FLabel) then
FLabel.Free;
Run Code Online (Sandbox Code Playgroud)
无济于事,因为FLabel发生错误时是一个悬空指针(不是nil)。
另外,在 Delphi 中,你永远不会写
if Assigned(FLabel) then
FLabel.Free;
Run Code Online (Sandbox Code Playgroud)
因为TObject.Free基本上可以if Assigned then Destroy,所以
if Assigned(FLabel) then
FLabel.Free;
Run Code Online (Sandbox Code Playgroud)
方法
if Assigned(FLabel) then
if Assigned(FLabel) then
FLabel.Destroy;
Run Code Online (Sandbox Code Playgroud)
这是非常愚蠢的。