PASUPALI

Tampilkan postingan dengan label Pemrograman Sourse code pascal. Tampilkan semua postingan

Senin, 24 Juni 2013

Tugas Strutur Data Persentasi (Pascal)

Hmmm..... Dunia Semakin Tua dan Ilmu Pengetahuan juga semakin Bertambah...Kali ini saya akan membahas tentang Linked List dan atrian....
Berikut ini adalah source Codenya.......
Program apotek =====>

program pelayanan_apotek;
uses wincrt;
type obat=^pointer;
	pointer=record
	namaobat:string;
        haobat:real;
        kodeobat:byte;
	next:obat;
end;
type antrian=^pointer2;
	pointer2=record
	nama:string;
	next2:antrian;
end;

type penjualan=^pointer3;
	pointer3=record
	namaobat3:string;
        kodeobat3:byte;
	haobat3:real;
	next3:penjualan;
end;

var awal,akhir,baru,bantu,hapus:obat;
	awal2,akhir2,baru2,bantu2,hapus2:antrian;
	awal3,akhir3,baru3,bantu3,hapus3:penjualan;
	nmobat,nmbeli,obatbeli,nmbaru,obatbeli2:string;
	hargabaru,hargabeli:real;
	pil,i,kdobat:byte;
	ketemu:boolean;

procedure tambah_obat (var L:obat;x:string;y:real;z:byte);
begin
	new(baru);
	baru^.namaobat:=x; baru^.haobat:=y;
        baru^.kodeobat:=z;
	baru^.next:=nil;
if L=nil then
begin
L:=baru;akhir:=baru;
end
else
begin
     baru^.next:=L;
     L:=baru;
end;
end;

procedure cetak_obat(var L:obat);
begin
	new(bantu);
	bantu:=L;
	writeln;
        writeln('+-----+-----+-----+-----+-----+');
	writeln('|        DAFTAR OBAT          |');
        writeln('+-----+-----+-----+-----+-----+');
	writeln('| Nama obat | Kode|   Harga   |');
        writeln('+-----+-----+-----+-----+-----+');
	while bantu<>nil do
	begin
	writeln(bantu^.namaobat:8,' ',bantu^.kodeobat:8,' ',bantu^.haobat:8:2);
	bantu:=bantu^.next;
	end;
writeln;
end;

procedure cetak_penjualan(var L:penjualan);
begin
	new(bantu3);
	bantu3:=L;
	writeln(' Nama   Kode    Harga');
	while bantu3<>nil do
	begin
	writeln(bantu3^.namaobat3:8,' ',bantu3^.kodeobat3:8,' ',bantu3^.haobat3:8 :2);
	bantu3:=bantu3^.next3;
	end;
writeln;
end;

procedure cetak_rekap(var L:penjualan);
begin
	new(bantu3);
	bantu3:=L;
	writeln(' Nama    Kode    Harga');
	while bantu3<>nil do
	begin
	writeln(bantu3^.namaobat3:8,' ',bantu3^.kodeobat3:8,' ',bantu3^.haobat3:8:2);
	bantu3:=bantu3^.next3;
end;
writeln;
end;

procedure tambah_antri (var k:antrian;x:string);
begin
new(baru2);
baru2^.nama:=x;
baru2^.next2:=nil;
if awal2=nil then
begin
awal2:=baru2;k:=baru2;
end
else
begin
k^.next2:=baru2;
k:=baru2;
end;
end;

procedure cetak_antri(var k:antrian);
begin
new(bantu2);
bantu2:=k;
writeln(' Pengantri saat ini adalah ');
while bantu2<>nil do
begin
write(bantu2^.nama:8,' ');
bantu2:=bantu2^.next2;
end;
end;

procedure cari_obat(var L:obat;x:string);
begin
new(bantu);bantu:=L;
ketemu:=false;
while (bantu<>nil) and (ketemu=false) do
begin
if bantu^.namaobat=x then ketemu:=true;
if ketemu=true then
writeln(bantu^.namaobat:8,' ',bantu^.kodeobat:8,' ',bantu^.haobat:8:2)
else 
writeln(' Obat tidak tersedia');
bantu:=bantu^.next;
end;
end;

