Преобразуйте число, заданное в римской системе счисления, в число десятичной системы — Pascal(Паскаль)

unit ar_rim;
interface
uses Crt;
 
const
   Rome : string = 'IVXLCDM';
 
   Arabic : array [1..7] of integer =
            (1, 5, 10, 50, 100, 500, 10000);
 
 
Function IsArabic (s:string):boolean;
function  AtoR (s:string):string;
function IsRome (rzym:string):boolean;
function RtoA(rzym:string):integer;
 
implementation
 
 // czy jest arabska ----------------------------
 
Function IsArabic (s:string):boolean;
var i,t,c : integer;
begin
  IsArabic := true;
  for i:=1 to length (s) do
  if not ( s[i] in ['0'..'9']) then
  begin
    IsArabic := false;
    exit;
  end;
  val (s,t,c);
  if (c<>0) or (t<1) then
    begin
      IsArabic:= false;
      exit;
    end;
end;
 
// arabskie - rzymskie ---------------------------
 
function  AtoR (s:string):string;
 var
   i,n,c: integer;
   res:string;
 begin
   val (s,n,c);
   res:='';
   i:=7; // sprawdzamy  od wiekszych do  mniejszych
   while n>0 do
     begin
     while Arabic[i]>n do i:=i-1;
           res:=res+Rome[i];
     n:=n-Arabic[i];
     end;
   AtoR:=res;
end;
 
//sprawdzenie czt jest rzymska  -----------------
 function IsRome (rzym:string):boolean;
 var i:integer;
 begin
   IsRome := true;
   if rzym='' then
     begin
       IsRome:= false;
       exit;
     end;
   for i:=1 to length (rzym) do
   if not (rzym[i] in ['I','V','X','L','C','D','M']) then
     begin
     IsRome := false;
     break;
   end;
 end;
 
// rzymskie - arabskie  -------------------------
function RtoA(rzym:string):integer;
var
 n,ar,ar1,i,a: integer;
 Begin
  ar:=0; n:=0;
  for i:= 1 to length (rzym) do
    begin
    ar1:=ar;
    if rzym[i]='I' then ar:=1;
    if rzym[i]='V' then ar:=5;
    if rzym[i]='X' then ar:=10;
    if rzym[i]='L' then ar:=50;
    if rzym[i]='C' then ar:=100;
    if rzym[i]='D' then ar:=500;
    if rzym[i]='M' then ar:=1000;
 
    if ar>ar1 then a:=-2*ar1
              else a:=0;
    n:=n+a+ar
  end;
 RtoA:=n;
end;
 
end.

program rim_arab;
Uses crt,ar_rim;
{ const
   Rome : string = 'IVXLCDM';
 
   Arabic : array [1..7] of integer =
            (1, 5, 10, 50, 100, 500, 10000);  }
 
 
// PROGRAM GLOWNY
 
var
  arab,rzym : string;
  ask: char;
BEGIN
while true do
   begin
    clrscr ;
    writeln (' nacisni klawisz ');
    Writeln (' 1 - zamiana liczby rzymskiej w arabska');
    Writeln (' 2 - zamiana liczby arabskiej w rzymska');
    Writeln (' q - wyjscie ');
 
   ask:=ReadKey;
 
   case ask of
    '1': begin
        write ('podaj liczbe rzymska: ');
        readln (rzym);
        if IsRome (rzym) then
           Writeln ('ARABIC =  ', RtoA(rzym))
        else
           Writeln (' !!! blad !!!');
           readln;
        end;
 
 
    '2': begin
         write (' podaj liczbe arabska: ');
         readln (arab);
         Writeln;
         if IsArabic(arab) then
           writeln (' ROME =  ', AtoR(arab))
         else
           writeln ('!!! blad !!! ');
         readln;
         end;
     'q': exit;
 
  end;
 
End;
 
end.

program rome_arabic;
Uses crt;
Const
  {римские цифры}
  RomeDigits:string='IVXLCDM';
  {числа - соответствующие римским цифрам}
  ArabicNumbers:array [1..7] of integer =
  (1, 5, 10, 50, 100, 500, 1000);
(*---------------------------------------------------
Функция определения правильности ввода арабского числа
----------------------------------------------------*)
function IsArabic(s:string):boolean;
var i,t,c:integer;
begin
IsArabic:=true;
for i:=1 to length(s) do
if not(s[i] in ['0'..'9'])then
 begin
  IsArabic:=false;
  exit;
 end;
