Rabu, 30 November 2011

Program Berantai Dalam Pascal

Program Berantai;
uses crt;
Type
 Ptrdata =^recordData;
 stringNama = STRING[20];
 RecordData = record
               Nama     : StringNama;
               Jabatan  : STRING [15];
               Lanjutan : ptrData ;
               end;
 var
  ptrAwalHeap : pointer;
  ptrKepala : ptrData;

Procedure BentukDaftar (Var ptrkepala : ptrdata);
Var
 Ptrbaru : PtrData;
 Jawaban : char;
begin
repeat
clrscr;
New(ptrbaru);
Write ('Nama pegawai : ');
Readln (ptrbaru^.nama);
Write ('Jabatan      : ');
Readln (ptrbaru^.jabatan);
Ptrbaru^.lanjutan := ptrkepala;
Ptrkepala := ptrbaru;
Write ('Masukan data lagi (Y/T) ? : ');
Repeat
Jawaban := Upcase (readkey)
Until jawaban IN ['Y','T'];
Writeln (jawaban);
Until jawaban ='T';
end;

Procedure CetakDaftar (ptrkepala : ptrdata);
var
Ptrsementara  : ptrdata;
begin
clrscr;
Writeln ('Isi Daftar Berantai : '); Writeln;
Writeln ('............................................................');
Writeln (' N A M A ' : 20,'J A B A T A N ':26);
Writeln ('............................................................');
Ptrsementara := ptrkepala;
While ptrsementara <> NIL Do
With ptrsementara^Do
Begin
Writeln (nama:20,jabatan:26);
Ptrsementara := lanjutan;
End;
Writeln ('............................................................');
Writeln('tekan Return'); Readln;
End;

Procedure Caridata (ptrkepala:ptrdata;namadicari:stringnama;
var ptrpraposisidata,ptrposisidata:ptrdata);

{untuk mencari data nama dicari pada daftar berantai, hasil}
{-jika data ketemu,maka}
{1. ptrposisidata menunjuk simpul dari data yang dicari}
{2. ptrpraposisidata menunjuk simpul sebelum data yang dicari}
{atau sama dengan NIL, jika ptrposisidata menunjuk yang juga ditunjuk}
{oleh ptrkepala}
{- jika tidak ditemukan,maka ptrposisidata sama dengan NIl}
Var
Ketemu : Boolean;
Begin
PtrPraposisidata := NIL;
PtrPosisidata := ptrkepala;
Ketemu := False;
While (Not ketemu And (ptrposisidata <> NIL)) Do
If Ptrposisidata^.nama <> namadicari Then
Begin
Ptrposisidata := ptrposisidata;
Ptrposisidata := ptrposisidata^.lanjutan
end
else
Ketemu := True;
End;


Procedure HapusIsiDaftar (Var ptrkepala:ptrdata);
Const
String_kosong='';
Var
Namadicari : stringnama;
Ptrposisidata,
Ptrpraposisidata : ptrdata;
Begin
Clrscr;
Writeln ('Masukan nama pegawai dari data yang akan dihapus :');
Readln (namadicari);
If namadicari= string_kosong Then
Exit;

Caridata (ptrkepala, namadicari, ptrpraposisidata, ptrposisidata);
If ptrposisidata = NIL Then
Begin
Writeln ('Data tak ditemukan, tekan enter untuk melanjutkan ');
Readln;
End;
Begin
{Proses penghapusan}
If ptrpraposisidata = NIL then
{simpul yang ditunjukan ptrkepala dihapus}
ptrkepala := ptrkepala^.lanjutan
else
{bukan simpul yang ditunjuk ptrkepala dihapus}
Writeln ('Ok........data sudah dihapus. Tekan enter');
end;
end;{akhir procedure hapusisidaftar}


 Procedure prosesPilihan (var ptrKepala : ptrdata);
 var
  Pilihan : char;
 Begin
  Repeat
   Clrscr;
   TEXTATTR := $70;
   Gotoxy (20,2); WRITE ('     pilihan proses   ');
   TEXTATTR := $07;
 Gotoxy (20,4) ; write ('[1]memasukkan /menambah data');
 Gotoxy (20,5) ; write ('[2]menampilkan isi daftar berantai');
 Gotoxy (20,6) ; write ('[3]menghapus data pada daftar berantai');
 Gotoxy (20,7) ; write ('[4]selesai');
 Gotoxy (20,8) ; write ('..............................................');
 Gotoxy (25,9) ; write ('[1]masukkan kode pilihan [1..4] : ');




Repeat
 Pilihan := UPCASE (READKEY)
UNTIL pilihan IN ['1'..'4'];
Write (pilihan);
CASE pilihan OF
 '1' : BentukDaftar (ptrKepala);
 '2' : Cetakdaftar (ptrKepala);
 '3' : HapusIsiDaftar (ptrKepala);
END;
Until pilihan ='4'
end;

{*program utama*}
Begin
 Mark (PtrAwalHeap) ;
 ptrKepala := NIL;
ProsesPilihan (ptrKepala);
RELEASE (ptrAwalHeap) ;
End.

Program Berantai;
uses crt;
Type
 Ptrdata =^recordData;
 stringNama = STRING[20];
 RecordData = record
               Nama     : StringNama;
               Jabatan  : STRING [15];
               Lanjutan : ptrData ;
               end;
 var
  ptrAwalHeap : pointer;
  ptrKepala : ptrData;

