另一个对象中的对象不会在单元之间持久存在 Delphi

Question

抱歉，如果这个问题是重复的，但我在任何地方都找不到解决我的问题的方法... 下面的代码显示了我如何将列表视图中的值分配给一个对象，该对象是另一个对象的属性：

主要单位：

procedure TForm1.SBCadClick(Sender: TObject);
var
  Procedimento: TProcedimento;
  Produto: TItemProcedimento;
  item: TListViewItem;
begin
...
  Procedimento := TProcedimento.Create;
  for item in LVItensProcedimento.Items do
  begin
    Produto := TItemProcedimento.Create;
    Produto.PRO_ID := item.Tag;
    Produto.IPR_Uso := TListItemText(item.Objects.FindDrawable('IPR_Uso'))
      .Text.ToDouble;
    Procedimento.AddPRC_Produtos(Produto);
    Produto.DisposeOf;
  end;

DM.gravaProcedimento(Procedimento); // from here we go into another unit to use its function, passing an object as a parameter

在命令 DM.gravaProcedimento(Procedimento); 之前，产品被正确地添加到 TProcedimento 的 TObjectList 中，我可以使用 Procedimento.GetPRC_Produtos 正确地获取它的内容。但是当我调试下面显示的下一个单元时，它获得随机 ID，这意味着它不会从一个单元持久保存到另一个单元：

单位DM：

procedure TDM.gravaProcedimento(Procedimento: TProcedimento);
var
  produto: TItemProcedimento;
  dura: string;
begin
...
  produto := TItemProcedimento.Create;
  for produto in Procedimento.GetPRC_Produtos do
  begin
    DM.FDQ.Append;
    DM.FDQ.FieldByName('PRO_ID').AsInteger := produto.PRO_ID; // here the value gets a random ID like 45684 instead of the current item ID
    DM.FDQ.FieldByName('PRC_ID').AsInteger := Procedimento.PRC_ID;
    DM.FDQ.FieldByName('IPR_Uso').AsFloat := produto.IPR_Uso;
    DM.FDQ.Post;
  end;
  produto.DisposeOf;
  DM.FDQ.ApplyUpdates;
  DM.FDQ.Close;
end;

这是我对象的 class 定义：

unit uClasses;

interface

uses
  System.SysUtils, System.Types, Generics.Collections;

type
  TItemProcedimento = class
  private
    FPRO_Nome: string;
    FPRO_Tipo: integer;
    FPRO_Custo: double;
    FPRO_ID: integer;
    FPRO_Rendimento: integer;
    FPRO_Potencia: double;
    FIPR_Uso: double;
    procedure SetPRO_Custo(const Value: double);
    procedure SetPRO_ID(const Value: integer);
    procedure SetPRO_Nome(const Value: string);
    procedure SetPRO_Rendimento(const Value: integer);
    procedure SetPRO_Tipo(const Value: integer);
    procedure SetPRO_Potencia(const Value: double);
    procedure SetIPR_Uso(const Value: double);
  public
    constructor Create;
  published
    property PRO_Rendimento: integer read FPRO_Rendimento
      write SetPRO_Rendimento;
    property PRO_ID: integer read FPRO_ID write SetPRO_ID;
    property PRO_Nome: string read FPRO_Nome write SetPRO_Nome;
    property PRO_Tipo: integer read FPRO_Tipo write SetPRO_Tipo;
    property PRO_Custo: double read FPRO_Custo write SetPRO_Custo;
    property PRO_Potencia: double read FPRO_Potencia write SetPRO_Potencia;
    property IPR_Uso: double read FIPR_Uso write SetIPR_Uso;
  end;

  TProcedimento = class
  private
    FPRC_Nome: string;
    FPRC_Duracao: TDateTime;
    FPRC_Preco: double;
    FPRC_ID: integer;
    FPRC_Consumo: double;
    FPRC_Produtos: TObjectList<TItemProcedimento>;
    procedure SetPRC_Consumo(const Value: double);
    procedure SetPRC_Duracao(const Value: TDateTime);
    procedure SetPRC_ID(const Value: integer);
    procedure SetPRC_Nome(const Value: string);
    procedure SetPRC_Preco(const Value: double);
  public
    constructor Create;
    function GetPRC_Produtos: TObjectList<TItemProcedimento>;
    procedure AddPRC_Produtos(const Value: TItemProcedimento);
    procedure DelPRC_Produtos(const Value: TItemProcedimento);
    procedure CleanPRC_Produtos;
  published
    property PRC_Preco: double read FPRC_Preco write SetPRC_Preco;
    property PRC_Consumo: double read FPRC_Consumo write SetPRC_Consumo;
    property PRC_ID: integer read FPRC_ID write SetPRC_ID;
    property PRC_Nome: string read FPRC_Nome write SetPRC_Nome;
    property PRC_Duracao: TDateTime read FPRC_Duracao write SetPRC_Duracao;
  end;

implementation

{ TProcedimento }

procedure TProcedimento.CleanPRC_Produtos;
begin
  if not Assigned(FPRC_Produtos) then
    FPRC_Produtos := TObjectList<TItemProcedimento>.Create
  else
    FPRC_Produtos.Clear;
end;

constructor TProcedimento.Create;
begin
  SetPRC_Consumo(0);
  SetPRC_Duracao(0);
  SetPRC_ID(0);
  SetPRC_Nome('');
  SetPRC_Preco(0);
end;

procedure TProcedimento.DelPRC_Produtos(const Value: TItemProcedimento);
begin
  FPRC_Produtos.Delete(FPRC_Produtos.IndexOf(Value));
