O Mamma.
Ma usare gli oggetti?
In questo modo non è l'utilizzatore che gestisce la memoria ma direttamente l'oggetto.
Mi piego.
".Create"
".Destroy"
servono a questo.
Se hai una catena di oggetti, basta che in ".Destroy" metti il codice che elimina il prossimo nodo.
if assigned(next) then
FreeAndNil(FNext);
Poi saranno affari del gestore dello heap a rilasciare correttamente la ram ;)
TProdotto = class(TObject)
protected
FPianta:string;
IDProdotto:string;
FQuantita:single;
FNext:TProdotto;
public
Constructor Create;
Destructor Destroy; override;
published
property Pianta: String;
property Quantita : Single;
Next : TProdotto;
end;
....
Constructor TProdotto.Create;
Begin
FPianta:='';
IDProdotto:='';
FQuantita:=0.0;
FNext:=nil;
End;
Destructor TProdotto.Destroy;
Begin
FPianta:='';
IDProdotto:='';
FQuantita:=0.0;
if Assigned(FNext) then FreeAndNil(FNext);
inherited Destroy;
End;
....
La butto lì senza nemmeno passare per l'ide ;)
Stilgar[/code]
Qui non compila.
Per il resto sei sulla strada giusto :D
Questa catena la devi gestire alla vecchia maniera. Tieni solo il primo oggetto referenziato. Poi sono affari suoi gestire il resto della catena.
Se vuoi farlo più ficaccione il codice :
property Next : TProdotto read getNext write setNext;
procedure TProdotto.setNext(value: TProdotto);
begin
if Assigned(fNext) then fNext.Next := Value
else
FNext := Value;
end;
In questo modo ottieni "gratis" la ricerca della coda. Metti l'ultimo next alla fine della catena.
Aggiungi che sfrutti lo stack per la ricerca della posizione. Meno cicli for e while ;)
Solo un if e un call.
Stilgar
function TProdotto.getNext : TProdotto;
begin
result := FNext;
end;
Non ricordo la shortcut .. ma c'è il modo di dire a Lazarus di fare il lavoro noioso al posto mio...
Crtl+O?
Possibbole?
Stilgar :p
OT: Inizio a sentire la primavera .. mo so affari vostri :D
Se non ti avesse dato errore mi sari incazzato con il compilatore... :D
Scommetto che si incazza perchè trova il valore NEXT non valorizzato.... o meglio valorizzato a pene segugiorum.
constructor TPianta.Create;
begin
FNomePianta:='';
FIDProdotto:='';
FQuantita:=0.0.;
FNext:=NIL;
// Non facciamo gli scansafatiche, impostiamo TUTTI i volori di default a mano. ;)
end;
//...
var TestaProdotti, ProdottoCursore : TProdotto;
//...
for i := 1 to numprod do //al 2° ciclo errore su
begin
ProdottoCursore.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString; 2° ciclo errore su
ProdottoCursore.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
ProdottoCursore := TProdotto.Create; // <----- SE NON LI CREI NON LI USI :D SE LI USI E NON LI CREI ... Buuum
TestaProdotti.Next := ProdottoCursore;
end;
Stilgar
OT: Come cantava?
Maledetta primavera?
allora di seguito la unit oggetto modificata. Mi manca come dicevo un passaggio e cioè il puntatore al primo elemento. In pratica riempo la lista e poi perdo l riferimento.
unit oggetti;
{$mode objfpc}{$H+}{$M+}
interface
uses
Classes, SysUtils;
type
{ TPianta }
TPianta=class(TObject)
private
procedure SetNomePianta(AValue: String);
protected
FNomePianta:string;
Fnext:TPianta;
public
Constructor Create;
Destructor Destroy; override;
published
Next : TPianta;
property NomePianta: String read FNomePianta write SetNomePianta;
end;
{ TProdotto }
TProdotto = class(TObject)
private
function GetFirst: TPRodotto;
procedure SetIDProdotto(AValue: String);
procedure SetNext(AValue: Tprodotto);
procedure SetNomePianta(AValue: String);
procedure SetQuantita(AValue: Single);
function GetNext:TProdotto;
protected
FNomePianta:string;
FIDProdotto:string;
FQuantita:single;
FNext:TProdotto;
FFirst:TProdotto;
public
Constructor Create;
Destructor Destroy; override;
published
property NomePianta: String read FNomePianta write SetNomePianta;
property IDProdotto: String read FIDProdotto write SetIDProdotto;
property Quantita : Single read FQuantita write SetQuantita;
property Next:Tprodotto read GetNext write SetNext;
property First:TPRodotto read GetFirst;
end;
implementation
{ TPianta }
procedure TPianta.SetNomePianta(AValue: String);
begin
if NomePianta=AValue then Exit;
FNomePianta:=AValue;
end;
constructor TPianta.Create;
begin
FNomePianta:='';
end;
destructor TPianta.Destroy;
begin
FNomePianta:='';
if Assigned(FNext) then FreeAndNil(FNext);
inherited Destroy;
end;
{ TProdotto}
procedure TProdotto.SetNomePianta(AValue: String);
begin
if FNomePianta=AValue then Exit;
FNomePianta:=AValue;
end;
function TProdotto.GetFirst: TPRodotto;
begin
metodo vuoto dato che non riueco a capire come restituire il primo elemento della lista
end;
procedure TProdotto.SetIDProdotto(AValue: String);
begin
if FIDProdotto=AValue then Exit;
FIDProdotto:=AValue;
end;
procedure TProdotto.SetNext(AValue: Tprodotto);
begin
if FNext=AValue then Exit;
FNext:=AValue;
end;
procedure TProdotto.SetQuantita(AValue: Single);
begin
if FQuantita=AValue then Exit;
FQuantita:=AValue;
end;
function TProdotto.GetNext: TProdotto;
begin
FNext:=TProdotto.Create;
result := FNext;
end;
constructor TProdotto.Create;
Begin
FNomePianta:='';
IDProdotto:='';
FQuantita:=0.0;
FNext:=nil;
End;
destructor TProdotto.Destroy;
Begin
FNomePianta:='';
IDProdotto:='';
FQuantita:=0.0;
if Assigned(FNext) then FreeAndNil(FNext);
inherited Destroy;
End;
end.
qui invece come viene richiamato l'oggetto
ProdottoCursore:=TProdotto.Create;
numprod:= THackGrid(DBGRTrattProdotti).VisibleRowCount;
//Getmem(prod,numprod*SizeOf(TProdotto) );
//inc(prod);
for i := 1 to numprod do
begin
ProdottoCursore.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString;
ProdottoCursore.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
dati.TTempTrattProdotti.Next;
ProdottoCursore := TProdotto.Create;
TestaProdotti.Next := ProdottoCursore;
Sicuramente la soluzione è lì ma io per poca conoscenza di questi meccanismi non la vedo
Per vitare la perdita della lista, piccolo trucchetto.
Fai una funzione al posto di una procedura.
Quando la richiami, crea e popola la lista.
L'utilizzatore poi ha in mano la testa della lista e ne farà quello che deve :D
Function TContenitore.carica: TProdotto;
var
ProdottoCursore : TProdotto;
numprod: integer;
begin
ProdottoCursore := TProdotto.Create;
Result := ProdottoCursore;
ProdottoCursore:=TProdotto.Create;
numprod:= THackGrid(DBGRTrattProdotti).VisibleRowCount;
for i := 1 to numprod do
begin
ProdottoCursore.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString;
ProdottoCursore.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
dati.TTempTrattProdotti.Next;
ProdottoCursore := TProdotto.Create;
Result.Next := ProdottoCursore;
End;
End;
Altra considerazione.
Semplifichi la lettura, ma da designer ho sempre qualche dubbio ;)
Questo oggetto è un oggetto di business, quindi potresti anche caricarlo della lettura e scrittuta sul dataset, a livello di competenze.
Quindi potresti mettere in piedi 2 metodilli carini.
Uno di lettura e uno di scrittura.
procedure TProdotto.LoadFromDataSet(const ds : TDataSet);
begin
FIDProdotto := ds.FieldByName('Prodotto').asString;
FQuantita:= ds.FieldByName('FDQuantita').asFloat;
end;
procedure TProdotto.SaveToDataSet(const ds : TDataSet);
begin
try
ds.edit;
ds.FieldByName('Prodotto').asString := FIDProdotto ;
ds.FieldByName('FDQuantita').asFloat := FQuantita;
ds.post;
except
on E : Exception do
raise EProdottoPersistenceServiceException .Create("Errore in salvataggio dei dati", e);
end;
end;
Type
EProdottoPersistenceServiceException = class(Exception)
protected
FCause : Exception;
public
constructor Create(messageValue: String; causeValue : Exception=null);
property Cause : Exception read FCause;
end;
constructor EProdottoPersistenceServiceException .Create(messageValue: String; causeValue : Exception);
begin
inherited Create(messageValue);
FCause := causeValue;
end;
Il getFirst nei nodi...a cosa ti serve?
Se ti serve a puntare alla testa della lista ...
Consumi ram per nulla.
Se vuole essere il nodo precedente, bene.
Non è una lista "semplice" ma "doppia" e mi torna ;)
Stilgar
Nente la lista si perde comunque. Se per maggiore precisione in ptatica richiamo la funzikone da un pulsante questo è il codice
procedure TFPrincipale.SpeedButton1Click(Sender: TObject);
var
recprod:TProdotto;
s:string;
begin
recprod:=CaricaProdotti;
s:=recprod.Next.IDProdotto;
Ti allego nuovamente tutto il codice
:'(
(*-----------------UNIT OGGETTI -----------*)
unit oggetti;
{$mode objfpc}{$H+}{$M+}
interface
uses
Classes, SysUtils;
type
{ TPianta }
TPianta=class(TObject)
private
procedure SetNomePianta(AValue: String);
protected
FNomePianta:string;
Fnext:TPianta;
public
Constructor Create;
Destructor Destroy; override;
published
Next : TPianta;
property NomePianta: String read FNomePianta write SetNomePianta;
end;
{ TProdotto }
TProdotto = class(TObject)
private
function GetFirst: TPRodotto;
procedure SetIDProdotto(AValue: String);
procedure SetNext(AValue: Tprodotto);
procedure SetNomePianta(AValue: String);
procedure SetQuantita(AValue: Single);
function GetNext:TProdotto;
protected
FNomePianta:string;
FIDProdotto:string;
FQuantita:single;
FNext:TProdotto;
FFirst:TProdotto;
public
Constructor Create;
Destructor Destroy; override;
published
property NomePianta: String read FNomePianta write SetNomePianta;
property IDProdotto: String read FIDProdotto write SetIDProdotto;
property Quantita : Single read FQuantita write SetQuantita;
property Next:Tprodotto read GetNext write SetNext;
property First:TPRodotto read GetFirst;
end;
implementation
{ TPianta }
procedure TPianta.SetNomePianta(AValue: String);
begin
if NomePianta=AValue then Exit;
FNomePianta:=AValue;
end;
constructor TPianta.Create;
begin
FNomePianta:='';
end;
destructor TPianta.Destroy;
begin
FNomePianta:='';
if Assigned(FNext) then FreeAndNil(FNext);
inherited Destroy;
end;
{ TProdotto}
procedure TProdotto.SetNomePianta(AValue: String);
begin
if FNomePianta=AValue then Exit;
FNomePianta:=AValue;
end;
function TProdotto.GetFirst: TPRodotto;
begin
end;
procedure TProdotto.SetIDProdotto(AValue: String);
begin
if FIDProdotto=AValue then Exit;
FIDProdotto:=AValue;
end;
procedure TProdotto.SetNext(AValue: Tprodotto);
begin
if FNext=AValue then Exit;
FNext:=AValue;
end;
procedure TProdotto.SetQuantita(AValue: Single);
begin
if FQuantita=AValue then Exit;
FQuantita:=AValue;
end;
function TProdotto.GetNext: TProdotto;
begin
FNext:=TProdotto.Create;
result := FNext;
end;
constructor TProdotto.Create;
Begin
FNomePianta:='';
IDProdotto:='';
FQuantita:=0.0;
FNext:=nil;
End;
destructor TProdotto.Destroy;
Begin
FNomePianta:='';
IDProdotto:='';
FQuantita:=0.0;
if Assigned(FNext) then FreeAndNil(FNext);
inherited Destroy;
End;
end.
(*--------------------------Funzione Carica Prodotti------------------------*)
function TFPrincipale.CaricaProdotti:TProdotto;
var
mempos,s:string;
ProdottoCursore : TProdotto;
begin
try
ProdottoCursore := TProdotto.Create;
Result := ProdottoCursore;
dati.TTempTrattProdotti.DisableControls;
dati.TTempTrattProdotti.Filtered:=true;
dati.TTempTrattProdotti.First;
while not dati.TTempTrattProdotti.eof do
begin
ProdottoCursore.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString;
ProdottoCursore.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
dati.TTempTrattProdotti.Next;
ProdottoCursore := TProdotto.Create;
Result.Next := ProdottoCursore;
end;
finally
dati.TTempTrattProdotti.Filtered:=False;
dati.TTempTrattProdotti.Locate('Prodotto',mempos,[]);
dati.TTempTrattProdotti.EnableControls;
end;
end;
while not dati.TTempTrattProdotti.eof do
begin
ProdottoCursore.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString;
ProdottoCursore.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
dati.TTempTrattProdotti.Next;
ProdottoCursore.Next := TProdotto.Create;
ProdottoCursore:=ProdottoCursore.Next;
end;
finally