Как закрыть приложение, которое находится в процессе выполнения алгоритма?

procedure WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer; closebool: boolean);

closebool: boolean
procedure WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
begin
   if closebool then
end;

TForm1 = class(TForm)
  procedure WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
 
procedure TForm1.ExitBClick(Sender: TObject);
begin
  Closebool := true;
  Application.Terminate;
end;
 
procedure TForm1.WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
var
  sl, sl2{, sl3}: TStringList;
  i, j:integer;
  vr: string;
begin
  Sl2 := TStringList.Create;
  Sl2.Text := Memo.Text;
  //Sl3 := TStringList.Create;
  //Sl3.Text := Mr.Text;
  Sl := TStringList.Create;
  //SL.Sorted := true;
  SL2.Duplicates := dupIgnore;
  Sl.Text := M.Text;
  T.Max := Sl.Count -1;
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  for i := i_n to Sl.Count-2 do
  begin
    if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
      Mr.Lines.Add(SL[i+1])
    else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
    begin
      Mr.Lines.Add(SL[i+1]);
      vr:=Mr.Lines.Strings[0];
      Mr.Lines.Delete(0);
      T2.Max := Sl2.Count-1;
      for j := 0 to Sl2.Count-1 do
      begin
        T2.Position := j;
        SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
        if j mod 10 = 0 then
        begin
          Memo.Text := SL2.Text;
          Application.ProcessMessages;
        end;
      end;
      Mr.Lines.Clear;
    end
    else
    begin
      if Mr.Lines.Count > 1 then
      begin
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        T2.Max := Sl2.Count-1;
        for j := 0 to Sl2.Count-1 do
        begin
          T2.Position := j;
          SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
          if j mod 10 = 0 then
          begin
            Memo.Text := SL2.Text;
            Application.ProcessMessages;
          end;
        end;
        if closebool then
          break;
      end;
      Mr.Lines.Clear;
      Mr.Lines.Add(SL[i+1]);
    end;
    T.Position := i;
    if closebool then
      break;
  end;
 
  Memo.Text := SL.Text;
  FreeAndNil(SL2);
  //FreeAndNil(Sl3);
  FreeAndNil(SL);
    if closebool then
      Application.Terminate;
end;

var
  ForceExit: boolean;
 
procedure proc;
begin
  while not ForceExit do
  begin
    // do smt.
  end;
end;

procedure TForm1.WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
var
  sl, sl2{, sl3}: TStringList;
  i, j:integer;
  vr: string;
begin
  Sl2 := TStringList.Create;
  Sl2.Text := Memo.Text;
  //Sl3 := TStringList.Create;
  //Sl3.Text := Mr.Text;
  Sl := TStringList.Create;
  //SL.Sorted := true;
  SL2.Duplicates := dupIgnore;
  Sl.Text := M.Text;
  T.Max := Sl.Count -1;
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  while not Closebool do
  begin
    for i := i_n to Sl.Count-2 do
    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
        Mr.Lines.Add(SL[i+1])
      else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
      begin
        Mr.Lines.Add(SL[i+1]);
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        T2.Max := Sl2.Count-1;
        for j := 0 to Sl2.Count-1 do
        begin
          T2.Position := j;
          SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
          if j mod 10 = 0 then
          begin
            Memo.Text := SL2.Text;
            Application.ProcessMessages;
          end;
          if closebool then
            break;
        end;
        Mr.Lines.Clear;
      end
      else
      begin
        if Mr.Lines.Count > 1 then
        begin
          vr:=Mr.Lines.Strings[0];
          Mr.Lines.Delete(0);
          T2.Max := Sl2.Count-1;
          for j := 0 to Sl2.Count-1 do
          begin
            T2.Position := j;
            SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
            if j mod 10 = 0 then
            begin
              Memo.Text := SL2.Text;
              Application.ProcessMessages;
            end;
          end;
          if closebool then
            break;
        end;
        Mr.Lines.Clear;
        Mr.Lines.Add(SL[i+1]);
      end;
      T.Position := i;
      if closebool then
        break;
    end;
  end;
 
  Memo.Text := SL.Text;
  FreeAndNil(SL2);
  //FreeAndNil(Sl3);
  FreeAndNil(SL);
  {  if closebool then
      Application.Terminate;  }
end;

procedure TForm1.WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
var
  sl, sl2{, sl3}: TStringList;
  i, j:integer;
  vr: string;
  b: boolean;
