Удалить повторяющиеся символы

[Heng]

Нужно чтобы из строки удалялись только повторяющиеся символы
Например: wwwrwrwyyy
Оставлял :rwrw писал w(3) и y(3)

procedure TForm1.Button3Click(Sender: TObject);
var
s:string;
k,i,j,b:integer;
p:char;
begin
s:=Edit1.Text;
for i:=1 to length(s) do begin
k:=0;
 p:=s[i];
 b:=i;
 for j:=1 to length(s) do
 If p=s[j]  then  k:=k+1 else If s[j]<>p  then break;
 If k>1 then
 delete(s,b,k);
 label1.Caption:=s;
end;
end;
end.

________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!

Модератор.

[Stilet]

procedure TForm1.Button3Click(Sender: TObject);
var s:string;i:integer;
begin
 s:=Edit1.Text;
 for i:=2 to length(s) do  if s[i]<>s[i-1] then label1.Caption:=label1.Caption+s[i-1];
end;

Подходит?

[Heng]

Сообщение от Stilet

procedure TForm1.Button3Click(Sender: TObject);
var s:string;i:integer;
begin
 s:=Edit1.Text;
 for i:=2 to length(s) do  if s[i]<>s[i-1] then label1.Caption:=label1.Caption+s[i-1];
end;

Подходит?

wwweeeettttuu- изначальная строка
wet- вывело

[eoln]

var
  s, s1, s2: string; i, j: integer;
begin
  s := Edit1.Text + #0;
  i := 1; j := 1;
  while i < length(s) do begin
    if s[i] = s[i+1] then
      inc(j)
    else begin
      if j < 2 then
        s1 := s1 + s[i]
      else
        s2 := s2 + s[i] + '(' + inttostr(j) + ') ';
      j := 1;
    end;
    inc(i)
  end;
  label1.Caption := s1 + ' ' + s2
end;

[Heng]

Сообщение от eoln

var
  s, s1, s2: string; i, j: integer;
begin
  s := Edit1.Text + #0;
  i := 1; j := 1;
  while i < length(s) do begin
    if s[i] = s[i+1] then
      inc(j)
    else begin
      if j < 2 then
        s1 := s1 + s[i]
      else
        s2 := s2 + s[i] + '(' + inttostr(j) + ') ';
      j := 1;
    end;
    inc(i)
  end;
  label1.Caption := s1 + ' ' + s2
end;

Спасибо большое очень сильно помогли