Программа перевода арабских чисел в римские!

uses crt;
const dec=3250;
function basedigit(x:integer):char;
begin
case x of 1:basedigit:='I';
5:basedigit:='V';
10:basedigit:='X';
50:basedigit:='L';
100:basedigit:='C';
500:basedigit:='D';
1000:basedigit:='M';
else basedigit:='0';
end;{case}
end;
function altconvert(x:integer):string;
var base:integer;
tmp:string;
begin tmp:='';
base:=0;
if (x<0) then tmp:='err' else if (x>3999)and(x<999999) then begin tmp:='*'+altconvert(trunc(x/1000))+'*';
x:=x-trunc(x/1000)*1000 ;
end;
while (X>0) do begin
if (x >= 1)and(x<=9) then
base:=1
else if (x >= 10)and(x<=99) then
base:=10
else if (x >= 100)and(x<=999) then
base:=100
else if(x >= 1000)and(x<=3999)
then base:=1000;
if x>=9*base then begin
tmp:=tmp+basedigit(base)+basedigit(base*10);
x:=x-9*base;
end
else if x>=5*base then begin
tmp:=tmp+basedigit(5*base);
x:=x-5*base;
end else if x>=4*base then begin tmp:=tmp+basedigit(base)+basedigit(5*base);
x:=x-4*base;
end;
while x>=base do begin
tmp:=tmp+basedigit(base);
x:=x-base;
end;
end; {while}
altconvert:=tmp;
end;
function convert(x:integer):string;
var tmp:string;
begin tmp:='';
if(x>=4000)or(x<1) then
convert:='err'
else begin
while x>=1000 do begin
tmp:=tmp+'M';
x:=x-1000;
end;
if x>=900 then begin
tmp:=tmp+'CM';
x:=x-900;
end
else
if x>=500 then begin
tmp:=tmp+'D';
x:=x-500;
end
else
if x>=400 then begin
tmp:=tmp+'CD';
x:=x-400;
end;
while x>=100 do begin
tmp:=tmp+'C';
x:=x-100;
end;
if x>=90 then begin
tmp:=tmp+'XC';
x:=x-90;
end
else if x>=50 then begin
tmp:=tmp+'L';
x:=x-50;
end else if x>=40 then begin
tmp:=tmp+'XL';
x:=x-40;
end;
while (x>=10) do begin
tmp:=tmp+'X';
x:=x-10;
end;
if x=9 then begin
tmp:=tmp+'IX';
x:=x-9;
end
else if x>=5 then begin
tmp:=tmp+'V';
x:=x-5;
end
else if x=4 then begin
tmp:=tmp+'IV';
x:=x-4;
end;
while (x>=1) do begin
tmp:=tmp+'I';
x:=x-1;
end;
end;{else}
convert:= tmp;
end;
var x:integer;
begin clrscr;
write('Введи число от 1 до 3999 ');
readln(x);
writeln('В арабских выглядет так ' + convert(x) );
readkey;
end.

var n:integer;
a,b,c,d,f,h,q,s,w,r:string;
begin
writeln('введите число');
readln(n);
case n mod 10 of
1:a:='I';
2:a:='II';
3:a:='III';
4:a:='IV';
5:a:='V';
6:a:='VI';
7:a:='VII';
8:a:='VIII';
9:a:='IX';
end;
b:='X';
c:='L';
d:='C';
case n mod 100 of
10..19:q:=b+a;
20..29:q:=b+b+a;
30..39:q:=b+b+b+a;
40..49:q:='IL'+a;
50..59:q:=c+a;
60..69:q:=c+b+a;
70..79:q:=c+b+b+a;
80..89:q:=c+b+b+b+a;
90..99:q:='IC'+a;
else q:=a;
end;
s:='D';
case n mod 1000 of
100..199:f:=d+q;
200..299:f:=d+d+q;
300..399:f:=d+d+d+q;
400..499:f:='ID'+q;
500..599:f:=s+q;
600..699:f:=s+d+q;
700..799:f:=s+d+d+q;
800..899:f:=s+d+d+d+q;
900..999:f:='IM'+q;
else f:=q;
end;
w:='M';
case n mod 4000 of
1000..1999:r:=w+f;
2000..2999:r:=w+w+f;
3000..3999:r:=w+w+w+f;
else r:=f;
end;
writeln(r);
 end.

var
   c : array [1..13] of string :=  ('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I'); 
   n : array [1..13] of integer := (1000,900, 500,400,100,90,50,40,10,9,5,4,1); 
   res : string := '';
   i,val : integer;
begin
   writeln('введите число');
   readln(val);
   for i:=1 to 13 do
      while (val>=n[i]) do begin
         res := res + c[i];
         val := val - n[i];
      end;
   writeln(res);
end.