Функция: заменить все подряд идущие одинаковые символы одним

var
  s: string;
  ch: char;
 
function DeleteChar(s: string; ch: char): string;
var
  i: integer;
  s1: string;
begin
  s := s + ' ';
  for i := 1 to length(s) - 1 do
    if (s[i] = ch) and (s[i + 1] = ch) then
      s1 := s1 + '' 
    else
      s1 := s1 + s[i];
  DeleteChar := s1;
end;
 
begin
  readln(s);
  readln(ch);
  writeln(DeleteChar(s, ch));
end.

function DeleteChar(s: string; ch: char): string;
var i: integer;
begin
  for i :=Length(s) - 1 downto 1 do
    if (s[i] = ch) and (s[i + 1] = ch) then Delete(s,i,1);
  DeleteChar := s;
end;

function DeleteChar(s: string): string;
var i: integer;
begin
  for i :=Length(s) - 1 downto 1 do
    if s[i] = s[i + 1] then Delete(s,i,1);
  DeleteChar := s;
end;

function DeleteChar(s: String; ch: Char): String;
var i, j: Integer;
begin
  i:=Length(s);
  while i>0 do begin
    j:=i;
    while (i>0) and (s[i]=s[j]) do Dec(i);
    if j-i>1 then begin
      s[i+1]:=ch; Delete(s,i+2,j-i-1);
    end;
  end;
  DeleteChar := s;
end;