Zablokowane problem z programem

[skasna]

witam

mam maly problem z programem i juz sama nie wiem co mam zrobic

mam program ktory zamienia liczby w systemie rzymskim na arabskie i na odwrot. z zamiana na rzymskie nie ma problemow, chodzi o rzymskie na arabskie.

w samej zamianie nie ma raczej bledow, ale zamiana ta nie uwzglednia tego, jak ktos napisze zla liczbe (np. XXX czy XIXI) i wtedy tez wypisuje wynik. zeby przed tym sie uchronic, podana liczbe w systemie rzymskim zamieniam na arabska i potem spowrotem na rzymska ta druga moja funkcja i sprawdzam czy zamieniona liczba i ta podana przez uzytkownika sa takie same. jesli sa, to program powinien wypisac liczbe arabska, jesli nie, poinformowac o bledzie. jednak za kazdym razem informuje o bledzie, mimo ze zamieniona i podana sa takie same (kaze programowi wypisywac ta zamieniona, i rzeczywiscie sa one takie same). juz nie wiem co moge zrobic, prosze o pomoc:)

program ArabskieRzymskie;
uses
  Crt;

var
  Arabska : integer;
  Rzymska : string;

procedure start(tytul:string);
begin
        ClrScr;
        writeln(tytul);
        writeln
end;

procedure czekaj;
begin
        writeln;
        writeln('Nacisnij klawisz ENTER');
        readln
end;

function Wstaw(num : integer; one, five, ten : string) : string;
var
  i: integer;
  T: string;
begin
T:='';

if num < 4 then for i:=1 to num do T:=T+one;
if num = 4 then T:=one + five;
if num = 5 then T := five;
if (num > 5) and (num < 9) then
begin
  T:=five;
  for i:=1 to num - 5 do  T:=T+one;
end;
if num = 9 then T:=one+ten;

Result := T;
end;

function ar(a: integer): string;
var
  i: integer;
  Rzym: string;
begin
if (a div 1000) > 0 then
    begin
      for i := 1 to a div 1000 do
        Rzym := Rzym +'M';
      a := a mod 1000;
    end;

  if (a div 100) > 0 then
    begin
      Rzym := Rzym + Wstaw(a div 100,'C','D','M');
      a := a mod 100;
    end;

  if (a div 10) > 0 then
    begin
      Rzym := Rzym + Wstaw(a div 10,'X','L','C');
      a := a mod 10;
    end;

  if a > 0 then
    Rzym := Rzym + wstaw(a,'I','V','X');
Result := Rzym;
end;

function ra(r : string) : integer;
var
  i, add, min, sum: integer;
  pom: boolean;
begin
sum := 0;
pom := false;

for i:= 1 to Length(r) do
   begin
    add := 0;
    min := 0;

    if pom = false then
      begin
        case R[i] of
            'M': add := 1000;
            'D': add := 500;
            'C': add := 100;
            'L': add := 50;
            'X': add := 10;
            'V': add := 5;
            'I': add := 1;
        end;

        case R[i + 1] of
            'M': min := 1000;
            'D': min := 500;
            'C': min := 100;
            'L': min := 50;
            'X': min := 10;
            'V': min := 5;
            'I': min := 1;
        end;

        if add < min then begin add := min - add; pom := true; end;
        sum := sum + add;
      end
    else
      pom := false;
  end;
result := sum;

end;

procedure NaRzymska;
begin
     start('Funkcja zamieniajaca liczby arabskie na rzymskie.');
     writeln('Podaj liczbe w systemie arabskim: ');
     readln(Arabska);
     if (Arabska > 0) and (Arabska < 10000) then
        begin
             writeln('Ta liczba w systemie rzymskim to: ',ar(Arabska));
        end
        else writeln('Bledna liczba.');
     readln;
     czekaj;
end;

procedure NaArabska;
var
   zamieniona : string;

begin
     start('Funkcja zamieniajaca liczby rzymskie na arabskie.');
     writeln('Podaj liczbe w systemie rzymskim: ');
     readln(Rzymska);
     zamieniona := ar(ra(Rzymska));
     writeln(Rzymska);
     writeln(ra(Rzymska));
     writeln(ar(ra(Rzymska)));
     if zamieniona=Rzymska
     then writeln('Ta liczba w systemie arabskim to: ',ra(Rzymska))
     else writeln('Podana przez Ciebie liczba w systemie rzymskim nie jest poprawna.');
     readln;
     czekaj;
end;


procedure Koniec;
begin
        start('Wywolano zakonczenie programu');
        czekaj;
        halt
end;

procedure Menu;
const format=6;
begin
        start('MENU');
        writeln('1':format,' - zamiana liczby arabskiej na rzymska');
        writeln('2':format,' - zamiana liczby rzymskiej na arabska');
        writeln('Esc':format,' - zakoczenie programu');
        writeln
end;

procedure KtoraFunkcja(var klawisz:char);
begin
        write('Podaj, ktora funkcje wybierasz: 1,2 czy Esc: ');
        klawisz:=ReadKey;
        writeln(klawisz);
end;

procedure WybierzFunkcje(klawisz:char);
const Esc=#27;
begin
        case klawisz of
           '1':NaRzymska;
           '2':NaArabska;
           Esc:Koniec
        end
end;

var klawisz:char;

begin
        start('Program zamiany liczb');
        czekaj;
        repeat
            Menu;
            KtoraFunkcja(klawisz);
            WybierzFunkcje(klawisz)
        until False
end.