MENU HITUNG

uses wincrt;

procedure tanya_hitung1;

var

x,y,h:real;

begin

write('Nilai x?');readln(x);

write('Nilai x?');readln(x);

h:=x*y;

writeln('Hasil perkalian= ',h:5:2);

end;

procedure tanya_hitung2;

var

x,y,h:real;

begin

write('Nilai x?');readln(x);

write('Nilai x?');readln(x);

h:=x+y;

writeln('Hasil penjumlahan= ',h:5:2);

end;

procedure menu;

var

j:integer;

begin

writeln('MENU HITUNG');

writeln('1.Perkalian');

writeln('2.Penjumlahan');

write('Pilih no?(1/2)');readln(j);

if j=1 then

begin

clrscr;

tanya_hitung1;

end;

if j=12 then

begin

clrscr;

tanya_hitung12;

end;

end;

begin

menu;

end.

Rata-rat,Max,Min

uses wincrt;
var
a,b,c,max,min:integer;
rata:real;
begin
write('Nilai 1 = '); readln(a);
write('Nilai 2 = '); readln(b);
write('Nilai 3 = '); readln(c);
rata:=(a+b+c)/3;
if a>b then
if a begin
max:=c;
min:=b;
end
else
begin
max:=a;
min:=c;
end
else
if b>c then
begin
max:=b;
min:=c;
end
else
begin
max:=c;
min:=a;
end;
writeln;
writeln('Rata-rata = ',rata:3:2);
writeln('Bilangan terbesar = ',max);
writeln('Bilangan terkecil = ',min);
end.

FIBONACCI

uses wincrt;

var
a:array[1..100] of real;
i,n:integer;

begin
write ( 'Masukkan suku keberapa deret fibonacci: ');readln(n);
a[1]:=1;
a[2]:=1;

for i:=2 to n do
a[i+1]:=a[i]+a[i-1];
for i:=1 to n do
write (a[i]:2:0,' ');


end.

PROGRAM LUAS SEGITIGA

uses wincrt;
var
a,t,L:real;
begin
write('panjang alas segitiga = ');
readln (a);
write('tinggi segitiga = ');
readln (t);
L:=1/2*a*t;
writeln('Luas Segitiga = ',L:6:2);
end.

PROSEDUR TANYA HITUNG

uses wincrt;

procedure tanya_hitung1;

var

x,y,h:real;

begin

write('Nilai x?');readln(x);

write('Nilai x?');readln(x);

h:=x*y;

writeln('Hasil perkalian= ',h:5:2);

end;

procedure tanya_hitung2;

var

x,y,h:real;

begin

write('Nilai x?');readln(x);

write('Nilai x?');readln(x);

h:=x+y;

writeln('Hasil penjumlahan= ',h:5:2);

end;

procedure menu;

var

j:integer;

begin

writeln('MENU HITUNG');

writeln('1.Perkalian');

writeln('2.Penjumlahan');

write('Pilih no?(1/2)');readln(j);

if j=1 then

begin

clrscr;

tanya_hitung1;

end;

if j=12 then

begin

clrscr;

tanya_hitung12;

end;

end;

begin

menu;

end.

ATM

uses wincrt;

var

uang:longint;

begin

write('Banyaknya uang:Rp ');raedln(uang);

if uang>100000 then

writeln('Tidak ambil uang di ATM')

else

writeln('Ambil uang di ATM');

end.

TANGGALAN

uses wincrt;
var
a,b,c,d,hr,bln,th:integer;
t,bl,thn:longint;
begin
write('Masukkan sembarang tanggal: ');read(a);read(b);readln(c);
write('Masukkan sembarang hari: ');readln(d);
th:=d div 360;
bln:=(d mod 360) div 30;
hr:=d mod 30;
writeln(d,'hr= ',th,'tahun',bln,'bulan',hr,'hari');
t :=a+hr;
bl:=b+bln;
thn:=c+th;
if t>30 then
begin
t:=(a+hr) mod 30;
bl:=((a+hr) div 30) + (b+bln);
end;
if bl>12 then
begin
bl:=(((a+hr) div 30) + (b+bln)) mod 12;
thn:=((b+bln) div 12) + (c+th);
end;
writeln('Jadi',d,'hari lagi tanggal',t,' ',bl,' ',thn);
end.

KONVERSI METER KE CENTI

