Program 11 Pointer

{ tutorial pascal / turbo pascal  }
{ 3th my tutorial for my friend   }
{ writen by : m3n_tu4r1           } padang, 24 mei 2003
-------------------------------------------------------

Sebenarnya pada tutorial kedua mengenai FUNCTION dan PROCEDURE sample programnya telah mengunakan pemakain pointer, tinggal menambah sedikit perintah penghapusan sesudah proses penampilan data. Tapi uda cibo agiah N1A program menyusun daftar berantai dengan pointer, untuang-untuang cocok jo tugas yang disuruah dosen N1A.

Mata kuliah yang berhubungan dengan penyusunan data berantai adalah SISTEM BASIS DATA (4 sks lo).

{ tutorial pascal / turbo pascal  }
{ 3th my tutorial for my friend   }
{ writen by : m3n_tu4r1           } 
{ padang, 24 mei 2003             }

PROGRAM POINTER;
USES CRT;
TYPE 
       Stringdata  = STRING[20];
       Ptrdata       =^RECORDDATA;
       Recorddata = RECORD;
                Nama      : STRINGNAMA;
                Jabatan   : STRING [25];
                Ptrkepala : PTRDATA;
        END;
VAR
       Ptrawal_heap : ptrdata;
       Ptrkepala       : ptrdata; 

PROCEDURE BENTUK_DAFTAR (VAR ptrkepala : ptrdata);
{ menyusun daftar berantai dengan variabel PTRKEPALA menunjuk data -}
{ terakhir yang dimasukan melalui keyboard                                          }
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 CETAK_DAFTAR ( ptrkepala:ptrdata);
{ mencetak isi daftar berantai }
VAR
      Ptrsementara:ptrdata;
BEGIN
      CLRSCR;
      WRITELN (‘ ISI DAFTAR BERANTAI : ‘);WRITELN;
      WRITELN (‘-----------------------------------------------------------------------------‘);
      WRITELN (‘ N A M A ’:20,’J A B A T A N’:16);
      WRITELN (‘-----------------------------------------------------------------------------‘);
      Ptrsementara :=ptrkepala;  
      {ptrsementara menunjuk pada lokasi yg sama dng ptrkepala}
      WHILE ptrsementara <> NIL Do
      WITH ptrsementara^DO
          BEGIN 
                 WRITELN (nama:20,jabatan:16);
                 Ptrsementara := lanjutan;
          END;  
      WRITELN (‘-----------------------------------------------------------------------------‘);
      WRITE (‘ tekan Return ‘); READLN;
END; 

PROCEDURE CARI DATA (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 simpul data yang dicari    }
{         atau sama dengan NIL, jika ptrposisidata menunjuk yang juga ditun- }
{	 juk oleh ptrkepala						     }
{- jika tidak diketemukan, 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);
{untuk menghapus sebuah simpul data daftar berantai}
CONST
     String_kosong=’ ‘;
VAR
     Namadicari : stringnama;
     Prtposisidata,
     Ptrpraposisidata : ptrdata;
BEGIN
     CLRSCR;
     WRITELN (‘Masukan nama pegawai dari data yang akan dihapus:’);
     READLN (namadicari);
     IF namadicari = string_kosong THEN
         EXIT;
     Cari_data (ptrkepala, namadicari, ptrpraposisidata, ptrposisidata);
     IF ptrposisidata = NIL THEN 
         BEGIN
            WRITELN (‘ data tak diketemukan, 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);
{ digunakan untuk memilih proses ; memasukan data, menampilkan data }
{ menghapus data							 }
VAR
     Pilihan : CHAR;
BEGIN
     REPEAT
            CLRSCR;
            TEXTATTR :=$70; { video terbalik }
 	   GOTOXY(20,2); WRITE (‘                   PILIHAN PROSES                 ‘);
	   TEXTATTR :=$70; { video normal kembali } 
             GOTOXY(20,4); WRITE (‘ [1] Memasukan / 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(20,9); WRITE (‘ Masukan kode pilihan [1…4]’);
             REPEAT
		Pilihan := UPCASE (READKEY)
             UNTIL pilihan IN [‘1’..’4’];
             WRITE (pilihan);
             CASE pilihan OF
                ‘1’ : bentuk_daftar(ptrkepala);
                ‘2’ : catak_daftar(ptrkepala);
                ‘3’ : hapusisidata(ptrkepala);
             END;
     UNTIL pilihan = ‘4’
END;

BEGIN
     MARK(ptrawal_heap);     {penandaan terhadap awalheap}
     Ptrkepala :=NIL ;           {keadaan awal ptr kepala          }
     Prosespilihan(ptrkepala); {pelaksanaan pemilihan proses }
     RELEASE(ptrawal_heap); {membebaskan heap yg digunakan u/ alokasi dynamic  }
END.

------------------------------------------------------------------------------------------------

padang , 12.21 wibb.

Ditemani tembang Avril lavigne (biar suasana tambah panas)

Regards,

m3n_tu4r1