Como arrumar o justificar do memo?

Ola amigos, eh o seguinte estou tentando fazer com que justifique um memo no meu programa ai fiz assim, criei um botao chamado bitbtn1 e um memo chamado me1 e logo abaixo como foi feito:

unit Unit1;


interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ComCtrls, Menus;

type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
me1: TMemo;
PopupMenu1: TPopupMenu;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }

public
{ Public declarations }

end;

var
Form1: TForm1;

implementation
function LargTexto(texto : string; f : TFont) : integer;
var
aux : TFont;
begin
aux:=Screen.ActiveForm.Canvas.font;
Screen.ActiveForm.Canvas.font:=f;
result:=Screen.ActiveForm.Canvas.textwidth(texto);
Screen.ActiveForm.Canvas.font:=aux;
end;

function Distancia(a,b : integer) : integer;
begin
result:=abs(a-b);
end;

function MenorEspacoEntrePalavras(cad : string) : integer;
var
menor,atual,i : integer;
espaco : boolean;
begin
atual:=0;
menor:=50;
result:=0;
espaco:=false;
for i:=1 to length(cad) do
begin
if cad=´ ´ then
begin
if espaco then
atual:=atual+1
else begin
espaco:=true;
atual:=1;
end;
end else
if espaco then
begin
espaco:=false;
if atual <> menor then
begin
menor:=atual;
result:=i-atual;
atual:=0;
end;
end;
end;
end;

{$R *.DFM}
procedure Justifica(texto : tstrings; fonte : TFont; ancho : integer);
var i : integer;
aux : string;
begin
for i:=0 to texto.count-1 do
while Distancia(LargTexto(texto,fonte),ancho)>10 do
begin
aux:=texto;
Insert(´ ´,aux,MenorEspacoEntrePalavras(aux));
texto:=aux;
End;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Justifica(mE1.LINES,mE1.font,mE1.width);
end;

end.


So que ele justifica tudo mesmo quando termina no meio da frase ele justifica, ou uma frase pequena ele justifica tambem, alguem sabe como fazer isso?

Agradeço a atençao!

Adriano.