{program utama}
begin
i:=0;
new(awal);awal:=nil; new(akhir);akhir:=nil;
new(awal2);awal2:=nil; new(akhir2);akhir2:=nil;
new(awal3);awal3:=nil;  new(akhir3);akhir3:=nil;
repeat
begin
clrscr;
        writeln('                    +-----+-----+-----+-----+-----+-----+-----+');
	writeln('                    |         PELAYANAN DI APOTIK K28B        |');
        writeln('                    +-----+-----+-----+-----+-----+-----+-----+');
	writeln('                    | 1. Tambah obat                          |');
	writeln('                    + 2. Tambah antrian                       +');
	writeln('                    | 3. Pelayanan                            |');
	writeln('                    + 4. Tampilkan obat yang tersedia         +');
	writeln('                    | 5. Tampilkan antrian                    |');
        writeln('                    | 5. Tampilkan antrian                    |');
	writeln('                    + 6. Tampilkan hasil penjualan            +');
	writeln('                    | 7. Tampilkan rekap pendapatan hari ini  |');
	writeln('                    + 8. Cari obat                            +');
	writeln('                    | 9. Selesai                              |');
        writeln('                    +-----+-----+-----+-----+-----+-----+-----+');
	write('pil anda ? : ');readln(pil);
	case pil of
	1: begin
           if i>15 then writeln('tumpukan sudah penuh') else
           begin
		writeln(' MENAMBAH STOCK OBAT');
		write('Masukkan Nama obat : ');readln(nmobat);
		write('Masukkan kode obat : ');readln(kdobat);
                write('Masukkan Harga     : ');readln(hargabaru);
		tambah_obat(awal,nmobat,hargabaru,kdobat);
		i:=i+1;
		cetak_obat(awal);
		end;
		end;
	2: begin
		writeln(' TAMBAH PENGANTRI');
		write('Masukkan nama pengantri : ');readln(nmbaru);
		tambah_antri(akhir2,nmbaru);
		cetak_antri(awal2);
		end;
	3: begin
		if awal2=nil then
           writeln('Antrian kosong')
           else
           begin
                begin
                     new(hapus2);
                     hapus2:=awal2;
                     nmbeli:=hapus2^.nama;
                     awal2:=awal2^.next2;
                     dispose(hapus2);
                end;
           writeln('saudara ',nmbeli,' ingin membeli obat ? ');
           cetak_obat(awal);readln(obatbeli);
           if awal<>nil then
                begin
                new(bantu);
                bantu:=awal;
                ketemu:=false;
                if awal^.namaobat=obatbeli then
                   begin
                   new(hapus);
                   hapus:=awal;
                   obatbeli2:=hapus^.namaobat;
                   hargabeli:=hapus^.haobat;
                   awal:=awal^.next;
                   dispose(hapus);  writeln('obat ',obatbeli2,' tersedia dan dibeli');
                   end else
                if akhir^.namaobat=obatbeli then
                   begin
                   new(bantu);new(hapus);
                   bantu:=awal;
                   while(bantu^.next)^.next<> nil do
                   bantu:=bantu^.next;
                   hapus:=bantu^.next;
                   obatbeli2:=hapus^.namaobat;
                   hargabeli:=hapus^.haobat;
                   akhir:=bantu;
                   akhir^.next:=nil;
                   dispose(hapus); writeln('obat ',obatbeli2,' tersedia dan dibeli');
                   end
                   else
                       begin
                            while bantu^.next<>nil do
                                   begin
                                        if(bantu^.next)^.namaobat=obatbeli then
                                        begin
                                        new(hapus);ketemu:=true;
                                        hapus:=bantu^.next;
                                        bantu^.next:=hapus^.next;
                                        obatbeli2:=hapus^.namaobat;
                                        hargabeli:=hapus^.haobat;
                                        dispose(hapus);
                                        writeln('obat ',obatbeli2,' tersedia dan dibeli');
                                        end;
                                       bantu:=bantu^.next;
                                   end;
                       end;