begin
  Sl2 := TStringList.Create;
  Sl2.Text := Memo.Text;
  //Sl3 := TStringList.Create;
  //Sl3.Text := Mr.Text;
  Sl := TStringList.Create;
  //SL.Sorted := true;
  SL2.Duplicates := dupIgnore;
  Sl.Text := M.Text;
  T.Max := Sl.Count -1;
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  b := false;
  while (not Closebool) and (not b) do
  begin
    for i := i_n to Sl.Count-2 do
    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
        Mr.Lines.Add(SL[i+1])
      else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
      begin
        Mr.Lines.Add(SL[i+1]);
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        T2.Max := Sl2.Count-1;
        for j := 0 to Sl2.Count-1 do
        begin
          T2.Position := j;
          SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
          if j mod 10 = 0 then
          begin
            Memo.Text := SL2.Text;
            Application.ProcessMessages;
          end;
          if closebool then
            break;
        end;
        b:=true;
        Mr.Lines.Clear;
      end
      else
      begin
        if Mr.Lines.Count > 1 then
        begin
          vr:=Mr.Lines.Strings[0];
          Mr.Lines.Delete(0);
          T2.Max := Sl2.Count-1;
          for j := 0 to Sl2.Count-1 do
          begin
            T2.Position := j;
            SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
            if j mod 10 = 0 then
            begin
              Memo.Text := SL2.Text;
              Application.ProcessMessages;
            end;
          end;
          if closebool then
            break;
        end;
        Mr.Lines.Clear;
        Mr.Lines.Add(SL[i+1]);
      end;
      T.Position := i;
      if closebool then
        break;
    end;
  end;
 
  Memo.Text := SL.Text;
  FreeAndNil(SL2);
  //FreeAndNil(Sl3);
  FreeAndNil(SL);
  {  if closebool then
      Application.Terminate;  }
end;

procedure TForm1.WordReplaceP (M, M2, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
var
  sl, sl2{, sl3}: TStringList;
  i, j:integer;
  vr: string;
  b: boolean;
begin
  Sl2 := TStringList.Create;
  Sl2.Text := M2.Text;
  //Sl3 := TStringList.Create;
  //Sl3.Text := Mr.Text;
  Sl := TStringList.Create;
  //SL.Sorted := true;
  SL2.Duplicates := dupIgnore;
  Sl.Text := M.Text;
  T.Max := Sl.Count -1;
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  b := false;
  while (not Closebool) or (not b) do
  begin
    for i := i_n to Sl.Count-2 do
    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
        Mr.Lines.Add(SL[i+1])
      else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
      begin
        Mr.Lines.Add(SL[i+1]);
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        T2.Max := Sl2.Count-1;
        for j := 0 to Sl2.Count-1 do
        begin
          T2.Position := j;
          SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
          if j mod 10 = 0 then
          begin
            M2.Text := SL2.Text;
            Application.ProcessMessages;
          end;
          if closebool then
            break;
        end;
        b:=true;
        Mr.Lines.Clear;
      end
      else
      begin
        if Mr.Lines.Count > 1 then
        begin
          vr:=Mr.Lines.Strings[0];
          Mr.Lines.Delete(0);
          T2.Max := Sl2.Count-1;
          for j := 0 to Sl2.Count-1 do
          begin
            T2.Position := j;
            SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
            if j mod 10 = 0 then
            begin
              M2.Text := SL2.Text;
              Application.ProcessMessages;
            end;
          end;
          if closebool then
            break;
        end;
        Mr.Lines.Clear;
        Mr.Lines.Add(SL[i+1]);
      end;
      T.Position := i;
      if closebool then
        break;
    end;
  end;
 
  M2.Text := SL.Text;
  FreeAndNil(SL2);
  //FreeAndNil(Sl3);
  FreeAndNil(SL);
  {  if closebool then
      Application.Terminate;  }
end;

procedure TForm1.WordReplaceP (M, M2, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar);
var
  sl, sl2: TStringList;
  i, j, k, l, n:integer;
  vr: string;
  b: boolean;
begin
  Sl2 := TStringList.Create;
  Sl2.Text := M2.Text;
  Sl := TStringList.Create;
  SL2.Duplicates := dupIgnore;
  Sl.Text := M.Text;
  T.Max := Sl.Count -1;
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  b := false;
  n := i_sin;
  while (not Closebool) and (not b) do
  begin
    for i := n to Sl.Count-2 do
    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
        Mr.Lines.Add(SL[i+1])
      else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
      begin
        Mr.Lines.Add(SL[i+1]);
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        T2.Max := Sl2.Count-1;
        for j := 0 to Sl2.Count-1 do
        begin
          T2.Position := j;
          SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
          if j mod 10 = 0 then
          begin
            M2.Text := SL2.Text;
            Application.ProcessMessages;
          end;
          if closebool then
            break;
        end;
        b:=true;
        l:=0;
        for k := 0 to Mr.Lines.Count-1 do
          for j := l to M.Lines.Count-1 do
            if AnsiCompareText(M.Lines.Strings[j], Mr.Lines.Strings[k])=0 then
            begin
              M.Lines.Delete(j);
              l:=j;
              break;
            end;
        Mr.Lines.Clear;
      end
      else
      begin
        if Mr.Lines.Count > 1 then
        begin
          vr:=Mr.Lines.Strings[0];
          Mr.Lines.Delete(0);
          T2.Max := Sl2.Count-1;
          for j := 0 to Sl2.Count-1 do
          begin
            T2.Position := j;
            SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
            if j mod 10 = 0 then
            begin
              M2.Text := SL2.Text;
              Application.ProcessMessages;
            end;
            if closebool then
              break;
          end;
        end;
        l:=0;
        for k := 0 to Mr.Lines.Count-1 do
          for j := l to M.Lines.Count-1 do
            if AnsiCompareText(M.Lines.Strings[j], Mr.Lines.Strings[k])=0 then
            begin
              M.Lines.Delete(j);
              l:=j;
              break;
            end;
        Mr.Lines.Clear;
        Mr.Lines.Add(SL[i+1]);
      end;
      T.Position := i;
      i_sin := i;
      if closebool then
        break;
    end;
  end;
 
  M2.Text := SL2.Text;
  FreeAndNil(SL2);
  FreeAndNil(SL);
end;

for index := x to y do
begin
  if closebool then
    break;
 
// и только потом тело цикла.
 
end;

label
  BreakRoutines, EndRoutines, ProcedureEnd;
var
  sl, sl2{, sl3}: TStringList;
  i, j:integer;
  vr: string;
  closebool,b: boolean;
begin
  // туча кода и циклов
          if closebool then
            goto BreakRoutines;
  // туча кода и циклов
 
EndRoutines:
  M2.Text := SL.Text;
  FreeAndNil(SL2);
  //FreeAndNil(Sl3);
  FreeAndNil(SL);
  {  if closebool then
      Application.Terminate;  }
 
  goto ProcedureEnd;
 
BreakRoutines:
// сохраняем все что под руку попадется 
  goto EndRoutines; // ну нам ведь надо и обьекты уничтожить :)
 
ProcedureEnd:
end;

    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
        Mr.Lines.Add(SL[i+1])
      else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
      begin

    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) then
        if (i<sl.Count-2) then
          Mr.Lines.Add(SL[i+1])
        else if (i=sl.Count-2) then
          begin

