Дано 2 слова длин a и b (a,b<20, a>b). Нужно вывести наименьшее количество удалений и замен символов из строки а, чтобы получить строку b и вывести строку a с учётом удалений символов — Pascal(Паскаль)

uses
  crt;
var
  a,b,temp:string;
  i,ti,cdel,zam:integer;
  tch:char;
{процедура прорисовки}
procedure Print(a,b:string);
var
  i:integer;
begin
  for i:=1 to length(a) do
  begin
    if a[i]=b[i] then
      textcolor(2)
    else
      textcolor(4);
    write(a[i])
  end;
  textcolor(0);
  writeln(' - ',b)
end;
{основная программа}
begin
  writeln('Введите первое слово...');
  readln(a);
  writeln('Введите второе слово...');
  {производим проверку на длину второго слова, она должна быть меньше длины первого}
  repeat
    readln(b);
    if (b<>'0') and (length(b)>length(a)) then
      writeln('Неверно задано второе слово. Его длина должна быть меньше либо равна длине первого. Попробуйте еще раз или введите "-" для выхода.');
    if b='-' then
      exit;
  until
    length(b)<=length(a);
  writeln('===============================================================================');
  {удаляем все лишние символы}
  temp:=b;
  i:=1;
  cdel:=0;
  zam:=0;
  while i<=length(a) do
  begin
    if pos(a[i],temp)=0 then
    begin
      delete(a,i,1);
      inc(cdel)
    end
    else
    begin
      delete(temp,pos(a[i],temp),1);
      inc(i)
    end;
  end;
  {если в первом слове осталось слишком мало букв, то выходим}
  if length(a)<length(b) then
  begin
    writeln('Из букв первого слова нельзя составить второе...');
    exit
  end
  else
  begin
    {а вот тут уже будем идти побуквенно}
    writeln('Производим замену...');
    writeln('===============================================================================');
    Print(a,b);
    while a<>b do
      for i:=1 to length(a) do
        if a[i]<>b[i] then
        begin
          inc(zam);
          tch:=a[i];
          ti:=pos(tch,copy(b,i,length(b)))+i-1;
          a[i]:=a[ti];
          a[ti]:=tch;
          Print(a,b)
        end;
    writeln('===============================================================================');
    writeln('Из первого слова можно составить второе. Для этого потребуется ',cdel,' удалений и ',zam,' замен.');
  end
end.

Program P3;
uses
    crt;
const
    n=20;
type
    tb = array[1..n] of byte;
    ts = string;
var
    a, b, c, res : ts;
    na, nb, d : byte;
    maxsum : byte;
    i : byte;
    l : tb;
procedure strlength(var s : string; l : byte);
    var
       i, old : byte;
       ts : string;
    begin
       old:=length(s);
       s[0]:=chr(l);
       if old<l then
          for i:=old+1 to l do
          s[i]:=' '
    end;
procedure compare;
    var
       i, j : byte;
       s : ts;
       sum : byte;
    begin
       s:=b;
       for i:=1 to d do
         begin
         for j:=na downto l[i]+1 do
           s[j]:=s[j-1];
           s[l[i]]:=' '
         end;
       sum:=0;
         for i:=1 to na do
          if a[i]=s[i] then inc(sum);
          if sum>maxsum then
       begin
         maxsum:=sum;
         res:=s
       end;
    end;
procedure req(x:byte);
     var
         i : byte;
     begin
        for i:=l[x] to na-d+x do
          begin
          if x<d then
          begin
          l[x+1]:= i+1;
          req(x+1)
        end
          else
           compare;
           inc(l[x])
          end;
     end;
function reslt: string;
     var
        s : ts;
        i, j, k : byte;
     begin
        s:=a;
        k:=1;
     for
         i:=1 to na do
         if res[i]=' ' then
         for j:=k to na-1 do
            s[j]:=s[j+1]
             else
          inc(k);
          strlength(s,nb);
          reslt:=s;
     end;
begin
    writeln('Vvedite pervoe slovo',a);
    readln(a);
    writeln('Vvedite vtoroe slovo',b);
    readln(b);
    if length(a)<length(b) then
       writeln ('Preobrazovanie nevozmozhno')
       else
       begin
       if length(a)=length(b) then
          begin
              for i:=1 to length(a) do
              begin
                 if a[i]<>b[i] then
                 maxsum:=maxsum+1;
              end;
          end;
       end;
    na:=length(a);
    nb:=length(b);
    d:=na-nb;
    c:=b;
    strlength(b,na);
    for i:=1 to d do l[i]:=i;
    for i:=d+1 to n do l[i]:=0;
    maxsum:=0;
    res:=b;
    req(1);
    writeln(a, ', ', c, ': udaleniy ', d, ', zamen ', nb-maxsum, ', ', reslt);
    readln;
end.