TObjectList consome muita memória

Estou desenvolvendo em Delphi OO, e tenho encontrado problemas com o TObjectList, que está consumindo muita memória e não consigo descarregar, conforme exemplo abaixo.


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Contnrs, StdCtrls, Buttons, Grids;

type

TCliente = class(TObject)
private
fnome: string;
fcodigo: integer;
ftexto: string;
public
destructor Destroy; override;
published
property codigo: integer read fcodigo write fcodigo;
property nome: string read fnome write fnome;
property texto: string read ftexto write ftexto;
end;

TClienteController = class
private
fLista: TObjectList;
public
procedure MontaLista(qt: integer);
procedure AfterConstruction; override;
destructor Destroy; override;
published
property Lista: TObjectList read fLista write flista;
end;

TForm1 = class(TForm)
StringGrid1: TStringGrid;
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TClienteController }

procedure TClienteController.AfterConstruction;
begin
inherited;
fLista := TObjectList.Create;
end;

destructor TClienteController.Destroy;
var i: integer;
begin
for i := Pred(Lista.Count) downto 0 do
begin
Lista.items[i] := nil;
Lista.delete(i);
end;
inherited Destroy;
end;

procedure TClienteController.MontaLista(qt: integer);
var i: integer;
cli: TCliente;
begin
for i := 1 to qt do
begin
cli := TCliente.Create;
cli.codigo := i;
cli.nome := CLIENTE +FormatCurr(000000, i);
cli.texto := StringofChar(A, 10000);
Lista.Add(cli);
end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var i: integer;
//n: string;
begin
//n := InputBox(Montar lista, Quantidade, 100);
with TClienteController.Create do
begin
MontaLista(100000);
//MontaLista(StrToInt(n));
for i := 0 to Lista.Count - 1 do
with StringGrid1 do
begin
RowCount := Lista.Count + 1;
Cells[0, i + 1] := FormatCurr(00000, TCliente(Lista[i]).codigo);
Cells[1, i + 1] := TCliente(Lista[i]).nome;
Cells[2, i + 1] := TCliente(Lista[i]).texto;
end;
Free();
end;
ShowMessage(Concluído!);
end;

{ TCliente }

destructor TCliente.Destroy;
begin
inherited Destroy;
end;

end.



//FORMULÁRIO

object Form1: TForm1
Left = 192
Top = 112
Width = 783
Height = 540
Caption = Form1
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = MS Sans Serif
Font.Style = []
OldCreateOrder = False
DesignSize = (
767
502)
PixelsPerInch = 96
TextHeight = 13
object StringGrid1: TStringGrid
Left = 24
Top = 16
Width = 729
Height = 441
Anchors = [akLeft, akTop, akRight, akBottom]
ColCount = 3
TabOrder = 0
ColWidths = (
64
226
401)
end
object BitBtn1: TBitBtn
Left = 24
Top = 464
Width = 75
Height = 25
Caption = BitBtn1
TabOrder = 1
OnClick = BitBtn1Click
end
end