[Alegun]

А зачем вообще удалять из строки символы после сравнения, время на это тратить (это наверное из-за разной длины входных слов), вот слегка подправленный варьянт, вроде так попроще будет:

Код:

function TForm1.CompareWords(var W1,W2: string; var CompareLevel:integer):boolean;
 function CompareLen(len1, len2: integer): integer;
 begin
   if len1 >= len2 then 
     Result:= len1 else 
     Result:= len2; 
 end;
var
//NumSymWord1,
NumSymWord2,Divide,i:integer;
//s1,s2: char;
begin
//NumSymWord1 := Length(W1);
  NumSymWord2 :=0;

(*============ ЦИКЛ =============================*)
        for i := 1 to CompareLen(Length(W1),Length(W2)) do
       //  begin
           //s1:=W1[1];
           //s2:=W2[1];  (*если ПЕРЕМ=пусто то ошибка, отладчик указывает на эту строку*)
           if W1[i]=W2[i] then    //if s1=s2 then
           inc(NumSymWord2); //NumSymWord2 := (NumSymWord2+1);
           //delete(W1, 1,1); (*удаляем уже обработанный символ*)
           //delete(W2, 1,1);
       //  end;
(*===============================================*)

         if Length(W1) >0 then //NumSymWord1 > 0 then
         // begin
           Divide := ((NumSymWord2*100)div Length(W1); // NumSymWord1);
         // end;

Result:= Divide > CompareLevel;      

//if Divide > CompareLevel then
//   CompareWords := TRUE;
end;

Наверное ещё короткой строчке SetLength`ом размер длинной строки надо задавать, тогда ошибки точно не будет. Или сразу результат положительный на-гора из функции выдавать, слова-то отличаются.