Сжатие строк

var s:string;
    a:array[byte] of byte;
    n,i,j:byte;
begin
writeln('Введите строку с одинаковыми символами рядом');
readln(s);
s:=s+' ';
i:=1;
n:=0;
while i<length(s) do
 begin
  inc(n);
  a[n]:=1;
  j:=i+1;
  while(j<=length(s))and(s[j]=s[i]) do
   begin
    inc(a[n]);
    delete(s,j,1);
   end;
  inc(i);
 end;  
writeln(s);
for i:=1 to n do
write(a[i],' ')
end.

##
var cur, prev: char;
var count:= 1;
cur:= ReadChar;
prev:= cur;
repeat
  cur:= ReadChar;
  
  if cur = prev then
    count+= 1
  else begin
    write(prev, count);
    count:= 1;
    prev:= cur;
  end;
until cur = #13;

##
ReadLnString
.AdjacentGroup
.Select(s-> $'{s[0]}{s.length}')
.Print('');

## ReadString
.AdjacentGroup
.Select(a->
begin
  Result := a[0].ToString;
  if a.Length<>1 then Result += a.Length.ToString;
end).Print('');

##
foreach var a in ReadString.AdjacentGroup do
begin
  Write(a[0]);
  if a.Length<>1 then
    Write(a.Length);
end;

begin
foreach var a in ReadString.AdjacentGroup do
begin
  Write(a[0]);
  if a.Length<>0 then
    Write(a.Length);
end;
end.

begin
var (s,s1):=(ReadString('Введите строку: '),'');  
  foreach var v in s do s1+=v+s.Countof(v).ToString;
  Println(s1);
  if s.Length<s1.Length then Println(s)
end.