CIRCULAR LINK LIST insert Before dalam Pascal

Insert before

program P_circular;

{$APPTYPE CONSOLE}

uses

  SysUtils;

type

  point  = ^recpoint ;

  recpoint = record

              id_mhs : string ;

              nama : string ;

              alamat : string ;

              semester : integer ;

              next,prev : point ;

             end;

var

  head,now,tail : point ;

  jawab : char ;

procedure insertBefore ;

begin

  new(now) ;

  if head = nil  then

    begin

      head := now ;

      tail := now ;

    end

  else

    begin

      now^.prev := head ;

      head^.next := now ;

    end;

  now^.next :=tail ;

  tail^.prev := now ;

  tail := now ;

end;

begin

  writeln ('INPUT DATA');

  writeln ('____________________');

  writeln ;

  repeat

    insertBefore ;

    write('masukan id :') ;readln(now^.id_mhs);

    write('masukan nama :') ;readln(now^.nama);

    write('masukan alamat :') ;readln(now^.alamat);

    write('masukan semester :') ;readln(now^.semester);

    writeln;

    write('Apakah ingin input data lagi (Y/T)? :');readln(jawab);

    writeln ;

  until upcase(jawab) = 'T' ;

  writeln('OUTPUT DATA');

  writeln('-------------------');

  now := head ;    // output

  repeat

   writeln('ID       :', now^.id_mhs);

    writeln('nama     :', now^.nama);

    writeln('alamat   :', now^.alamat);

    writeln('semester :', now^.semester);

    writeln ;

    now := now^.next ;

  until (now^.next = head^.next) ;

readln ;

end.

CIRCULAR LINK LIST insert after dalam Pascal

CIRCULAR LINK LIST

Adalah double linked list yang simpul terakhirnya menuju simpul awal dan simpul awal menuju simpul setelahnya sehingga membentul sebuah simpul lingakaran.

Insert after

program P_circular;

{$APPTYPE CONSOLE}

uses

  SysUtils;

type

  point  = ^recpoint ;

  recpoint = record

              id_mhs : string ;

              nama : string ;

              alamat : string ;

              semester : integer ;

              next,prev : point ;

             end;

var

  head,now,tail : point ;

  jawab : char ;

procedure insertAfter ;

begin

  new(now) ;

  if head = nil then

    head := now

  else

    begin

      now^.prev := tail ;

      tail^.next := now ;

    end;

 tail := now ;

 tail^.next := head ;

 head^.prev := tail ;

end;

begin

  writeln ('INPUT DATA');

  writeln ('____________________');

  writeln ;

  repeat

    insertAfter ;

    write('masukan id :') ;readln(now^.id_mhs);

    write('masukan nama :') ;readln(now^.nama);

    write('masukan alamat :') ;readln(now^.alamat);

    write('masukan semester :') ;readln(now^.semester);

    writeln;

    write('Apakah ingin input data lagi (Y/T)? :');readln(jawab);

    writeln ;

  until upcase(jawab) = 'T' ;

  writeln('OUTPUT DATA');

  writeln('-------------------');

  now := head ;    // output

  repeat

   writeln('ID       :', now^.id_mhs);

    writeln('nama     :', now^.nama);

    writeln('alamat   :', now^.alamat);

    writeln('semester :', now^.semester);

    writeln ;

    now := now^.next ;

  until (now^.next = head^.next) ;

readln ;

end.

Delete Before simpul pointer dalam pascal

 Delete Before

Yaitu menghapus data di sebelah kanan dari simpul

program dlete;

{$APPTYPE CONSOLE}

uses

  SysUtils;

type

   point = ^recKar ;

   reckar = record

              id_mhs : string ;

              nama : string ;

              prodi : string ;

              semester : integer ;

              next,prev : point;

            end;

var

  head,now,tail : point ;

  jawab : char ;

  no : byte ;

procedure insertAfter ;      // insert After

begin

  new(now) ;

  if head =nil then

     begin

       head := now ;

       tail := now ;

       head^.prev := nil ;

       tail^.prev := nil ;

     end

  else

    begin

      tail^.next := now ;

      now^.prev := tail ;

      tail := now ;

      tail^.next := nil ;

    end;

end;

procedure deleteBefore ;

begin

  now := head ;

  if now <> tail then

    begin

      head := now^.next ;

      head^.prev := nil ;

    end

  else

    begin

      tail := nil ;

      head := nil ;

    end;

    if now <> nil then Dispose(now) ;

end;

begin

  writeln('DATA MAHASISWA');

  writeln('__________________________');

  writeln ;

  repeat

     insertAfter ;

      write('ID MAHASISWA :'); readln(now^.id_mhs);

      write('NAMA         :'); readln(now^.nama);

      write('PRODI        :'); readln(now^.prodi);

      write('SEMESTER     :'); readln(now^.semester);

      writeln ;

      write('Apakah ingin isi data lagi (Y/T)?  ');readln(jawab);

      writeln ;

  until upcase(jawab) ='T' ;

  writeln ;

  writeln('DATA MAHASISWA');

  writeln('__________________________');

  writeln ;

  no := 1 ;

  now := head ;

  while now <> nil do

    begin

      writeln (No,'. ID MAHASISWA :',Now^.id_mhs) ;

      writeln ('   NAMA           :',Now^.nama) ;

      writeln ('   PRODI          :',Now^.prodi) ;

      writeln ('   SEMESTER       :',Now^.semester) ;

      writeln ;

      inc(no) ;      

   now := now^.next ;  

    end;

  write('Apakah anda ingin menghapus Data (Y/T)? : ');Readln(jawab);

  if UpCase(jawab)='Y' then deleteBefore ;

  writeln ;

  writeln('DATA MAHASISWA');

  writeln('__________________________');

  writeln ;

  no := 1 ;

  now := head ;

  while now <> nil do

    begin

      writeln (No,'. ID MAHASISWA :',Now^.id_mhs) ;

      writeln ('   NAMA :',Now^.nama) ;

      writeln ('   PRODI :',Now^.prodi) ;

      writeln ('   SEMESTER :',Now^.semester) ;

      writeln ;

      inc(no) ;   

      now := now^.next ;  

    end;

  readln ;

end.