另一个对象中的对象不在单元之间保持不变 Delphi

Posted 2023-03-29

【中文标题】另一个对象中的对象不在单元之间保持不变 Delphi

【英文标题】：Object within another Object not persisting between units Delphi

【发布时间】：2020-08-18 20:18:16

【问题描述】：

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

主机：

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;

这是我的对象的类定义：

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.

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

【参考方案1】：

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

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

AddPRC_Produtos() 将原始的Produto 对象保存到TObjectList 中，该对象拥有该对象的所有权（因为TObjectList 默认设置为OwnsObjects=True）。这意味着对象从列表中移除时会自动销毁，包括列表被清除或销毁的时间。

因此，您需要完全摆脱 DisposeOf() 的调用。

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

您似乎对 Delphi 对象生命周期的实际工作方式并没有完全掌握。在将对象 instance 分配给它之前，您不需要在对象 variable 上调用 Create。当您使用 variable 时，您不需要在对象 variable 上调用 DisposeOf()，只有在您使用完 object 时才需要> 本身（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 中的引用类型。它们总是由指针引用。 Create() 在内存中创建对象，Destroy()/Free()/DisposeOf() 销毁并从内存中删除它。在这两者之间，对对象所做的一切都是通过传递一个指向对象的指针来完成的。

【参考方案2】：

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

【讨论】：

枚举添加对象列表后与gravaProcedimento()相同。