Program Konversi Angka Desimal ke Romawi Pascal

Program konversi;
Uses crt;
Var
angka:longint;
Begin
clrscr;
Writeln('Konversi Angka Desimal ke Romawi');
Writeln('--------------------------------');
Writeln;
repeat
Write('Masukkan bilangan [1..3999] : ');Readln(angka);
Writeln;
until angka>0;
Writeln;
Writeln('Hasil Konversi');
Writeln('--------------');
Writeln;
If (angka>3999) or (angka<=0) then Writeln('Tidak Sesuai ! Masukkan hanya bilangan [1..3999] !')
Else
Begin
repeat
if angka>=1000 then
Begin
angka:=angka-1000;
Write('M');
End
Else If (angka>=900) and (angka<1000) then
Begin
angka:=angka-900;
write('CM');
End
Else if (angka>=800) and (angka<900) then
Begin
angka:=angka-800;
Write('DCCC');
End
Else if (angka>=700) and (angka<800) then
Begin
angka:=angka-700;
Write('DCC');
End
Else if (angka>=600) and (angka<700) then
Begin
angka:=angka-600;
Write('DC');
End
Else if (angka>=500) and (angka<600) then
Begin
angka:=angka-500;
Write('D');
End
Else if (angka>=400) and (angka<500) then
Begin
angka:=angka-400;
Write('CD');
End
Else if (angka>=300) and (angka<400) then
Begin
angka:=angka-300;
Write('CCC');
End
Else if (angka>=200) and (angka<300) then
Begin
angka:=angka-200;
Write('CC');
End
Else if (angka>=100) and (angka<200) then
Begin
angka:=angka-100;
Write('C');
End
Else if (angka>=90) and (angka<100) then
Begin
angka:=angka-90;
Write('XC');
End
Else if (angka>=80) and (angka<90) then
Begin
angka:=angka-80;
Write('LXXX');
End
Else if (angka>=70) and (angka<80) then
Begin
angka:=angka-70;
Write('LXX');
End
Else if (angka>=60) and (angka<70) then
Begin
angka:=angka-60;
Write('LX');
End
Else if (angka>=50) and (angka<60) then
Begin
angka:=angka-50;
Write('L');
End
Else if (angka>=40) and (angka<50) then
Begin
angka:=angka-40;
Write('XL');
End
Else if (angka>=30) and (angka<40) then
Begin
angka:=angka-30;
Write('XXX');
End
Else if (angka>=20) and (angka<30) then
Begin
angka:=angka-20;
Write('XX');
End
Else if (angka>=10) and (angka<20) then
Begin
angka:=angka-20;
Write('X');
End
Else if (angka=9) then
Begin
angka:=angka-9;
Write('IX');
End
Else if (angka=8) then
Begin
angka:=angka-8;
Write('VIII');
End
Else if (angka=7) then
Begin
angka:=angka-7;
Write('VII');
End
Else if (angka=6) then
Begin
angka:=angka-6;
Write('VI');
End
Else if (angka=5) then
Begin
angka:=angka-5;
Write('V');
End
Else if (angka=4) then
Begin
angka:=angka-4;
Write('IV');
End
Else if (angka=3) then
Begin
angka:=angka-3;
Write('III');
End
Else if (angka=2) then
Begin
angka:=angka-2;
Write('II');
End
Else if (angka=1) then
Begin
angka:=angka-1;
Write('I');
End;
Until angka=0;
End;

Readln;
End.

Share On