end;
             end;
             new(baru3);
             baru3^.namaobat3:=obatbeli2;
             baru3^.haobat3:=hargabeli;
             baru3^.namaobat3:=nmbeli;
             if awal3=nil then
             begin awal3:=baru3;
             akhir3:=baru3; end
             else begin baru3^.next3:=awal3;
             awal3:=baru3;end;
             i:=i-1;
      end;
	
	4: cetak_obat(awal);
	5: cetak_antri(awal2);
	6: cetak_penjualan(awal3);
	7: cetak_rekap(awal3);
	8: begin
		writeln(' Mencari obat didalam tumpukan');
		write('Masukkan nama obat yang akan dicari : ');readln(nmobat);
		if awal<>nil then
		begin
			cari_obat(awal,nmobat);
		end
		else
			writeln('Obat tidak ada dalam tumpukan');
		end;
	9: writeln('Terimakasih');
	end;
	readln;
	end;
	until pil=9;
	end.

semogah bermanfaat......jangan lupa iya kalo abis baca tinggalkan komentar anda dibahwa ini.........

Rabu, 20 Maret 2013

PROGRAM DATA MAHASISWA DENGAN TYPE DATA TERSTRUKTUR(Record di dalam Record)

Program Data_Mahasiswa;
Uses wincrt;

{------------TYPE RECORD------------}

  Type Tabel_Mhs = Record
     nim : String;
     nama: String;
     tgl : String;
  End;

  Type Tabel_MK = Record
     kode_MK : String;
     Nama_MK : String;
     jum_SKS : Integer;
  End;

  Type Tabel_Nilai = Record
     tugas     : Real;
     UTS       : Real;
     UAS       : Real;
     nil_Angka : Real;
     nil_Huruf : Char;
  End;

Var
  Mhs  : Array[1..20] of Tabel_Mhs;  
  MK   : Array[1..20] of Tabel_MK;
  Nilai: Array[1..20] of Tabel_Nilai;
  Angka: Real;
  i, n : Integer;


  {---PROCEDURE INPUT DATA MAHASISWA---}

     Procedure Mahasiswa;
     Begin
      With Mhs[i] do
        Begin          
          write('Nim Mahasiswa    : ');readln(nim);
          write('Nama Mahasiswa   : ');readln(nama);
          write('tgl lahir        : ');readln(tgl);
          Writeln;
        End;
      End;

  
  {---PROCEDURE INPUT MATAKULIAH---}

      Procedure Mata_Kuliah;
      Begin
       With MK[i] do
         Begin
           Write('Kode Mata Kuliah : ');readln(kode_MK);
           Write('Nama Mata Kuliah : ');readln(Nama_MK);
           Write('Jumlah SKS       : ');readln(jum_SKS);
           Writeln;
         End;
      End;


  {---FUNCTION HITUNG NILAI ANGKA---}

      Function Nilai_Mhs(tugas,UTS,UAS : Real; Var nil_Angka : Real) : Real; 
      Begin
        nil_Angka:= (0.2 * tugas) + (0.3 * UTS) + (0.5 * UAS);
        Nilai_Mhs:= nil_Angka;
      End;


{-----------PROGRAM UTAMA----------}

Begin
Write('Jumlah Data : ');readln(n);
Writeln;
For i:= 1 to n do
Begin
Writeln('Data',i);
Writeln('-------');
Mahasiswa;
Mata_Kuliah; 

With Nilai[i] do
   Begin
     Write('Nilai Tugas      : ');readln(tugas);
     Write('Nilai UTS        : ');readln(UTS);
     Write('Nilai UAS        : ');readln(UAS);
     Writeln('Nilai Angka      : ',Nilai_Mhs(tugas,UTS,UAS,nil_Angka):0:2);
     Angka:=Nilai_Mhs(tugas,UTS,UAS,nil_Angka);

      if Angka >= 81 then
         nil_Huruf:= 'A'
      Else if Angka >= 71 then
         nil_Huruf:= 'B'
      Else if Angka >= 61 then
         nil_Huruf:= 'C'
      Else if Angka >= 51 then
         nil_Huruf:= 'D'
      Else if Angka < 51 then
         nil_Huruf:= 'E';
     
     Writeln('Nilai Huruf      : ',nil_Huruf);readln;
   End;
 End;


