Program Kasir

uses wincrt;
var nama_barang : array[1..20] of string;
harga : array[1..20] of real;
banyak : array[1..20] of byte;
kata,grs :string;
x,y,i,j :byte;
Jum_Harga,Total_Harga,disc,Total_Bayar,uang :real;
begin
clrscr;
grs:='===============================================================';
kata:='Program Kasir';
x:=round((78-length(kata))/2);
gotoxy(x,2);writeln(kata);
x:=round((78-length(grs))/2);
gotoxy(x,3);write(grs);
{-----------------------------}
gotoxy(x,4);write('Data Belanja');
gotoxy(x,5);write(grs);
30
gotoxy(x,6);writeln('| No | Nama Barang | Harga Satuan |
Banyak | Jumlah Harga |');
gotoxy(x,7);write(grs);
{--------------------------------------------------------------------}
i:=0;
Total_Harga:=0;
repeat
i:=i+1;
gotoxy(x,7+i);write('| ',i);
gotoxy(x+5,7+i);write('|');
gotoxy(x+7,7+i);readln(Nama_barang[i]);
if Nama_Barang[i] <>'' then begin
gotoxy(x+25,7+i);write('|');
gotoxy(x+28,7+i);readln(Harga[i]);
gotoxy(x+28,7+i);writeln(Harga[i]:10:2);
gotoxy(x+41,7+i);write('|');
gotoxy(x+44,7+i);readln(Banyak[i]);
gotoxy(x+50,7+i);write('|');
Jum_Harga:=Harga[i]*Banyak[i];
gotoxy(x+53,7+i);writeln(Jum_Harga:10:2);
gotoxy(x+65,7+i);writeln('|');
Total_Harga:=Total_Harga+Jum_Harga ; end;
until nama_barang[i]='';
{--------------------------------------------------------------------}
disc:=0;
if (Total_Harga > 10000) and (Total_Harga <100000) then
disc:=0.05 * Total_Harga
else
if (Total_Harga >= 100000 ) then
disc:=0.1 *Total_Harga;
{--------------------------------------------------------------------}
kata:='Faktur Penjualan';
y:=round((78-length(kata))/2);
gotoxy(y,2);writeln(kata);
j:=i-1;
gotoxy(x,8+j);write(grs);
gotoxy(x,8+j+1);write('Total Belanja :');
gotoxy(x+53,8+j+1);write(Total_Harga:10:2);
gotoxy(x,8+j+2);write('Discount :');
gotoxy(x+53,8+j+2);write(disc:10:2);
gotoxy(x,8+j+3);write(grs);
gotoxy(x,8+j+4);write('Total Bayar setelah discount :');
Total_Bayar:=Total_Harga-disc;
gotoxy(x+53,8+j+4);write(Total_Bayar:10:2);
gotoxy(x,8+j+5);write('Uang diBayar');
gotoxy(x+53,8+j+5);readln(Uang);
gotoxy(x+53,8+j+5);writeln(Uang:10:2);
gotoxy(x,8+j+6);Write(grs);
gotoxy(x,8+j+7);write('Uang Kembali');
gotoxy(x+53,8+j+7);write(Uang-Total_Bayar:10:2);
end.

Baca Selengkapnya >>

Program Menghitung_Banyak_Vokal

uses wincrt;
var
nama :string;
i,vok :integer;
BEGIN
clrscr;
vok:=0;
write('Masukkan Sebuah Kata =');readln(nama);
for i:=1 to length(nama) do
case nama[i] of
'A','a','U','u','I','i','E','e','O','o':vok:=vok+1;
end;
writeln('Jumlah Vokalnya :',vok);
READLN;
END.

Baca Selengkapnya >>

PROGRAM UNTUK MENGURUTKAN DATA DENGAN METODE RADIX SORT

Uses WinCrt;
Type
Pointer = ^TypeData;
TypeData = Record
Nilai : integer;
Berikutnya : Pointer;
End;
Pointer2 = Array[0..9] Of Pointer;
Var
List : Pointer;
Q : Pointer2;
{====================================================================}
{===================== MASUK DATA DARI DEPAN ========================}
{====================================================================}
Procedure Masuk_Depan(Var L : Pointer; X : Integer);
Var
Baru : Pointer;
Begin
New(Baru);
Baru^.Nilai := X;
Baru^.Berikutnya := Nil;
If L = Nil Then L := Baru
Else
Begin
Baru^.Berikutnya := L;
L :=Baru;
End;
End;
{====================================================================}
{======================= PROCEDURE INITIALIZATION ===================}
{====================================================================}
Procedure Initialization(Var Q : Pointer2);
Var
i : byte;
Begin
For i := 0 To 9 Do Q[i] := Nil;
End;
{====================================================================}
{=============== SUSUN DATA UNTUK TIAP MACAM DALAM ARRAY ============}
{====================================================================}
Procedure Susun(L : Pointer;Var Q1 : Pointer2);
Var
Bantu,Baru : Pointer;
i : Byte;
Begin
Bantu := L;
While Bantu <> Nil Do
Begin
New(Baru);
Baru^.Berikutnya := Nil;
Baru^.Nilai := Bantu^.Nilai;
Masuk_Depan(Q1[Baru^.Nilai],Baru^.Nilai);
Bantu := Bantu^.Berikutnya;
End;
End;
25
{====================================================================}
{=================== PROCEDURE CONCATINATION DATA ===================}
{====================================================================}
Procedure Concatination(L : Pointer2; Var Q1 : Pointer);
Var
Bantu,Baru : Pointer;
i : Byte;
Begin
For i := 0 To 9 Do
Begin
If L[i] <> Nil Then
Begin
Baru := L[i];
If Q1 = Nil Then Q1 := Baru
Else
Begin
Bantu := Q1;
While Bantu^.Berikutnya <> Nil Do
Bantu := Bantu^.Berikutnya;
Bantu^.Berikutnya := Baru
End;
End;
End;
End;
{====================================================================}
{========================= PROCEDURE CETAK DATA =====================}
{====================================================================}
Procedure Cetak(L : Pointer);
Var
Bantu : Pointer;
Begin
Bantu := L;
While Bantu <> Nil Do
Begin
Write(Bantu^.Nilai:3);
Bantu := Bantu^.Berikutnya;
End;
End;
{====================================================================}
{======================= PROCEDURE CETAK DATA =======================}
{====================================================================}
Procedure Cetak_Susunan(L : Pointer2);
Var
Bantu,Baru : Pointer2;
i : Byte;
Begin
For i := 0 to 9 do
Begin
Write(' Q[',i,'] =');
If L[i] <> Nil Then
Begin
Bantu[i] := L[i];
While Bantu[i] <> Nil Do
Begin
Write(Bantu[i]^.Nilai:3);
Bantu[i] := Bantu[i]^.Berikutnya;
End;
26
End;
Writeln;
End;
End;
{====================================================================}
{========================== PROGRAM UTAMA ===========================}
{====================================================================}
Var
Bil,N : Byte;
Begin
New(List);
List:=Nil;
Initialization(Q);
Randomize;
Repeat
Bil:=Random(10);
Masuk_Depan(List,Bil);
N:=N+1;
Until N=20;
Writeln;
Writeln(' Mengurutkan Data Dengan Metode RADIX SORT');
Writeln;
Writeln(' DATA SEBELUM DIURUTKAN ....');
Cetak(List);
Writeln;
Susun(List,Q);
writeln;
Writeln(' HASIL PENGELOMPOKAN ...');
Cetak_Susunan(Q);
Writeln;
List:=Nil;
Concatination(Q,List);
Writeln(' HASIL PENGURUTAN SETELAH DIKELOMPOKKAN');
Cetak(List);
writeln;
End.

Baca Selengkapnya >>

Program Hitung_Huruf

Program Hitung_Huruf;
Uses WinCrt;
Var
Teks : string;
banyak : array['A'..'Z'] of byte;
i : byte;
begin
Write('Masukkan Suatu Kalimat :');
Readln(Teks);
for i:=1 to length(teks) do
banyak[upcase(teks[i])]:=banyak[upcase(teks[i])]+1;
for i:=1 to 26 do
if (banyak[upcase(chr(64+i))]<>0) then
writeln(upcase(chr(64+i)),' banyaknya
=',banyak[upcase(chr(64+i))]);
end.

Baca Selengkapnya >>

program pecahan

uses wincrt;
var
uang,pecah1,pecah2,pecah3,pecah4,pecah5,pecah6,pecah7,pecah8,pecah9,pecah10
: longint;
begin
94
write('TOTAL Belanja = ');readln(uang);
pecah1:=uang div 100000;
uang:=uang mod 100000;
pecah2:=uang div 50000;
uang:=uang mod 50000;
pecah3:=uang div 20000;
uang:=uang mod 20000;
pecah4:=uang div 10000;
uang:=uang mod 10000;
pecah5:=uang div 5000;
uang:=uang mod 5000;
pecah6:=uang div 1000;
uang:=uang mod 1000;
pecah7:=uang div 500;
uang:=uang mod 500;
pecah8:=uang div 100;
uang:=uang mod 100;
pecah9:=uang div 50;
uang:=uang mod 50;
pecah10:=uang div 25;
uang:=uang mod 25;
writeln('100000 ada ',pecah1);
writeln('50000 ada ',pecah2);
writeln('20000 ada ',pecah3);
writeln('10000 ada ',pecah4);
writeln('5000 ada ',pecah5);
writeln('1000 ada ',pecah6);
writeln('500 ada ',pecah7);
writeln('100 ada ',pecah8);
writeln('50 ada ',pecah9);
writeln('25 ada ',pecah10);
end.

Baca Selengkapnya >>