uses wincrt;
var
m:integer;
cm,mm:longint;
begin
write('Masukkan bilangan dalam bentuk m: ');readln(m);
cm:=100*m;
mm:=1000*m;
writeln(m,'m= ',cm,'cm');
writeln(m,'m= ',mm,'mm');
end.

ULANG NAMA,NIM

Perulangan nama,nim. Input nama,nim,pertanyaan 'Apakah ingin ada perulangan?'

uses wincrt;
var
nama,nim:string;
j:char;
begin
write('Nama: ');readln(nama);
write('NIM: ');readln(nim);
write('Apakah ingin diulang lagi?: ');readln(j);
if j='y' then
begin
clrscr;
repeat
write('Nama: ');readln(nama);
write('NIM: ');readln(nim);
write('Apakah ingin diulang lagi?: ');readln(j);
clrscr;
until j='t';
writeln('Terima kasih');
end;
else
if j='t' then writeln('Terima kasih') else writeln(' ');
end.

Lulus-Tidak Lulus

Menampilkan NA= 40% UTS + 60% UAS dan keterangan( lulus atau tidak).
Lulus jika NA>50. Input nama, NIM, UTS, UAS.

uses wincrt;
var
nim,nama:sting;
uts,uas:integer;
na:real;
begin
write('NIM = '); readln(nim);
write('Nama = '); readln(nama);
write('Nilai UTS = '); readln(uts);
write('Nilai UAS = '); readln(uas);
na:=(40/100*uts)+(60/100*uas);
writeln('Nilai akhir = ',na:10:2);
if na>50 then
writeln('LULUS');
else
writeln('TIDAK LULUS');
end.

RUMUS ABC

Mencari akar-akar pers. kuadrat menggunakan rumus ABC

uses wincrt;
var
a,b,c:integer;
D,x1,x2:real;
begin
write('Nilai a = '); readln(a);
write('Nilai b = '); readln(b);
write('Nilai c = ');readln(c);
D:=(sqr b)-(4*a*c);
if D=0 then
begin
x1:=-b/(2*a);
x2:=-b/(2*a);
writeln('x1 = ',x1:8:2);
writeln('x2 = ',x2:8:2);
end
else
if D>0 then
begin
x1:=(-b+sqrt(D))/(2*a);
x2:=(-b-sqrt(D))/(2*a);
writeln('x1 = ',x1:8:2);
writeln('x2 = ',x2:8:2);
end
else
writeln('x1 dan x2 adalah bilangan imginer');
end.

PERULANGAN KATA

uses wincrt;

var

k1,k2,k3:string;

n,x:integer;

begin

write('Masukkan kata 1: ');readln(k1);

write('Masukkan kata 2: ');readln(k2);

write('Masukkan kata 3: ');readln(k3);

write('Masukkan perulangan: ');readln(x);

n:=1;

repeat

if n

n:=n+1;

until n>x;

end.

PROGRAM FAKTORIAL

uses wincrt;

function faktorial(a:integer):longint;
begin
if(a=1) then
faktorial:=1 else
faktorial:=a*faktorial(a-1);
end;

var
x:integer;
begin
writeln('Faktorial');
write('Berapa faktorial ?: ');readln(x);
writeln(x,'faktorial = ',faktorial(x));
readln;
end.

INPUT DATA

uses wincrt;
var
a,b,x:integer;
nilai:array[1..10] of integer;
no,nama,nim:array[1..10]of string;

procedure input_data;
begin
clrscr;
write('Berapa data yang diinginkan: ');readln(a);
begin
for b:=1 to a do
begin
write('No.');readln(no[b]);
write('Nama: ');readln(nama[b]);
write('NIM: ');readln(nim[b]);
write('Nilai: ');readln(nilai[b]);
end;
end;
end;
procedure lap_data;
begin
clrscr;
gotoxy(25,5);writeln('DAFTAR NILAI MAHASISWA');
gotoxy(25,6);writeln('SEMESTER III');
writeln('--------------------------------');
writeln('|| No || Nama || NIM || Nilai ||');
writeln('--------------------------------');
for b:=1 to a do
begin
write(' ',no[b],' ');
write(' ',nama[b],' ');
write(' ',nim[b],' ');
write(' ',nilai[b],' ');
writeln;
end;
end;
begin
writeln('Menu');
writeln('1.Input Data');
writeln('2.Laporan Data');
write('Tekan 1 untuk menginput data: ');readln(x);
if x=1 then
begin
input_data;
end;
write('Tekan 2 untuk melihat laporan data: ');readln(x);
if x=2 then
begin
lap_data;
end;
end.