{---MENAMPILKAN DATA DALAM BENTUK TABEL---}

Begin
Clrscr;
gotoxy(1,2);Writeln('DATA REPORT':45);
gotoxy(1,4);Writeln('[----][-------------][---------------][-----------][-----------][-------][-----]');
gotoxy(1,5);Writeln('[ NO ][     NIM     ][      Nama     ][  Kode MK  ][  Nama MK  ][  N.A  ][ N.H ]');
gotoxy(1,6);Writeln('[----][-------------][---------------][-----------][-----------][-------][-----]');

For i:= 1 to n do
 Begin
  gotoxy(1,6+i);Write('[    ][             ][               ][           ][           ][       ][     ]');
  gotoxy(3,6+i);Write(i);
  gotoxy(9,6+i);Write(Mhs[i].nim);
  gotoxy(24,6+i);Write(Mhs[i].nama);
  gotoxy(41,6+i);Write(Mk[i].Kode_MK);
  gotoxy(54,6+i);Write(Mk[i].nama_MK);
  gotoxy(67,6+i);Write(Nilai[i].nil_Angka:0:2);
  gotoxy(77,6+i);Write(Nilai[i].nil_Huruf);
 End;             
End;

End.

PROGRAM KASIR

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);
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.

MENGHITUNG BILANGAN GANJIL DAN GENAP

program marless;
uses wincrt;
var
j_ganjil, j_genap, b_ganjil, b_genap : integer;
jum, bil, b, x: integer;

begin
 writeln('***************************************************************');
        writeln('     Program Menghitung Bilangan Ganjil dan Bilangan Genap     ');
        writeln('       Proses Akan Berhenti Jika Bilangan sama dengan 10       ');
 writeln('***************************************************************');
        writeln;
 writeln('[-------][------------][------------][-----------][-----------]');
 writeln('[  Bil  ][  J.Ganjil  ][  B.Ganjil  ][  J.Genap  ][  B.Genap  ]');
 writeln('[-------][------------][------------][-----------][-----------]');
 gotoxy(4,9);readln(bil);
        writeln;
 
     if bil mod 2 <> 0 then
     b:= bil;
     if bil mod 2 <> 0 then
     jum:=1;
     if bil mod 2 = 0 then
     b:=0;
     if bil mod 2 = 0 then
            jum:=0;

     j_ganjil:= b + j_ganjil;
     b_ganjil:= jum + b_ganjil;

     gotoxy(17,9);write(b);
     gotoxy(30,9);write(jum);
 
     if bil mod 2 = 0 then
     b:= bil;
     if bil mod 2 = 0 then
     jum:=1;
     if bil mod 2 <> 0 then
            b:=0;
     if bil mod 2 <> 0 then
     jum:=0;

     j_genap:= b + j_genap;
     b_genap:= jum + b_genap;

     gotoxy(44,9);write(b);
     gotoxy(57,9);write(jum);

     gotoxy(1,9);write('[');
     gotoxy(9,9);write(']');
     gotoxy(10,9);write('[');
     gotoxy(23,9);write(']');
     gotoxy(24,9);write('[');
     gotoxy(37,9);write(']');
     gotoxy(38,9);write('[');
     gotoxy(50,9);write(']');
     gotoxy(51,9);write('[');
     gotoxy(63,9);writeln(']');


    while bil <> 10 do
    begin
        x:=x+1;
 gotoxy(4,9+x);readln(bil);
        
 begin
     if bil mod 2 <> 0 then
     b:= bil;
     if bil mod 2 <> 0 then
     jum:=1;
     if bil mod 2 = 0 then
     b:=0;
     if bil mod 2 = 0 then
            jum:=0;

     j_ganjil:= b + j_ganjil;
     b_ganjil:= jum + b_ganjil;

     gotoxy(17,9+x);write(b);
     gotoxy(30,9+x);write(jum);
 end;

        begin
     if bil mod 2 = 0 then
     b:= bil;
     if bil mod 2 = 0 then
     jum:=1;
     if bil mod 2 <> 0 then
            b:=0;
     if bil mod 2 <> 0 then
     jum:=0;

     j_genap:= b + j_genap;
     b_genap:= jum + b_genap;

     gotoxy(44,9+x);write(b);
     gotoxy(57,9+x);write(jum);
 end;
     gotoxy(1,9+x);write('[');
     gotoxy(9,9+x);write(']');
     gotoxy(10,9+x);write('[');
     gotoxy(23,9+x);write(']');
     gotoxy(24,9+x);write('[');
     gotoxy(37,9+x);write(']');
     gotoxy(38,9+x);write('[');
     gotoxy(50,9+x);write(']');
     gotoxy(51,9+x);write('[');
     gotoxy(63,9+x);writeln(']');
     end;
   writeln('[-------][------------][------------][-----------][-----------]');
   writeln(' Jumlah',j_ganjil:11,b_ganjil:12,j_genap:15,b_genap:12);


