function TForm1.CompareWords(var W1,W2: string; var CompareLevel:integer):boolean;
var
NumSymWord1,NumSymWord2,Divide,i:integer;
s1,s2: char;
begin
  NumSymWord1 := Length(W1);
  NumSymWord2 :=0;
(*============ ЦИКЛ =============================*)
        for i := 1 to Length(W1) do
         begin
           s1:=W1[1];
           s2:=W2[1];  (*если ПЕРЕМ=пусто то ошибка, отладчик указывает на эту строку*)
           if s1=s2 then
           NumSymWord2 := (NumSymWord2+1);
           delete(W1, 1,1); (*удаляем уже обработанный символ*)
           delete(W2, 1,1);
         end;
(*===============================================*)
         if NumSymWord1 > 0 then
          begin
           Divide := ((NumSymWord2*100)div NumSymWord1);
          end;
      if Divide > CompareLevel then
      CompareWords := TRUE;
end;