Search code examples
oopdelphifiremonkey

Object within another Object not persisting between units Delphi

Sorry if this question is a duplicate but I couldn't find any solution to my problem anywhere... The code below shows how I'm assigning values from a listview into an object that is a property of another object:

Main Unit:

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

Before the command DM.gravaProcedimento(Procedimento); the produto is correctly being added to the TObjectList of TProcedimento, I can get its contents correctly with Procedimento.GetPRC_Produtos. But when I debug the next unit shown below, its getting random IDs that means its not being persisted from one unit to the other:

unit 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;

This is the class definition of my objects:

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.

Any particular reason why this is happening? What am I doing wrong here?

Solution

  • The problem is that you are destroying the TItemProcedimento objects before gravaProcedimento() has a chance to use them.

    You are calling Produto.DisposeOf() immediately after Procedimento.AddPRC_Produtos(Produto) exits, and also in gravaProcedimento(), too. DO NOT DO THAT!

    AddPRC_Produtos() saves the original Produto object into a TObjectList, which takes ownership of the object (as TObjectList is set to OwnsObjects=True by default). That means the object will be destroyed automatically when it is removed from the list, which includes when the list is cleared or destroyed.

    So, you need to get rid of your DisposeOf() calls completely.

    Also, you need to get rid of the call to TItemProcedimento.Create in gravaProcedimento(), too. It does not belong there. All you are doing by that is creating a memory leak on non-ARC systems.

    It seems you do not have a firm grasp of how Delphi object lifetimes actually work. You DO NOT need to call Create on an object variable before assigning an object instance to it. And you DO NOT need to call DisposeOf() on an object variable when you are doing using the variable, only when you are done using the object itself (which TObjectList will handle for you).

    Try this instead:

    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;