PASCAL - CONTOH PROGRAM SUSUN BILANGAN MENGGUNAKAN POINTER

Listing Program :

program susunangka;
uses crt;
type pointer = ^simpul;
     simpul = record
            data : byte;
            next : pointer;
     end;

var  awal,baru,bantu,hapus : pointer;
     angka,x : byte; mau : char;
procedure cetak;
begin
     new(bantu);
     bantu := awal;
     while bantu^.next <> nil do
     begin
          write(bantu^.data,' ');
          bantu := bantu^.next;
     end;
     write(bantu^.data);
end;

begin
     x := 1;
     repeat
           clrscr;
           new(awal);
           awal := nil;
           write('[0 untuk berhenti] Masukkan angka ke ',x,' : ');readln(angka);
           inc(x);
     until angka <> 0;
     repeat
        new(baru);
        baru^.data := angka;
        baru^.next := nil;
        if awal = nil then
           awal := baru
        else
        if baru^.data < awal^.data then
        begin
           baru^.next := awal;
           awal := baru;
        end
        else
        begin
             new(bantu);
             bantu := awal;
             while (bantu^.next <> nil) and (bantu^.next^.data < baru^.data) do
                  bantu := bantu^.next;
             baru^.next := bantu^.next;
             bantu^.next := baru;
        end;
        write('[0 untuk berhenti] Masukkan angka ke ',x,' : ');readln(angka);
        inc(x);
     until angka = 0;
     write('Setelah data diurutkan = ');
     cetak;
     writeln;
     repeat
       write('apakah anda ingin menghapus data angka genap ?[y/t] : ');readln(mau);
     until (mau = 'y') or (mau = 't');
     if mau = 'y' then
     begin
          while (awal^.data mod 2 = 0) and (awal^.next <> nil) do
          begin
               new(hapus);
               hapus := awal;
               awal := hapus^.next;
               dispose(hapus);
          end;
          if (awal^.next = nil) and (awal^.data mod 2 = 0) then
             awal := nil;
          if awal <> nil then
          begin
               new(bantu);
               bantu := awal;
               while bantu^.next <> nil do
               begin
                    if bantu^.next^.data mod 2 = 0 then
                    begin
                         new(hapus);
                         hapus := bantu^.next;
                         bantu^.next := hapus^.next;
                         dispose(hapus);
                    end
                    else
                        bantu := bantu^.next;
               end;
          end;
     end;
     if mau = 't' then
          write('Data masih tetap sama')
     else if awal <> nil then
     begin
          write('Data setelah semua angka genap dihapus = ');
          cetak;
     end
     else
         write('Data angka ganjil tidak ada');
     readln;
end.

Jangan lupa tinggalkan pesan berupa saran dan kritik yang bermanfaat untuk blog  ini. Untuk teman-teman yang hendak mencopy artikel ini untuk dipasang pada blog atau web-nya, dengan sangat diharapkan untuk mencantumkan Link keblog ini sebagai sumber artikel sekaligus sebagai backlink untuk blog ini. Terima kasih untuk pengertian dan kerjasamanya, mari berkembang bersama.