Оптимизация кода. Или, как сделать более легкую программу?

procedure TForm1.Button1Click(Sender: TObject);
Type
  TArrayOfInteger = Array Of Integer;
Var
  sl,sl1,sk1 : TStringList;
  i,j,n,z,tim,timee,timerr : Integer;
  Arr : Array[0..9999] Of LongWord;
  s : String;
  ArrIndex : TArrayOfInteger;
//-------------------------------------------------------------
//BegNesting - Количество вложений (нужное)
//CurNesting - Текущее вложение (при передаче уменьшается)
//Index - Индекс с которого начинать поиск
//ResComparison - результат сравнения на предыдущих уровнях
//AccumulStr - строка, накапливающая результат
//ArrIndex - Массив для передачи индексов выбранных элементов с уровня на уровень
Function FindHit(BegNesting,CurNesting:Byte;Index:Integer;
         ResComparison:LongWord;AccumulStr:String;Var ArrIndex:TArrayOfInteger):Boolean;
Var
  i,j,n,t,tZ : Integer;
  a,b : LongWord;
  s : String;
Begin
  Result:=False;
  SetLength(ArrIndex,Length(ArrIndex)+1);
  For i:=Index To sl.Count-CurNesting Do
  If Arr[i]<>$FFFFFFF Then
  Begin
    Result:=False;
    If CurNesting=BegNesting Then
    ProgressBar1.Position:=i;
 
    a:=ResComparison;
    If Index<>0 Then
    Begin
      a:=ResComparison Or (Arr[Index-1] Xor Arr[i]);
      tZ:=0;
      b:=$F;
      For t:=1 to 7 do     {окончательное сравнивание}
      Begin
        If (a And b)=0 Then tZ:=tZ+1;
        If tZ>=Z then Break;
        If (tZ+(7-t))<Z Then Break;
        b:=b Shl 4;
      End;
      if tZ<Z then Continue;
    End;
 
    ArrIndex[High(ArrIndex)]:=i;
 
    s:=sl[i];
    If AccumulStr<>'' Then s:='-|-'+s;
 
    If CurNesting=1 Then
    {условие, если найдено ,что совпали на всех уровнях}
    Begin
      sl1.Add(AccumulStr+s);
      Timee:=Timee+1;
      Edit3.Text:=IntToSTR(timee);
      For j:=0 To High(ArrIndex) Do
      Begin
        n:=sk1.IndexOf(sl[ArrIndex[j]]);
        If n>=0 Then sk1.Delete(n);
        Arr[ArrIndex[j]]:=$FFFFFFF;
      End;
      Result:=True;
      Break;
    End;
 
    Result:=FindHit(BegNesting,CurNesting-1,i+1,a,AccumulStr+s,ArrIndex);
 
    If Result And (CurNesting<>BegNesting) Then Break;
 
    Application.ProcessMessages; //Чтобы форма не зависала
    If EndProcess Then Break;
  End;
  SetLength(ArrIndex,Length(ArrIndex)-1);
End;
//-------------------------------------------------------------
begin
image3.Visible:=false;
Image5.Visible:=true;
  sl:=TStringList.Create;
  sl.LoadFromFile(
  ExtractFilePath(Application.ExeName)+'inGos.txt');
 
  ProgressBar1.Max:=sl.Count-16;
  ProgressBar1.Position:=0;
 
  z:=StrToIntDef(Edit1.Text,3); //Количество знаков совпадения
  If z>7 Then z:=7;
  If z=0 Then z:=1;
  Edit1.Text:=IntToStr(z);
  //Обработка...
 
  //Находим все обрабатываемые части текста
  i:=0;
  While i<sl.Count Do
  Begin
    j:=Pos('g ',sl[i]);
    If j=0 Then
    Begin
      sl.Delete(i);
      Continue;
    End;
    s:=Copy(sl[i],j+2,7); //Взяли только рабочую часть
    //Занесём данное в массив, преобразовав в число (двоично-десятичный формат)
    Arr[i]:=0;
    For n:=1 To 7 Do
    Begin
      Arr[i]:=Arr[i] Shl 4;
      Arr[i]:=Arr[i] Or (Ord(s[n])-Ord('0'));
    End;
 
    //Избавимся от лишних символов в строке
    s:='';
    For n:=1 To Length(sl[i]) Do
    If sl[i][n] In ['g','0'..'9',';',','] Then
    s:=s+sl[i][n];
    sl[i]:=s;
 
    Edit2.Text:=IntToStr(sl.count);
    Inc(i);
  End;
 
  sk1:=TStringList.Create;
  sk1.Assign(sl);
 
  sl1:=TStringList.Create;
 
  EndProcess:=False;
  SetLength(ArrIndex,0);
  FindHit(16,16,0,0,'',ArrIndex);
  Finalize(ArrIndex);
 
  sl1.SaveToFile(ExtractFilePath(Application.ExeName)+'OutGos'+IntToStr(z)+'.txt');
  sk1.SaveToFile(ExtractFilePath(Application.ExeName)+'Outgosfull.txt');
  Edit4.Text:=IntToStr(sl1.Count);
  sl1.Free;
  sl.Free;
  sk1.free;
end;