val(s,t,c);
if (c<>0)or(t<1) then
 begin
  IsArabic:=false;
  exit;
 end;
end;
(*----------------------------------------
Функция перевода арабского числа в римское
----------------------------------------*)
function ArabicToRome (s: string): string;
var
  i,n,c: integer;
  res: string;
begin
  val(s,n,c);
  res:='';
  i:=7; {Проверяем от больших чисел к меньшим}
  while n>0 do
   begin
    {находим следующее число - из которого будем формировать римскую цифру}
    while ArabicNumbers[i]>n do i:=i-1;
      res:=res+RomeDigits[i];
    n:=n-ArabicNumbers[i];
  end;
  ArabicToRome := res;
end;
(*---------------------------------------------------
Функция определения правильности ввода римского числа
----------------------------------------------------*)
function IsRome(s:string):boolean;
var i:integer;
begin
IsRome:=true;
if s='' then
  begin
   IsRome:=false;
   exit;
  end;
for i:=1 to length(s) do
if not (s[i] in ['I', 'V', 'X', 'L', 'C', 'D', 'M']) then
 begin
  IsRome:=false;
  break;
 end;
end;
(*----------------------------------------
Функция перевода римского числа в арабское
----------------------------------------*)
function RomeToArabic (s: string): integer;
var
  b:array[1..100] of integer;
  i,j:integer;
  res:integer;
begin
for i:=1 to length(s) do
 begin
  if s[i]='I' then b[i]:=1;
  if s[i]='V' then b[i]:=5;
  if s[i]='X' then b[i]:=10;
  if s[i]='L' then b[i]:=50;
  if s[i]='C' then b[i]:=100;
  if s[i]='D' then b[i]:=500;
  if s[i]='M' then b[i]:=1000;
 end;
res:=b[1];{массив локальная переменная и
сравнение первого элемента с нулевым искажает число,
почему-то считает, что b[0]=1 и автоматом вычитает 2}
for i:=2 to length(s) do
 begin
  res:=res+b[i];
  if b[i-1]<b[i] then res:=res-2*b[i-1]{вот здесь}
 end;
RomeToArabic:=res;
end;
{Основная программа}
var
  arabic: string; {арабское число}
  rome: string; {римское число}
  ask: char; {режим перевода чисел}
begin
  clrscr;
  writeln('Программа переводит римское число в арабское или арабское в римское');
  repeat
    clrscr;
    writeln('Выберите режим перевода:');
    writeln('1 - римское число в арабское');
    writeln('2 - арабское число в римское');
    writeln('другое - выход');
      ask:=readkey;
  case ask of
  '1': begin {Римское в арабское}
        write('Введите римское число: ');
          readln(rome);
          if IsRome(rome) then
          writeln('Арабское число = ',RomeToArabic(rome))
          else writeln('В римской записи числа допущены ошибки! Перевод не возможен!');
        writeln('Press Enter...');
        readln
       end;
   '2':begin {арабское в римское}
        write('Введите арабское число: ');
        readln(arabic);
        if IsArabic(arabic) then
        writeln('Римская запись = ',ArabicToRome(arabic))
        else writeln('В арабской записи числа допущены ошибки! Перевод не возможен!');
        writeln('Press Enter...');
        readln
       end;
    else exit;
   end;
  until not(ask in ['1','2']);
end.

program rim_arab;
uses crt;
var a:string;
    i,j:integer;
    b:array[1..50] of integer;
    s:longint;
begin
clrscr;
writeln('Rimskoe chislo');
readln(a);
for i:=1 to length(a) do
    begin
      if (a[i]<>'I') and (a[i]<>'V') and (a[i]<>'X')
      and (a[i]<>'L')and (a[i]<>'C') and (a[i]<>'D') and (a[i]<>'M')
      then halt;
      if a[i]='I'then b[i]:=1;
      if a[i]='V'then b[i]:=5;
      if a[i]='X'then b[i]:=10;
      if a[i]='L'then b[i]:=50;
      if a[i]='C'then b[i]:=100;
      if a[i]='D'then b[i]:=500;
      if a[i]='M'then b[i]:=1000;
    end;
s:=0;
for i:=1 to length(a) do
   begin
     s:=s+b[i];
     if(i>1)and(b[i-1]<b[i]) then s:=s-2*b[i-1];
   end;
write(s);
readln;
end.