FMX 动态创建及销毁(释放free)对象

Posted 2021-11-09 kinglandsoft

 http://www.2pascal.com/thread-3037-1-1.html这是原文地址。

(* ************************************************ *)
(*　　　　　　　　　　　　　　　　　　　　　　　　　*)
(*　　　　　　　　　　　　　　　　　　　　　　　　　*)
(*　　编写：爱吃猪头肉 & Flying Wang 2015-12-03　　 *)
(*　　　　　　上面的版权声明请不要移除。　　　　　　*)
(*　　　　　　　　　　　　　　　　　　　　　　　　　*)
(* ************************************************ *)

//本人所在的群（① FireMonkey[移动开发]  165232328）

{-------------------------------------------------------------------------------}

procedure FDFree(AObj: TObject);
begin
  if AObj <> nil then
{$IFDEF AUTOREFCOUNT}
    AObj.DisposeOf;
{$ELSE}
    AObj.Destroy;
{$ENDIF}
end;


{-------------------------------------------------------------------------------}

procedure FDFreeAndNil(var AObj);
var
  p: Pointer;
begin
  if Pointer(AObj) <> nil then begin
    p := Pointer(AObj);
    Pointer(AObj) := nil;
{$IFDEF AUTOREFCOUNT}
    if TObject(p).__ObjRelease > 0 then
      TObject(p).DisposeOf;
{$ELSE}
    TObject(p).Destroy;
{$ENDIF}
  end;
end;

//FD 开头的是 官方的 FireDac 专用函数。

function FindChild(Name: string; Parent: TFmxObject): TFmxObject;
var
  I: Integer;
  Child: TFmxObject;
begin
  Result := nil;
  if (Parent <> nil) and (Parent.Children <> nil) then
  begin
    for I := Parent.Children.Count - 1 downto 0 do
    begin
      Child := TFmxObject(Parent.Children[I]);
      if Child.Name = Name then
      begin
        Result := Child;
        break;
      end;
    end;
  end;
end;

procedure FreeAndNilFmxObject(var Obj: TFmxObject);
begin
  if Obj <> nil then
  begin
    Obj.Parent := nil;
    Obj.SetRoot(nil);
    //FreeAndNil(Obj);
    FDFreeAndNil(Obj);
  end;
end;

var
  AIndex : Integer = 0;
procedure TForm1.Button1Click(Sender: TObject);
var
  A: TButton;
  B: TFmxObject;
begin
  B := FindChild(‘A‘, Self);
  if (B <> nil) and (B is TButton) then
  begin
    A := B as TButton;
    B := nil;
    FreeAndNilFmxObject(TFmxObject(A));
  end;
  inc(AIndex);
  A := TButton.Create(nil);
  A.Name := ‘A‘;
  A.Position.Y := AIndex * A.Height;
  A.Text := ‘按钮‘ + AIndex.ToString;
  A.Parent := Self;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  B: TFmxObject;
begin
  B := FindChild(‘A‘, Self);
  //这样写更简单些。
  FreeAndNilFmxObject(B);
end;