Процедура перевода из арабского в римское

program Roman
uses crt;
var n, x, a: Word;
    str    : String;  {переменная в которую запишем результатир-е римское число}
    excode : char;
begin
  ClrScr;
  writeln('Roman!');
  writeln('------------------------------------');
  repeat  {цикл програмы ОПРОСА ввода араб. и вывода римского числа}
  ClrScr;
  writeln('Arabic: ');
  Readln(a);  {считываем  арабское число}
  x := a;
  str:=''; {созд. ПУСТУЮ переменную в которую запишем результатир-е римское число запишем }
  repeat  {цикл перевода чисел из араб. в римс.}
    while 1000 <= x do {пока арабское число > 1000}
    begin
      str := str + 'M'; Dec(x, 1000) {дописываем к "str" соотв. римскую букву}
    end;
    if 900 <= x then  {пока арабское число => 900}
    begin
      str := str + 'CM'; Dec(x, 900) {дописываем к "str" соотв. римскую букву}
    end
    else if 500 <= x then  {пока арабское число => 500}
    begin
      str := str + 'D'; Dec(x, 500)  {дописываем к "str" соотв. римскую букву}
    end
    else if 400 <= x then  {пока арабское число => 400}
    begin
      str := str + 'CD'; Dec(x, 400)  {дописываем к "str" соотв. римскую букву}
    end;
    while 100 <= x do  {пока арабское число => 100}
    begin
      str := str + 'C'; Dec(x, 100) {дописываем к "str" соотв. римскую букву}
    end;
    if 90 <= x then {пока арабское число => 90}
    begin
      str := str + 'XC'; Dec(x, 90) {дописываем к "str" соотв. римскую букву}
    end
    else if 50 <= x then  {пока арабское число => 50}
    begin
      str := str + 'L'; Dec(x, 50)  {дописываем к "str" соотв. римскую букву}
    end
    else if 40 <= x then  {пока арабское число => 40}
    begin
      str := str + 'XL'; Dec(x, 40)  {дописываем к "str" соотв. римскую букву}
    end;
    while 10 <= x do  {пока арабское число => 10}
    begin
      str := str + 'X'; Dec(x, 10)  {дописываем к "str" соотв. римскую букву}
    end;
    if 9 = x then    {пока арабское число => 9}
    begin
      str := str + 'IX'; Dec(x, 9) {дописываем к "str" соотв. римскую букву}
    end
    else if 5 <= x then    {пока арабское число => 5}
    begin
      str := str + 'V'; Dec(x, 5)  {дописываем к "str" соотв. римскую букву}
    end
    else if 4 = x then {пока арабское число => 4}
    begin
      str := str + 'IV'; Dec(x, 4) {дописываем к "str" соотв. римскую букву}
    end;
    while 1 <= x do   {пока арабское число => 1}
    begin
      str := str + 'I'; Dec(x)   {дописываем к "str" соотв. римскую букву}
    end;
    Inc(n)
  until x < n; {--- КОНЕЦ цикла перевода чисел из араб. в римс.---}
  
  writeln(a, ' = ', str); {выводим результат}
  str := '';
  Writeln;Writeln('Continue? (Y/N)'); {спрашиваем - надо ли проводить новые вычисления}
  Readln(excode);
  until UpCase(excode) = 'N';   {--- КОНЕЦ цикла програмы ОПРОСА ввода араб. и вывода римского числа---}
end.