Procedure BentukDaftar (Var ptrkepala : ptrdata);
Var
 Ptrbaru : PtrData;
 Jawaban : char;
begin
repeat
clrscr;
New(ptrbaru);
Write ('Nama pegawai : ');
Readln (ptrbaru^.nama);
Write ('Jabatan      : ');
Readln (ptrbaru^.jabatan);
Ptrbaru^.lanjutan := ptrkepala;
Ptrkepala := ptrbaru;
Write ('Masukan data lagi (Y/T) ? : ');
Repeat
Jawaban := Upcase (readkey)
Until jawaban IN ['Y','T'];
Writeln (jawaban);
Until jawaban ='T';
end;

Procedure CetakDaftar (ptrkepala : ptrdata);
var
Ptrsementara  : ptrdata;
begin
clrscr;
Writeln ('Isi Daftar Berantai : '); Writeln;
Writeln ('............................................................');
Writeln (' N A M A ' : 20,'J A B A T A N ':26);
Writeln ('............................................................');
Ptrsementara := ptrkepala;
While ptrsementara <> NIL Do
With ptrsementara^Do
Begin
Writeln (nama:20,jabatan:26);
Ptrsementara := lanjutan;
End;
Writeln ('............................................................');
Writeln('tekan Return'); Readln;
End;

Procedure Caridata (ptrkepala:ptrdata;namadicari:stringnama;
var ptrpraposisidata,ptrposisidata:ptrdata);

{untuk mencari data nama dicari pada daftar berantai, hasil}
{-jika data ketemu,maka}
{1. ptrposisidata menunjuk simpul dari data yang dicari}
{2. ptrpraposisidata menunjuk simpul sebelum data yang dicari}
{atau sama dengan NIL, jika ptrposisidata menunjuk yang juga ditunjuk}
{oleh ptrkepala}
{- jika tidak ditemukan,maka ptrposisidata sama dengan NIl}
Var
Ketemu : Boolean;
Begin
PtrPraposisidata := NIL;
PtrPosisidata := ptrkepala;
Ketemu := False;
While (Not ketemu And (ptrposisidata <> NIL)) Do
If Ptrposisidata^.nama <> namadicari Then
Begin
Ptrposisidata := ptrposisidata;
Ptrposisidata := ptrposisidata^.lanjutan
end
else
Ketemu := True;
End;


Procedure HapusIsiDaftar (Var ptrkepala:ptrdata);
Const
String_kosong='';
Var
Namadicari : stringnama;
Ptrposisidata,
Ptrpraposisidata : ptrdata;
Begin
Clrscr;
Writeln ('Masukan nama pegawai dari data yang akan dihapus :');
Readln (namadicari);
If namadicari= string_kosong Then
Exit;

Caridata (ptrkepala, namadicari, ptrpraposisidata, ptrposisidata);
If ptrposisidata = NIL Then
Begin
Writeln ('Data tak ditemukan, tekan enter untuk melanjutkan ');
Readln;
End;
Begin
{Proses penghapusan}
If ptrpraposisidata = NIL then
{simpul yang ditunjukan ptrkepala dihapus}
ptrkepala := ptrkepala^.lanjutan
else
{bukan simpul yang ditunjuk ptrkepala dihapus}
Writeln ('Ok........data sudah dihapus. Tekan enter');
end;
end;{akhir procedure hapusisidaftar}


 Procedure prosesPilihan (var ptrKepala : ptrdata);
 var
  Pilihan : char;
 Begin
  Repeat
   Clrscr;
   TEXTATTR := $70;
   Gotoxy (20,2); WRITE ('     pilihan proses   ');
   TEXTATTR := $07;
 Gotoxy (20,4) ; write ('[1]memasukkan /menambah data');
 Gotoxy (20,5) ; write ('[2]menampilkan isi daftar berantai');
 Gotoxy (20,6) ; write ('[3]menghapus data pada daftar berantai');
 Gotoxy (20,7) ; write ('[4]selesai');
 Gotoxy (20,8) ; write ('..............................................');
 Gotoxy (25,9) ; write ('[1]masukkan kode pilihan [1..4] : ');




Repeat
 Pilihan := UPCASE (READKEY)
UNTIL pilihan IN ['1'..'4'];
Write (pilihan);
CASE pilihan OF
 '1' : BentukDaftar (ptrKepala);
 '2' : Cetakdaftar (ptrKepala);
 '3' : HapusIsiDaftar (ptrKepala);
END;
Until pilihan ='4'
end;

{*program utama*}
Begin
 Mark (PtrAwalHeap) ;
 ptrKepala := NIL;
ProsesPilihan (ptrKepala);
RELEASE (ptrAwalHeap) ;
End.

Diposting oleh dhety's blog di 20.32

1 komentar:

Unknown mengatakan...

Casino Game For Sale by Hoyle - Filmfile Europe
› casino-games › casino-games 토토 사이트 › casino-games febcasino › casino-games Casino Game for sale by Hoyle 바카라 on Filmfile Europe. Free shipping for most countries, sol.edu.kg no download required. Check the deals microtouch solo titanium we have.

3 April 2022 pukul 15.55

Posting Komentar

Langganan: Posting Komentar (Atom)
Diberdayakan oleh Blogger.