Perkalian Matriks

uses wincrt;
type
larik=array[1..25,1..25] of real;
var
i,j,k:byte;
m,n,l:byte;
A,B,C:larik;
begin
clrscr;
write('Baris matriks pertama? '); readln(m);
write('Kolom matriks pertama/ baris matriks kedua? '); readln(n);
write('Kolom matriks kedua? '); readln(l);
writeln;
writeln('Matriks yang pertama');
for i:=1 to m do
begin
for j:=1 to n do
begin
write('Nilai [ ',i,' , ',j,' ]? '); readln(A[i,j]);
end;
writeln;
end;
writeln('Matriks yang kedua');
for i:=1 to n do
begin
for j:=1 to l do
begin
write('Nilai [ ',i,' , ',j,' ]? '); readln(B[i,j]);
end;
writeln;
end;
writeln('Perkalian Matriks');
for i:=1 to m do
begin
for j:=1 to n do
begin
C[i,j]:=o;
for k:=1 to l do
C[i,j]:=C[i,j]+A[i,k]*B[k,j];
end;
end;
clrscr;
writeln('Hasil Perkalian Matriks');
writeln;
for i:=1 to m do
begin
for j:=1 to l do
write(C[i,j]:5:0);
writeln
end;
end.

Permainan Segitiga Asyik...

uses wincrt;
var
a,b,n:integer;
begin
write('Masukkan banyak angka = '); readln(n);
writeln;
for a:=1 to n do
begin
for b:=1 to a do
write(a:2);
write(' ');
writeln;
end;
end.


"Selamat Mencoba....^^

MARI BERNYANYI

program anak_ayam
uses wincrt;
var
x,n:integer;
begin
writeln('Lagu Anak Ayam');
writeln;
write('Masukkan banyaknya anak ayam yang ingin ditampilkan: ');readln(x);
writeln;
writeln('Tek kotek kotek kotek anak ayam turun berkotek');
writeln('Anak ayam turunlah ',x);
n:=x-1;
repeat
if n>1 then
begin
writeln('Mati satu tinggalah ',n);
end
else
writeln('Mati satu tinggalah ',n);
writeln('Anak ayam turunlah ',n);
n:=n-1;
until n=0;
writeln('Mati semua tinggal induknya');
end.

PROGRAM PANGKAT

program perpangkatan;
uses wincrt;
var
n,x:integer;
function pangkat(M:integer):longint;
begin
if M=0 then
pangkat:=1;
else
pangkat:=n*pangkat(M-1);
end;
begin
clrscr;
writeln('Perpangkatan');
write('Input bilangan : '); readln(n);
write('Input Pangkat : '); readln(x);
writeln(n,' pangkat ',x,' = ',pangkat(x));
end.

INPUTAN MATRIKS

program input_matriks;
uses wincrt;
var
tabel:array[1..6,1..6] of integer;
m,n,i,j:integer;
begin
write('Input baris: ');readln(m);
write('Input kolom: ');readln(n);
writeln('Matriks yang anda input berukuran: ',m, 'x' ,n);

for i:=1 to m do
begin
for j:=1 to n do
begin
write('Tabel',i,'.',j,' ');readln(tabel[i,j]);
end;
end;
for i:=1 to m do
begin
for j:=1 to n do
write(tabel[i,j],' ');
writeln;
end;
end.

MENU KALKULATOR

Program Menu_Kalkulator;
uses wincrt;
var
a,b,x:integer;
jml,kurang,kali:longint;
begin
gotoxy(35:20); writeln('Selamat DAtang di Menu Kalkulator');
writeln('1. Penjumlahan');
writeln('2. Pengurangan');
writeln('3. Perkalian');
gotoxy(35:20); write('Input Menu yang Anda pilih : '); readln(x);

case x of
1:begin
clrscr;
write('masukkan a : '); readln(a);
write('masukkan b : '); readln(b);
jml:=(a+b);
writeln('Jumlah = ',jml);
end;
2:begin
clrscr;
write('masukkan a : '); readln(a);
write('masukkan b : '); readln(b);
kurang:=(a-b);
writeln('hasil Pengurangan = ',kurang);
end;
3:begin
clrscr;
write('masukkan a : '); readln(a);
write('masukkan b : '); readln(b);
kali:=(a*b);
writeln('hasil kali = ',kali);
end;
end;
end.