procedure NoDuplicateT(aSg: TStringGrid; const aCol: integer);
var
  SlSort, SlRow: TStringList;
  i, j: integer;
begin
  // Сортируемый список.
  SlSort := TStringList.Create;
 
  // Добавляем в сортируемый список пары: "строка - объект".
  // В качестве строки будем записывать значения ячеек того
  // столбца, по которому надо провести сортировку. Будем брать те ячейки, которые
  // не принадлежат фиксированным строкам - чтобы не подвергнуть сортировке
  // шапку таблицы, если она есть.
  // А в качестве объекта будем присоединять копии соответствующих строк таблицы.
  for i := aSg.FixedRows to aSg.RowCount - 1 do
  begin
    // Создаём контейнер для копии строки таблицы.
    SlRow := TStringList.Create;
    // Копируем строку таблицы в контейнер.
    SlRow.Assign(aSg.Rows[i]);
    // Добавляем в сортируемый список пару:
    // строка: строка из ячейки целевого столбца;
    // объект: контейнер, содержащий копию строки таблицы.
    SlSort.AddObject(aSg.Cells[aCol, i], SlRow);
  end;
 
  // Сортируем столбец.
  SlSort.Sort;
  // SlSort.Duplicates := dupIgnore;
 
  // Возвращаем в таблицу строки, отсортированные по столбцу с номером aCol.
  j := 0;
  for i := aSg.FixedRows to aSg.RowCount - 1 do
  begin
    // Берём очередной контейнер.
    SlRow := Pointer(SlSort.Objects[j]);
    // Записываем содержимое контейнера в строку таблицы.
    aSg.Rows[i].Assign(SlRow);
    // Уничтожаем контейнер.
    SlRow.Free;
    // Следующий индекс списка.
    inc(j);
  end;
 
  // Уничтожаем сортируемый список.
  FreeAndNil(SlSort);
end;

function Opa (s:string):string;