Fórum [Delphi] - Erro Classe com Array de uma outra Classe #604146

unit ClasseTags;

interface

uses
  System.SysUtils;

type
  TTag = class
  private
    fId: string;
    fNome: string;
    fTexto: string;
    fOrigem: string;
    fConta: string;
    fProduto_tipo: string;
    fNivel: string;
    fExpr: string;
    fEmpresas: array of String;
    fValores: array of Double;
    fTotal: Double;
//    fNode: PVirtualNode;
  protected
    function GetEmpresa(Row:Integer):String;
    procedure SetEmpresa(Row:Integer; Value:String);
    function GetValor(Row:Integer):Double;
    procedure SetValor(Row:Integer; Value:Double);
  public
    constructor Create; overload;
    property Id: string read fId write fId;
    property Nome: string read fNome write fNome;
    property Texto: string read fTexto write fTexto;
    property Origem: string read fOrigem write fOrigem;
    property Conta: string read fConta write fConta;
    property Produto_tipo: string read fProduto_tipo write fProduto_tipo;
    property Nivel: string read fNivel write fNivel;
    property Expr: string read fExpr write fExpr;
    property Empresas[row:Integer]: string read GetEmpresa write SetEmpresa;
    property Valores[row:Integer]: double read GetValor write SetValor;
    property Total: double read fTotal write fTotal;
//    property Node: PVirtualNode read fNode write fNode;
    procedure AddEmpresa(Empresa: string);
    procedure RemoveEmpresa(row: integer);
  end;

  TTags = class
  private
    fNome: string;
    fTag: array of TTag;
    fObs: string;
    fCount: integer;
  protected
    function GetTag(row: integer): TTag;
    procedure SetTag(row: integer; Value: TTag);
  public
    constructor Create; overload;
    property Nome :String read fNome write fNome;
    property Tag[row:Integer]: TTag read GetTag write SetTag; default;
    property Obs :String read fObs write fObs;
    property Count: integer read fCount;
    function Add: TTag;
    procedure Remove(row:Integer);
  end;

implementation

{ TTag }

procedure TTag.AddEmpresa(Empresa: string);
begin
  // adiciona uma empresa na lista de empresas
  SetLength(FEmpresas, Length(FEmpresas)+1);
  FEmpresas[Length(FEmpresas)-1] := Empresa;
end;

constructor TTag.Create;
begin
  inherited;

  // inicializa o que for necessário
  fTotal := 0;
end;

function TTag.GetEmpresa(Row: integer): string;
begin
  Result := fEmpresas[Row];
end;

function TTag.GetValor(Row: integer): Double;
begin
  Result := fValores[Row];
end;

procedure TTag.RemoveEmpresa(row: integer);
begin
  try
    Delete(fEmpresas, row, 1);
    SetLength(fEmpresas, Length(fEmpresas)-1);
  except
    // mostra a mensagem caso o elemento não exista
    on e:exception do
      raise Exception.Create(e.Message);
  end;
end;

procedure TTag.SetEmpresa(Row: integer; Value: string);
begin
  fEmpresas[Row] := Value;
end;

procedure TTag.SetValor(Row: integer; Value: Double);
begin
  fValores[Row] := Value;
end;

{ TTags }

function TTags.Add: TTag;
var
  tag: TTag;
begin
  Inc(fCount); // incrementa o número de tags
  SetLength(fTag, fCount);
  fTag[fCount-1] := TTag.Create;
  Result := fTag[Length(fTag)];
end;

constructor TTags.Create;
begin
  inherited;

  // inicializa o que for necessário
  fNome := '';
  fObs := '';
  fCount := 0;
end;

function TTags.GetTag(row: integer): TTag;
begin
  try
    Result := fTag[Row];
  except
    // mostra a mensagem caso o elemento não exista
    on e:exception do
      raise Exception.Create(e.Message);
  end;
end;

procedure TTags.Remove(row: integer);
begin
  try
    // só pode atribuir o conteúdo a um elemento existente
    fTag[row] := nil;
    Delete(fTag, row, 1);
    SetLength(fTag, Length(fTag)-1);
    Dec(fCount); // decrementa o número de tags
  except
    // mostra a mensagem caso o elemento não exista
    on e:exception do
      raise Exception.Create(e.Message);
  end;
end;

procedure TTags.SetTag(row: integer; Value: TTag);
begin
  try
    // só pode atribuir o conteúdo a um elemento existente
    fTag[row] := Value
  except
    // mostra a mensagem caso o elemento não exista
    on e:exception do
      raise Exception.Create(e.Message);
  end;
end;

end.

var tags: TTags;
begin
  tags := TTags.Create;
  showmessage( 'qtd.tags: '+inttostr(tags.Count) );

  tags.Add;
  tags[tags.Count-1].Nome := 'teste1';
  showmessage( 'qtd.tags: '+inttostr(tags.Count)+'   -   '+tags.Tag[tags.Count-1].Nome+' é o nome do elemento'+inttostr(tags.Count-1) );

  tags.Add;
  tags[tags.Count-1].Nome := 'teste2';
  showmessage( 'qtd.tags: '+inttostr(tags.Count)+'   -   '+tags.Tag[tags.Count-1].Nome+' é o nome do elemento'+inttostr(tags.Count-1) );
end;