Hi,
I am facing a problem and need help.
When I use TBufDataSet together with a DBGrid, after inserting items and deallocating the memory with the Free command, the RAM does not decrease.
What can it be?
unit datamodule;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, DB, BufDataset, memds, fpjsondataset;
type
{ TDm }
TDm = class(TDataModule)
dsTeste: TDataSource;
JSONDataSet1: TJSONDataSet;
JSONDataSet2: TJSONDataSet;
procedure DataModuleCreate(Sender: TObject);
private
FtbBuf: TBufDataset;
FtbMemBuf: TMemDataset;
FtbListBuf: TStringList;
public
procedure DoClearBufDataSet(ADataSet: TBufDataSet);
procedure DoClearMemDataSet(ADataSet: TMemDataset);
procedure ObterDadosBuf();
procedure ObterDadosMemBuf();
procedure ObterDadosListBuf();
procedure DoClearListDataSet(ADataSet: TStringList);
procedure Destruir();
property tbBuf : TBufDataSet read FtbBuf write FtbBuf;
property tbMemBuf : TMemDataset read FtbMemBuf write FtbMemBuf;
property tbListBuf : TStringList read FtbListBuf write FtbListBuf;
end;
var
Dm: TDm;
implementation
{$R *.lfm}
procedure TDm.ObterDadosBuf;
var
i : Integer;
begin
try
FtbBuf := TBufDataSet.Create(nil);
FtbBuf.FieldDefs.Add('col_descr_qtd', ftString, 30);
FtbBuf.FieldDefs.Add('seqcontrole', ftInteger);
dsTeste.DataSet := FtbBuf;
i := 0;
while (i < 10000) do
begin
if not FtbBuf.Active then
FtbBuf.CreateDataset;
FtbBuf.Open;
FtbBuf.First;
FtbBuf.Insert;
FtbBuf.FieldByName('seqcontrole').Value := 0;
FtbBuf.FieldByName('col_descr_qtd').Value := Concat('00','teste','00');
FtbBuf.FieldByName('seqcontrole').Value := 1;
FtbBuf.FieldByName('col_descr_qtd').Value := Concat('01','teste','01');
FtbBuf.FieldByName('seqcontrole').Value := 2;
FtbBuf.FieldByName('col_descr_qtd').Value := Concat('02','teste','02');
FtbBuf.FieldByName('seqcontrole').Value := 3;
FtbBuf.FieldByName('col_descr_qtd').Value := Concat('03','teste','03');
FtbBuf.Post;
i := i + 1;
end;
finally
//DoClearBufDataSet(FtbBuf);
end;
end;
procedure TDm.ObterDadosMemBuf;
var
i : Integer;
begin
try
if not Assigned(FtbMemBuf) then
begin
FtbMemBuf := TMemDataset.Create(nil);
FtbMemBuf.FieldDefs.Add('col_descr_qtd', ftString, 30);
FtbMemBuf.FieldDefs.Add('seqcontrole', ftInteger);
dsTeste.DataSet := tbMemBuf;
end;
i := 0;
while (i < 10000) do
begin
FtbMemBuf.Open;
FtbMemBuf.First;
FtbMemBuf.Append;
FtbMemBuf.FieldByName('seqcontrole').Value := 0;
FtbMemBuf.FieldByName('col_descr_qtd').Value := Concat('00','teste','00');
FtbMemBuf.FieldByName('seqcontrole').Value := 1;
FtbMemBuf.FieldByName('col_descr_qtd').Value := Concat('01','teste','01');
FtbMemBuf.FieldByName('seqcontrole').Value := 2;
FtbMemBuf.FieldByName('col_descr_qtd').Value := Concat('02','teste','02');
FtbMemBuf.FieldByName('seqcontrole').Value := 3;
FtbMemBuf.FieldByName('col_descr_qtd').Value := Concat('03','teste','03');
FtbMemBuf.Post;
i := i + 1;
end;
finally
//DoClearMemDataSet(FtbMemBuf);
end;
end;
procedure TDm.ObterDadosListBuf();
var
i : Integer;
begin
try
FtbListBuf := TStringList.Create;
i := 0;
while (i < 1000) do
begin
FtbListBuf.Add('0' + IntToStr(i));
i := i + 1;
end;
finally
end;
end;
procedure TDm.DoClearListDataSet(ADataSet: TStringList);
begin
end;
procedure TDm.Destruir;
begin
if Assigned(FtbBuf) then begin
FtbBuf.Fields.Clear;
FtbBuf.FieldDefs.Clear;
FreeAndNil(FtbBuf);
end;
if Assigned(FtbMemBuf) then begin
FtbMemBuf.Fields.Clear;
FtbMemBuf.FieldDefs.Clear;
FreeAndNil(FtbMemBuf);
end;
end;
procedure TDm.DataModuleCreate(Sender: TObject);
begin
end;
procedure TDm.DoClearBufDataSet(ADataSet: TBufDataSet);
begin
with ADataSet do
begin
try
First;
DisableControls;
while not EoF do
Delete;
finally
EnableControls;
end;
end;
end;
procedure TDm.DoClearMemDataSet(ADataSet: TMemDataset);
begin
with ADataSet do
begin
try
First;
DisableControls;
while not EoF do
Delete;
finally
EnableControls;
end;
end;
end;
end.
Recent