end.

Menggunakan Looping di dalam Array

program marless;
uses wincrt;
type larik=array[1..20] of integer;
var bil:larik;
i,n:byte;
kuad,akar:real;
ket,ket1,ket2:string;
lagi:char;

begin
lagi:='y';
repeat
begin
inc(n);
write ('Masukan bilangan bulat ke ',n,' ==> ');readln(bil[n]);
write('lagi<y/t>?');readln(lagi);
end
until (lagi<>'y');
writeln('----------------------------------------------------------------------');
writeln('No    Bilangan       Kuadrat      Akar       Pos/neg       gan/gen    ');
writeln('----------------------------------------------------------------------');
for i:=1 to n do
begin
     kuad :=sqr(bil[i]);
     if bil[i]<0 then ket :='imajiner' else akar:=sqrt (bil[i]);
     if bil[i]>0 then ket1:='positif' else if bil[i]<0 then ket1:='negatif' else ket1:='nol';
     if bil[i]=0 then ket2:='nol' else if (bil[i] mod 2 =0) then ket2:='genap' else ket2:='ganjil';
     write(i:2,'   ',bil[i]:4,'      ',kuad:6:0,'           ');
     if (bil[i]>=0) then write(akar:8:2) else write (ket);
     writeln('      ',ket1,'       ',ket2);
end;
writeln('---------------------------------------------------------------------');
writeln('TERIMAKASIH SUDAH MENCOBA');
end.

Kamis, 13 Desember 2012

PROGRAM MENCARI BILANGAN GENAP DAN GANGIL

Program ganjil_genap;
uses wincrt;
var
bil, i,g1,g2,j1,j2,n: integer;
rt1,rt2:real;
begin
write('Masukkan Banyaknya Data ' );readln(n);
for i := 1 to n do
begin
write('Bilangan ke:',i ,' ');readln(bil);
if bil mod 2 = 0 then
j1:=j1 +1;
g1:=g1+bil;
if bil mod 2 =1 then
j2:=j2+1;
g2:=g2+bil;
end;
rt1:=g1/j1;
rt2:=g2/j2;
writeln('Jumlah bil. Ganjil=' ,j2);
writeln('Jumlah bil. Genap=' ,j1);
writeln('Rerata Ganjil=' ,rt2:4:2);
writeln('Rerata Genap=' ,rt1:4:2);
writeln;
writeln;
write ('==============>TERIMA KASIH , ANDA SUDAH MENCOBA PROGRAM INI<==============');
writeln;
writeln;
write ('============================>SEMOGAH BERMANFAAT<============================');
writeln;
writeln;
write(' BY PROGRAM : LUCIO A. DA COSTA. ');
end.

OUT PUTNYA TERLIHAT SEPERTI GAMBAR DI BAHWA INI…..