RSS

Semoga apa yang ada bisa memberi manfaat kepada kita semua

Progam Pascal Pecahan Mata Uang

program Pecahan_Mata_Uang;
uses wincrt;
var uang,jumlah:longint;
ulang:char;


begin
repeat
writeln ('Masukkan Uang yang Dipunyai: '); readln(uang);
writeln ('Uang yang Dipunyai: Rp. ',uang,',-');
writeln ('Pecahan Uang yang Dipunyai: ');
if uang>100000 then

begin
jumlah:=uang div 100000;
writeln (jumlah,' Lembar Seratus Ribuan');
uang:=uang mod 100000;
end;
begin
jumlah:=uang div 50000;
writeln (jumlah,' Lembar Lima Puluh Ribuan');
uang:=uang mod 50000;
end;
begin
jumlah:=uang div 20000;
writeln (jumlah,' Lembar Dua puluh Ribuan');
uang:=uang mod 20000;
end;
begin
jumlah:=uang div 10000;
writeln (jumlah,' Lembar Sepuluh Ribuan');
uang:=uang mod 10000;
end;
begin
jumlah:=uang div 5000;
writeln (jumlah,' Lembar Lima Ribuan');
uang:=uang mod 5000;
end;
begin
jumlah:=uang div 2000;
writeln (jumlah,' Lembar Dua Ribuan');
uang:=uang mod 2000;
end;
begin
jumlah:=uang div 1000;
writeln (jumlah,' Lembar/Keping Seribuan');
uang:=uang mod 1000;
end;
begin
jumlah:=uang div 500;
writeln (jumlah,' Keping Lima Ratusan');
uang:=uang mod 500;
end;
begin
jumlah:=uang div 200;
writeln (jumlah,' Keping Dua Ratusan');
uang:=uang mod 200;
end;
begin
jumlah:=uang div 100;
writeln (jumlah,' Keping Seratusan');
uang:=uang mod 100;
end;
begin
jumlah:=uang mod 100;
writeln ('Sisa Rp. ',jumlah,',-');
end;
begin
writeln ('Mau Mengulangi? [Y/T]'); ulang:=upcase(readkey);
clrscr
end;
until ulang <> 'Y';
end.

Baca selengkapnya...
  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Progam Pascal Menentukan Nilai Tertinggi

program nilai;
uses wincrt;
var a,b,c:integer;
ulang:char;
begin
repeat
write ('Masukkan Nilai A: '); readln(a);
write ('Masukkan Nilai B: '); readln(b);
write ('Masukkan Nilai C: '); readln(c);

if (a > b) and (b > c) and (a > c) then
writeln ('Nilai A Merupakan Nilai Tertinggi Dan Nilai C Merupakan Nilai Terendah') else
if (a > b) and (c > b) and (a > c) then
writeln ('Nilai A Merupakan Nilai Tertinggi Dan Nilai B Merupakan Nilai Terendah') else
if (a < b) and (b < c) and (a < c) then writeln ('Nilai C Merupakan Nilai Tertinggi Dan Nilai A Merupakan Nilai Terendah') else if (a > b) and (b < c) and (a < c) then writeln ('Nilai C Merupakan Nilai Tertinggi Dan Nilai B Merupakan Nilai Terendah') else if (a < b) and (b > c) and (a < c) then writeln ('Nilai B Merupakan Nilai Tertinggi Dan Nilai A Merupakan Nilai Terendah') else if (a < b) and (b > c) and (a > c) then
writeln ('Nilai B Merupakan Nilai Tertinggi Dan Nilai C Merupakan Nilai Terendah');
writeln ('Mau Mengulangi? [Y/T]'); ulang:=upcase(readkey);
clrscr;
until ulang <> 'Y';
end.

Baca selengkapnya...
  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Progam Pascal Luas Lingkaran, Luas Segitiga Dan Perulangan

program Pascal;
uses wincrt;
var pilih,ulang:char;

procedure lingkaran;
var r,luas_l:real;
begin
     writeln ('    Luas Lingkaran    ');
     writeln ('======================');
     write   ('Jari-Jari Lingkaran: '); readln (r);
     luas_l:=pi*sqr(r);
     writeln ('Luas Lingkaran: ',luas_l:4:2);
end;

procedure segitiga;
var a,t,luas_s:real;
begin
     writeln ('    Luas Segitiga    ');
     writeln ('=====================');
     write ('Panjang Alas Segitiga: '); readln (a);
     write ('Tinggi Segitiga: '); readln (t);
     luas_s:=(1/2)*a*t;
     writeln ('Luas Segitiga: ',luas_s:4:2);
end;

procedure perulangan;
var pilih:char;

    procedure baris;
    var n,baris:integer;
    begin
         writeln ('Jumlah Bintang Dalam Baris');
         writeln ('==========================');
         write   ('Jumlah Bintang: '); readln (n);
         for baris:=1 to n do
         write ('*');
         writeln;
    end;

    procedure kolom;
    var n,kolom:integer;
    begin
         writeln ('Jumlah Bintang Dalam Kolom');
         writeln ('==========================');
         write   ('Jumlah Bintang: '); readln (n);
         for kolom:=1 to n do
         writeln ('*');
    end;

    procedure urut;
    var n,baris,kolom:integer;
    begin
         writeln ('         Berurutan         ');
         writeln ('===========================');
         write   ('Jumlah Bintang: '); readln (n);
         for baris:=1 to n do
         for kolom:=1 to baris do
         if kolom=baris then writeln('*')
         else write ('*');
    end;

begin
repeat
     writeln ('       MENU PERULANGAN       ');                
     writeln ('=============================');
     writeln ('1. Jumlah Bintang dalam Baris');
     writeln ('2. Jumlah Bintang dalam Kolom');
     writeln ('3. Berurutan');
     writeln ('=============================');
     write   ('Masukkan pilihan anda [1 - 3]: '); readln(pilih);
     clrscr;
     if pilih='1' then baris else
     if pilih='2' then kolom else
     if pilih='3' then urut else writeln ('Program Tidak Ada');
     write   ('Mau Kembali ke Program Perulangan [Y atau T]? : '); readln (ulang);
     if (ulang='Y') or (ulang='y') then clrscr;
until (ulang='T') or (ulang='t');
end;

begin
repeat
      clrscr;
      writeln ('          MENU UTAMA          ');
      writeln ('==============================');
      writeln ('1. Menghitung Luas Lingkaran');
      writeln ('2. Menghitung Luas Segitiga ');
      writeln ('3. Perulangan');
      writeln ('==============================');
      write   ('Masukkan pilihan anda [1 - 3]: '); readln(pilih);
      clrscr;
      if pilih='1' then lingkaran else
      if pilih='2' then segitiga else
      if pilih='3' then perulangan else writeln ('Program Belum Tersedia');
      write   ('Mau Kembali ke Progam Utama [Y atau T]? : '); readln (ulang);
until (ulang='T') or (ulang='t');
clrscr;
writeln ('Terima Kasih Sudah Menggunakan Program Kami');
end.

Baca selengkapnya...
  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS