【转】FMX 动态创建及销毁(释放free)对象
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;