Ini Program Pencarian :
Program Searching;
uses crt;
label z,g,f, h,k ;
const max=100;
type
r=integer;
pegawai = record
no:r;
na:string[30];
ba:string[20];
ga:longint;
end;
tabel = array[1..max] of pegawai;
tabel1= array[1..max] of r;
var
a:tabel;
b:tabel1;
n, ni, i, j, t, pilih: r;
p:char;
nomor : array[1..25] of string;
nama : array[1..25] of string;
asal : array[1..25] of string;
procedure seqsearch(a:tabel; n:r; x:r; var isearch:r);
var
i:r;
begin
if (n=0) then
isearch:=0 else
begin
i:=1;
while ((a[i].no <x) and (i<n)) do
i:=i+1;
if (a[i].no=x) then
begin
writeln('Data Yang Dicari :');
writeln('Nomor Kendaran : ',a[i].no);
writeln('Nama Pembalap : ',a[i].na);
writeln('Asal Negara : ',a[i].ba);
writeln('Gaji Pembalap : Rp. ',a[i].ga);
end else
writeln('Data Tidak Ditemukan !!!');
end;
end;
procedure Tampil(pos : byte; bs : string);
begin
clrscr;
writeln('==========================');
gotoxy(pos,2);writeln(bs);
writeln('==========================');
writeln('Terdapat',i,' data ');
writeln;
for i:=1 to i do
begin
writeln('--------------');
writeln('Data ke-',i);
writeln('--------------');
writeln('Nomor Kendaraan : ',a[i].no);
writeln('Nama Pembalap : ',a[i].na);
writeln('Asal Negara : ',a[i].ba);
writeln('Gaji Pembalap : Rp. ',a[i].ga);
writeln;
end;
writeln;
write('Enter Untuk Lanjut');readln;
end;
procedure hapus;
var no,a : integer;
begin
Tampil(5,'Hapus Data');
if (i>0) then
begin
write('Data yang di hapus Urutan ke-');readln(no);
if (no>0) and (no<=i) then
begin
for i:=no to i-1 do
begin
nomor[i]:= nomor[i+1];
nama[i] := nama[i+1];
asal[i] := asal[i+1];
end;
i:=i-1;
writeln;
write('Data telah dihapus, enter ke menu');
readln
end
else
begin
writeln;
write('Nomor tidak tepat, enter ke menu');readln;
end;
end;
end;
procedure biner (a:tabel; n:r; x:r; var isearch:r);
var
atas, bawah, tengah :r;
found : boolean;
begin
if (n=0) then isearch :=0
else begin
bawah:=1;
atas:=n;
found:=false;
while ((not found) and (atas >= bawah)) do
begin
tengah:=(bawah + atas) div 2;
if (a[tengah].no=x) then
found:=true
else if (a[tengah].no >x) then
atas := tengah-1
else
bawah:=tengah+1;
end;
if found then
begin
isearch :=tengah;
writeln('Data Yang Dicari :');
writeln('Nomor Kendaraan : ',a[i].no);
writeln('Nama Pembalap : ',a[i].na);
writeln('Asal Negara : ',a[i].ba);
writeln('Gaji Pembalap : Rp. ',a[i].ga);
end else
writeln('Data Tidak Ditemukan !!!');
end;
end;
begin
h:clrscr;
GOTOXY(1,5);write('Jumlah Data Pembalap : '); readln(n);
writeln;
for i:=1 to n do
begin
write('Nomor Kendaraan Ke-',i,' : '); readln(a[i].no);
write('Nama Pembalap Ke-',i,' : '); readln(a[i].na);
write('Asal Negara Ke-',i,' : '); readln(a[i].ba);
write('Gaji Pembalap Ke-',i,' : '); readln(a[i].ga);
writeln;
end;
z:clrscr;
gotoxy(25,5);writeln('-----------------------------');
gotoxy(25,6);writeln('********** M E N U **********');
gotoxy(25,7);writeln('-----------------------------');
gotoxy(25,10);writeln('1. Cari Data');
gotoxy(25,12);writeln('2. Tampil Data');
gotoxy(25,14);writeln('3. Hapus Data');
gotoxy(25,16);writeln('4. Exit');
gotoxy(25,18);writeln('--------------------');
gotoxy(25,20);writeln('--------------------');
gotoxy(25,19);write('Pilihan = ');readln(pilih);
case pilih of
1 : begin
clrscr;
g:
TEXTBACKGROUND(BLUE);
GOTOXY(10,4);
writeln('*** cari data ***'); writeln;
for i:=1 to n-1 do
begin
for j:=1 to n-1 do
begin
if (a[j].no) > (a[j+1].no) then
begin
t:=a[j].no;
a[j].no:=a[j+1].no;
a[j+1].no:=t;
end;
end;
end;
write('Nomor Kendaraan Dicari : '); readln(ni);
writeln;
seqsearch(a,n,ni,i);writeln;
write('Ingin Cari Lagi (y/t) : ');readln(p);
writeln;
if (p='Y') or (p='y') then goto g;
goto z;
writeln;
end;
2: begin
clrscr;
tampil(3,'Tampil Data');
writeln;
write('Ingin Cari Lagi (y/t) : ');readln(p);
writeln;
if (p='Y') or (p='y') then goto g;
goto z;
writeln
end;
3: begin
clrscr;
hapus;
writeln;
if (p='Y') or (p='y') then goto g;
goto z;
writeln
end;
4: begin
clrscr;
TEXTCOLOR(YELLOW);
GOTOXY(20,10);
write('***********PROGRAM SELESAI************');
GOTOXY(20,11);
WRITE('======================================');
TEXTCOLOR(WHITE);
GOTOXY(26,12);
end else
TEXTCOLOR(WHITE);
writeln; writeln;
write('MAAF ANDA BELUM BERUNTUNG');
end;
readkey;
end.
Program Kalkulator :
Program kalkulator;
Uses Crt;
Var bil1,bil2,hasil:Real;
calc:integer;
lagi:char;
Begin
Clrscr;
Repeat
Clrscr;
Writeln('**************************************');
Writeln('========= Program Kalkulator =========');
Writeln('**************************************');
Writeln;
Writeln('============ MENU UTAMA ==============');
Writeln;
Writeln(' 1. Perkalian ');
Writeln(' 2. Penjumlahan ');
Writeln(' 3. Pembagian ');
Writeln(' 4. Pengurangan ');
Writeln(' 5. Pangkat Dua (N^2)');
Writeln(' 6. Keluar ');
Writeln('--------------------------------------');
Writeln;
Write('Masukan pilihan : '); readln(calc);
If calc > 6 then
Write('Inputan Salah');
Readkey;
Case calc of
1 : Begin
Repeat
Clrscr;
Write('Masukan Bilangan 1 : '); readln(bil1);
Write('Masukan Bilangan 2 : '); readln(bil2);
Hasil:=bil1*bil2;
Writeln('------------------------');
Writeln('Hasil perkalian : ',hasil:0:2);
Repeat
Write('apakah anda ingin mengulang ? [Y/T] : '); readln(lagi);
If (lagi <> 'T') or (lagi <> 'Y') then CLRSCR;
Writeln('Masukan Salah');
Writeln('Inputkan lagi');
Until (lagi = 'Y') or (lagi = 'T');
Until lagi = 'T';
End;
2 : Begin
Repeat
Clrscr;
Write('Masukan Bilangan 1 : '); readln(bil1);
Write('Masukan Bilangan 2 : '); readln(bil2);
Hasil:=bil1+bil2;
Writeln('------------------------');
Writeln('Hasil penjumlahan : ',hasil:0:2);
Repeat
Write('apakah anda ingin mengulang ? [Y/T]: '); readln(lagi);
If (lagi <> 'T') or (lagi <> 'Y') then CLRSCR;
Writeln('Masukan Salah');
Writeln('Inputkan lagi');
Until (lagi = 'Y') or (lagi = 'T');
Until lagi = 'T';
End;
3 : Begin
Repeat
Clrscr;
Write('Masukan Bilangan 1 : '); readln(bil1);
Write('Masukan Bilangan 2 : '); readln(bil2);
If bil2=0 then
Begin
Writeln('Syntax Error !!!!');
Hasil:=0;
End else
Hasil:=bil1/bil2;
Writeln('------------------------');
Writeln('Hasil pembagian : ',hasil:0:2);
Repeat
Write('apakah anda ingin mengulang ? [Y/T]: '); readln(lagi);
If (lagi <> 'T') or (lagi <> 'Y') then CLRSCR;
Writeln('Masukan Salah');
Writeln('Inputkan lagi');
Until (lagi = 'Y') or (lagi = 'T');
Until lagi = 'T';
End;
4 : Begin
Repeat
Clrscr;
Write('Masukan Bilangan 1 : '); readln(bil1);
Write('Masukan Bilangan 2 : '); readln(bil2);
Hasil:=bil1-bil2;
Writeln('------------------------');
Writeln('Hasil pengurangan : ',hasil:0:2);
Repeat
Write('apakah anda ingin mengulang ? [Y/T]: '); readln(lagi);
If (lagi <> 'T') or (lagi <> 'Y') then CLRSCR;
Writeln('Masukan Salah');
Writeln('Inputkan lagi');
Until (lagi = 'Y') or (lagi = 'T');
Until lagi = 'T';
End;
5 : Begin
Repeat
Clrscr;
Write('Masukan Bilangan : '); readln(bil1);
Hasil:= Sqr (bil1);
Writeln('------------------------');
Writeln('Hasil pangkat : ',hasil:0:2);
Repeat
Write('apakah anda ingin mengulang ? [Y/T]: '); readln(lagi);
If (lagi <> 'T') or (lagi <> 'Y') then CLRSCR;
Writeln('Masukan Salah');
Writeln('Inputkan lagi');
Until (lagi = 'Y') or (lagi = 'T');
Until lagi = 'T';
End;
6 : Begin
Repeat
Clrscr;
Write('Apahkah anda Yakin ingin Keluar ? [Y/T] '); readln(lagi);
If (lagi <> 'T') or (lagi <> 'Y') then CLRSCR;
Until (lagi = 'Y') or (lagi = 'T');
If lagi= 'Y' then
Begin
Clrscr;
Writeln('Program keluar ... GOOD BYE ^_^ !!!');
Readkey;
Exit;
End else
Write('Tekan sembarang tombol untuk kembali...');
Readkey;
End;
End;
Until lagi = 'A'; Readkey;
End.
Tidak ada komentar:
Posting Komentar