另一个对象中的对象在单元Delphi

编程问答 2022-08-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.

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

解决方法

问题是您正在{em}摧毁 TItemProcedimento对象，而gravaProcedimento()才有机会使用它们。

您将在Produto.DisposeOf()退出后立即呼叫Procedimento.AddPRC_Produtos(Produto)，也在gravaProcedimento()中呼叫。 不要这样做！

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

因此，您需要完全摆脱DisposeOf()通话。

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

似乎您对Delphi对象生存期的实际工作方式并不完全了解。在为对象实例分配对象之前，无需在对象变量上调用Create。而且，在使用变量时，无需在对象变量上调用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;
,

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

delphifiremonkey