contoh kode pascal 2

Program Konversi_Decimal_Ke_Romawi_Pakai_Array;
Uses WinCrt;
Const
   Romawi : array [1..13] of String =
   ('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I');
   Desimal : array [1..13] of integer =
   (1000,900,500,400,100,90,50,40,10,9,5,4,1);
Var
   B,B1,i : Integer;
   Ul:Char;
   Rom : String;


Begin
  Repeat
    Clrscr;
    Writeln('Program Konversi Desimal Menjadi Romawi');
    Writeln('=======================================');
    Writeln;
    Write('Masukkan Bilangan Antara [1..9999] : ');Readln(B);
    Writeln;
    Rom:='';
    B1:=B;
    If (B>0) And (B<10000) Then
      Begin                                                                              
        For i:=1 To 13 Do
          Begin
            While (B>=Desimal[i]) Do
              Begin
                B:=B-Desimal[i];
                Rom:=Rom+Romawi[i]
              End;
          End;
        Writeln('Desimal ',B1,' = ',Rom,' Romawi');
      End
    Else
      Writeln('Tidak Diketahui Simbol Romawinya!');
    Writeln;
    Write('Mau Ulang Lagi? [Y/T]: ');Readln(Ul);
    Ul:=Upcase(Ul);
  Until (Ul<>'Y');


Program Konversi_Decimal_Ke_Romawi_Pakai_If;
Uses WinCrt;
Var
   B,B1,i : Integer;
   Ul:Char;
   Rom : String;
Begin
  Repeat
    Clrscr;
    Writeln('Program Konversi Desimal Menjadi Romawi');
    Writeln('=======================================');
    Writeln;
    Write('Masukkan Bilangan Antara [1..9999] : ');Readln(B);
    Writeln;
    Rom:='';
    B1:=B;
    if (B>0) And (B<10000) Then
      Begin
        While (B>0) Do
          Begin
            If (B>=1000) Then
              Begin
                B:=B-1000;
                Rom:=Rom+'M';
              End
            Else If (B>=900) Then
              Begin
                B:=B-900;
                Rom:=Rom+'CM';
              End
            Else If (B>=500) Then
              Begin
                B:=B-500;
                Rom:=Rom+'D';
              End        
            Else If (B>=400) Then
              Begin
                B:=B-400;
                Rom:=Rom+'CD';
              End
            Else If (B>=100) Then
              Begin
                B:=B-100;
                Rom:=Rom+'C';
              End
            Else If (B>=90) Then
              Begin
                B:=B-90;
                Rom:=Rom+'XC';
              End
            Else If (B>=50) Then
              Begin
                B:=B-50;
                Rom:=Rom+'L';
              End
            Else If (B>=40) Then
              Begin
                B:=B-40;
                Rom:=Rom+'XL';
              End
            Else If (B>=10) Then
              Begin
                B:=B-10;
                Rom:=Rom+'X';
              End
            Else If (B>=9) Then
              Begin
                B:=B-9;
                Rom:=Rom+'IX';
              End
            Else If (B>=5) Then
              Begin
                B:=B-5;
                Rom:=Rom+'V';
              End
            Else If (B>=4) Then
              Begin
                B:=B-4;
                Rom:=Rom+'IV';
              End
            Else If (B>=1) Then
              Begin
                B:=B-1;
                Rom:=Rom+'I';
              End
            Else
              B:=B-1;
          End;
        Writeln('Desimal ',B1,' = ',Rom,' Romawi');
      End
    Else
      Writeln('Tidak Diketahui Simbol Romawinya!');
    Writeln;
    Write('Mau Coba Lagi? [Y/T]: ');
    Ul:=Upcase(ReadKey);
  Until (Ul<>'Y');
End.

Program Konversi_Desimal_Ke_Biner;
Uses WinCrt;
Var
  Des,Desi: Integer;
  Bin: String;
  Ul:Char;
Begin
  Repeat
    Clrscr;
    Writeln('Program Konversi Desimal Menjadi Biner');
    Writeln('======================================');
    Writeln;
    Write('Masukkan Bilangan Desimal: ');Readln(Des);
    Desi:=Des;
    Bin:='';
    Repeat
      If(Des Mod 2 = 0) Then
        Bin:='0'+Bin
      Else
        Bin:='1'+Bin;
      Des:=Des Div 2;
    Until Des=0;
    Writeln;
    Writeln(Desi,' Desimal = ',Bin,' Biner');
    Writeln;
    Write('Mau Ulang Lagi? [Y/T]: ');Readln(Ul);
    Ul:=Upcase(Ul);
  Until (Ul<>'Y');
End.