Не стал писать проверку на правильность введения римского числа. Так что вводить нужно аккуратно, без ошибок, в верхнем регистре.
var a, stroka:string;
i,n,t,s,d,e,x : Integer;
b:array[1..20] of integer;
type slova = array[0..9] of String[15];
const
edinit : slova = ('',' один',' два',' три',' четыре',' пять',' шесть',' семь', ' восемь',' девять');
desyat : slova = ('',' десять',' двадцать',' тридцать',' сорок',' пятьдесят', ' шестьдесят',' семьдесят',' восемьдесят ',' девяносто');
sotnya : slova = ('',' сто',' двести',' триста',' четыреста',' пятьсот',' шестьсот',' семьсот',' восемьсот',' девятьсот');
teeeen : slova = ('',' одинадцать',' двенадцать',' тринадцать',' четырнадцать',
' пятнадцать',' шестнадцать',' семнадцать',' восемьнадцать',
' девятнадцать');
tyscha : slova = ('','одна тысяча','две тысячи','три тысячи','четыре тысячи','пять тысяч','шесть тысяч','семь тысяч', 'восемь тысяч','девять тысяч');
begin
writeln('Введите римское число: ');
readln(a);
{записываем число как сумму арабских эквивалентов в массив}
for i:=1 to length(a) do
case a[i] of
'I': b[i]:=1;
'V': b[i]:=5;
'X': b[i]:=10;
'L': b[i]:=50;
'C': b[i]:=100;
'D': b[i]:=500;
'M': b[i]:=1000;
end;
{суммируя элементы массива, находим число в 10-м виде}
n:=0;
for i:=1 to length(a) do
begin
n:=n+b[i];
if(i>1)and( b[i-1]
end;
{преобразовываем число в текст}
stroka:='';
t:=n div 1000;
if t>0 then stroka:=stroka+tyscha[t];
s:=n div 100 mod 10;
stroka:=stroka+sotnya[s];
x:=n mod 100;
d:=X div 10;
e:=X mod 10;
if (d=1) and (e<>0) then stroka:=stroka+teeeen[e]
else stroka:=stroka+desyat[d]+edinit[e];
writeln(stroka);
end.