Бинарный поиск в Memo

[Stranger333]

У меня бинарной поиск работает хорошо если наперед известно количество слов в Мемо. Но я хочу загружать текст в Мемо, тоесть наперед не известно количество слов. Я для массива слов использую SetLength... Только когда я использую эту процедуру у меня не идет сортировка или сам же поиск. Вот код посмотрите, где же я ошибся

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ToolWin;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Memo2: TMemo;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function cutter(s:string;p1:integer;p2:integer):string;
var r:string;
i:integer;
begin
r:='';
if ((p1=p2)OR(p1<p2)) then result:= r; 
 for i:= p1 to p2 do
     r:=r+s[i];   
 result:= r;
end;

procedure Analiz(s:string);
var k,i,j,q,sl:integer;  a:array[1..6] of string;
w,s1,x:string;
fl:boolean;
label Kilkist;
begin
k:=1;
i:=1;
j:=1;
sl:=1;
while i<=length(s) do
  begin
  if s[i] in ['.',',',' ','!','?',#10,#13] then
    begin
    w:=cutter(s,k,i-1);  
    SetLength(a,sl+j);
    a[j]:=w;
    j:=j+1;
    repeat   
      k:=i+1;
      i:=i+1;
    until not (s[k] in ['.',',',' ','!','?',#10,#13] );
    end;
    i:=i+1;
   end;
   SetLength(a,sl);
   q:=0;
Kilkist:   for i:=1 to 5{Length(a)-1} do
 for k:=i downto 1 do
    if a[k]>a[k+1] then
        begin
             x:=a[k];
             a[k]:=a[k+1];
             a[k+1]:=x;
        end;
    x:=Form1.Edit1.Text;
 i := 0;  { индекс перед первым элементом массива }
  j :=Length(a)+ 1;  { индекс после последнего элемента массива }

  while i < j - 1 do begin
    { ищем элемент на интервале индексов от i до j, не включая i и j }
    k := (i + j) div 2;  { k = элемент посередине интервала }
    if x >= a[k] then
      i := k
    else
      j := k;
  end;
  if (i > 0) and (a[i] = x) then begin
    { элемент найден }
    q:=q+1;
    a[i]:=' ';
    goto Kilkist;

  end;


  if q>0 then begin
       with Form1.Memo2.Lines do
    begin
      Add(x + ' втречается ' + IntToStr(q) + 'раз');
    end;
    end
    else
       with Form1.Memo2.Lines do
    begin
      Add('Ничего не найдено');
    end;

end;



procedure TForm1.Button1Click(Sender: TObject);
var i,k1,k2,max:integer;
begin
  Memo2.Lines.Clear;
  with Memo1 do
  begin
    k1 := Length(Lines[0]);
    for i:=0 to Lines.Count-1 do
    begin
      k2 := Length(Lines[i]);
      if k1>k2 then max:=k1 else
      begin
        max:=k2;
        k1:=k2;
      end;
    end;
    for i:=1 to max-1 do
    Lines.Text := StringReplace(Lines.Text,'  ',' ',[rfReplaceAll]);
    Lines.Text := StringReplace(Lines.Text,#10+' ','',[rfReplaceAll]);
  end;
  Analiz(Memo1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

end.