end;

function TProcedimento.GetPRC_Produtos: TObjectList<TItemProcedimento>;
begin
  if Assigned(FPRC_Produtos) then
    result := FPRC_Produtos
  else
  begin
    CleanPRC_Produtos;
    result := FPRC_Produtos;
  end;
end;

procedure TProcedimento.SetPRC_Consumo(const Value: double);
begin
  FPRC_Consumo := Value;
end;

procedure TProcedimento.SetPRC_Duracao(const Value: TDateTime);
begin
  FPRC_Duracao := Value;
end;

procedure TProcedimento.SetPRC_ID(const Value: integer);
begin
  FPRC_ID := Value;
end;

procedure TProcedimento.SetPRC_Nome(const Value: string);
begin
  FPRC_Nome := Value;
end;

procedure TProcedimento.SetPRC_Preco(const Value: double);
begin
  FPRC_Preco := Value;
end;

procedure TProcedimento.AddPRC_Produtos(const Value: TItemProcedimento);
begin
  FPRC_Produtos.Add(Value);
end;

{ TItemProcedimento }

constructor TItemProcedimento.Create;
begin
  SetPRO_Custo(0);
  SetPRO_ID(0);
  SetPRO_Nome('');
  SetPRO_Tipo(0);
  SetPRO_Rendimento(0);
end;

procedure TItemProcedimento.SetIPR_Uso(const Value: double);
begin
  FIPR_Uso := Value;
end;

procedure TItemProcedimento.SetPRO_Custo(const Value: double);
begin
  FPRO_Custo := Value;
end;

procedure TItemProcedimento.SetPRO_ID(const Value: integer);
begin
  FPRO_ID := Value;
end;

procedure TItemProcedimento.SetPRO_Nome(const Value: string);
begin
  FPRO_Nome := Value;
end;

procedure TItemProcedimento.SetPRO_Potencia(const Value: double);
begin
  FPRO_Potencia := Value;
end;

procedure TItemProcedimento.SetPRO_Rendimento(const Value: integer);
begin
  FPRO_Rendimento := Value;
end;

procedure TItemProcedimento.SetPRO_Tipo(const Value: integer);
begin
  FPRO_Tipo := Value;
end;

end.

发生这种情况的任何特定原因？我在这里做错了什么？

Answer 1

您不应在过程 TForm1.SBCadClick 中调用 Produto.DisposeOf。您正在破坏刚刚添加的对象..

Answer 2

问题是您在 gravaProcedimento() 有机会使用它们之前销毁 TItemProcedimento 个对象。

您在 Procedimento.AddPRC_Produtos(Produto) 退出后立即调用 Produto.DisposeOf()，也在 gravaProcedimento() 中调用。 不要那样做！

AddPRC_Produtos() 将原始 Produto 对象保存到一个 TObjectList 中，它获得了该对象的所有权（因为 TObjectList 默认设置为 OwnsObjects=True ).这意味着对象将在从列表中删除时自动销毁，包括清除或销毁列表时。

所以，你需要完全摆脱你的 DisposeOf() 电话。

此外，您还需要删除 gravaProcedimento() 中对 TItemProcedimento.Create 的调用。它不属于那里。你所做的就是在 non-ARC 系统上造成内存泄漏。

看来您对 Delphi 对象生命周期的实际工作原理没有把握。在将对象 instance 分配给它之前，您不需要在对象 variable 上调用 Create。当您使用变量时，您不需要在对象变量上调用 DisposeOf()，仅当您完成使用时对象本身（TObjectList 将为您处理）。

试试这个：

procedure TForm1.SBCadClick(Sender: TObject);
var
  Procedimento: TProcedimento;
  Produto: TItemProcedimento;
  item: TListViewItem;
begin
  ...
  Procedimento := TProcedimento.Create;
  try
    for item in LVItensProcedimento.Items do
    begin
      Produto := TItemProcedimento.Create;
      try
        Produto.PRO_ID := item.Tag;
        Produto.IPR_Uso := TListItemText(item.Objects.FindDrawable('IPR_Uso')).Text.ToDouble;
        Procedimento.AddPRC_Produtos(Produto);
        // Produto.DisposeOf; // <-- DO NOT DO THIS HERE!!!
      except
        Produto.DisposeOf; // <-- DO THIS HERE INSTEAD, if AddPRC_Produtos fails!!!
        raise;
      end;
    end;

    DM.gravaProcedimento(Procedimento);
  finally
    Procedimento.DisposeOf; // <-- ADD THIS, if needed!!!
  end;
end;

procedure TDM.gravaProcedimento(Procedimento: TProcedimento);
var
  produto: TItemProcedimento;
  dura: string;
begin
  ...
  // produto := TItemProcedimento.Create; // <- DO NOT DO THIS!!!
  for produto in Procedimento.GetPRC_Produtos do
  begin
    FDQ.Append;
    try
      FDQ.FieldByName('PRO_ID').AsInteger := produto.PRO_ID;
      FDQ.FieldByName('PRC_ID').AsInteger := Procedimento.PRC_ID;
      FDQ.FieldByName('IPR_Uso').AsFloat := produto.IPR_Uso;
      FDQ.Post;
    except
      FDQ.Cancel; // <-- ADD THIS!!!
      raise;
    end;
  end;
  // produto.DisposeOf; // <-- DO NOT DO THIS!!!
  FDQ.ApplyUpdates;
  FDQ.Close;
end;

另一个对象中的对象不会在单元之间持久存在 Delphi

Object within another Object not persisting between units Delphi

delphi

oop

firemonkey