Найдите ошибку в проге(Delphi)!!!

[Npwas]

Там ошибочная часть указана вообщем там должно удалять каждое последующее вхождение каждой буквы
К примеру если ввел: cvnjcvnjcvnjcvnjcvnjcvnjcvnjcvnj
То должно вывести: cvnj
Не могу никак с ошибкой своей разобраться!!!

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
  stroka=array[1..100000000] of string;
  mz=set of Char;
  Var
  a:mz;
  s: stroka ;
  x,j,i,n,z:Integer;
  Vrepeat:boolean;
begin
  Writeln('Kakoe kolichestwo slov vi hotite vvesti?');
  Readln(n);
  Writeln('Vvedite ',n,' slov:');
  {Ввод строк}
  for i:=1 to  n do
   Readln(s[i]);
  Writeln;
 {Берёт слово}
  for i:=1 to n-1 do
    begin
      Vrepeat:=true;
     {Берёт поочерёдно букву}
     for j:=1to Length(s[i]) do
       for x:=j+1 to Length(s[i]) do
       begin
       {$B+}     {Сравнивает}
         if(s[i,j]=s[i,x]) and (not(s[i]=s[n]))and (Vrepeat)then
            begin
              Write(s[i],'  ');
              Vrepeat:=false;
            end;
       {$B-}
       end;
   end;
  Writeln;
  Writeln;
  {Ошибочная часть}
  for i:=1 to n-1 do
     for j:=1 to Length(s[i])  do
       for x:=j+1 to Length(s[i])  do
         {$B+}
         if(s[i,j]=s[i,x]) then
           begin
             Include(a,s[i,j]);
           end;
          {$B-}
  For i:=1 to n-1 do
    begin
     For j:=1 to Length(s[i]) do
       begin
        {$B+}
         If s[i,j] in a then
          begin
            For x:=1 to Length(s[i])+1 do
              If (s[i,x] in a) and (s[i,j]=s[i,x]) then
                Delete(s[i],x,1);
          end;
        {$B-}
       end;
     Write(s[i],'  ');
    end;
    {Ошибочная часть}
  Readln;
end.

[Niro]

Ээм, не совсем понятно, что вам нужно, но судя по

К примеру если ввел: cvnjcvnjcvnjcvnjcvnjcvnjcvnjcvnj
То должно вывести: cvnj

Нужно удалить из заданной строки повтоярющиеся символы, тогда можно так

while i<=length(s) do
   begin
     i:=i+1;
     j:=i+1;
     while j<=length(s) do
     begin
        if s[i]=s[j] then begin
                             delete(s,j,1);
                             j:=j-1;
                          end;
        j:=j+1;
      end;
   end;

[Npwas]

СПС работает, но както для одного слова

[Niro]

Ну тогда код написанный мною выше надо загнать в цикл

var z: longint;
for z:=1 to hign(s) do
begin
i:=0;
j:=1;
while i<=length(s) do
   begin
     i:=i+1;
     j:=i+1;
     while j<=length(s) do
     begin
        if s[i]=s[j] then begin
                             delete(s,j,1);
                             j:=j-1;
                          end;
        j:=j+1;
      end;
   end;
end;

[Npwas]

Как то всеравно не очень!!! Выводит ток четыре буквы!!!

{Ошибочная часть}
  For x:=1 to n do
   begin
     while i<=length(s[x]) do
      begin

       while j<=length(s[x]) do
         begin
            if s[i]=s[j] then
              begin
                delete(s[x],j,1);
                j:=j-1;
              end;
            j:=j+1;
         end;
         i:=i+1;
       j:=i+1;
      end;
      i:=1;
      j:=2;
   end;

[whatever]

А не проще вот так:

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
  stroka=array[1..100000000] of string;
  mz=set of Char;

procedure nevermind(var S:string);
var
//  i,j,lenword,n:integer;
  bukva:char;
  tmp:string;
begin
      TMP:='';
//      LenWord:=length(s);
  //    for j:=1 to lenword do
      while s<>'' do
        begin
          bukva:=s[1];
          TMP:=TMP+s[1];
          delete(S,1,1);
          while pos(bukva,s)<>0 do
            delete(s,pos(bukva,s),1)
        end;
      s:=TMP;
end;

Var
  a:mz;
  s: stroka ;
  TMP:string;
  x,j,i,n,z,LenWord:Integer;
  Vrepeat:boolean;
  bukva:char;
begin
  Writeln('Kakoe kolichestwo slov vi hotite vvesti?');
  Readln(n);
  Writeln('Vvedite ',n,' slov:');
  {Ввод строк}
  for i:=1 to  n do
   Readln(s[i]);
  Writeln;
  for i:=1 to n do
    begin
      nevermind(s[i]);
      writeln(s[i]);
    end;
  readln
end.

?

P.S. Лишних переменных до**я, но почистить не проблема. Просто мне лень :P

[Npwas]

СПС, но у меня и так вот уже работает!!!

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
  stroka=array[1..100000000] of string;
Var
  s:stroka ;
  x,j,i,n:Integer;
  Vrepeat:boolean;
begin
  Writeln('Kakoe kolichestwo slov vi hotite vvesti?');
  Readln(n);
  Writeln('Vvedite ',n,' slov:');
  {Ввод строк}
  For i:=1 to  n do
   Readln(s[i]);
  Writeln;
 {Берёт слово}
  For i:=1 to n-1 do
    begin
      Vrepeat:=true;
     {Берёт поочерёдно букву}
     For j:=1 to Length(s[i]) do
     {Берёт поочерёдно букву}
       For x:=j+1 to Length(s[i]) do
        begin
        {$B+}     {Сравнивает}
          If(s[i,j]=s[i,x]) and (not(s[i]=s[n]))and (Vrepeat)then
             begin
               Write(s[i],'  ');
               Vrepeat:=false;
             end;
        {$B-}
        end;
    end;
  Writeln;
  {Алгоритм исключения из слов последующих вхождений каждой буквы}
  For i:=1 to n do
   begin
     j:=0;
     x:=1;
     while j<=length(s[i]) do
      begin
        j:=j+1;
        x:=j+1;
        while x<=length(s[i]) do
          begin
             if s[i,j]=s[i,x] then
               begin
                 Delete(s[i],Pos(s[i,j],s[i]),1);
                 x:=x-1;
               end;
             x:=x+1;
          end;
      end;
   end;
  For i:=1 to n-1 do
   If not (s[i]=s[n]) then
     Write(s[i],'   ');
  Readln;
end.