Jumat, Desember 13, 2013

program pascal linklist

Diposting oleh ajeng diana di 07.35
program linklist;
uses crt;
type
    pointer=^TypeData;
    TypeData=record
        nama:string;
        Berikutnya:pointer;
    end;
var
    list,akhir:pointer;
   
procedure masuk_depan(Var L : Pointer;X:string);
var
    baru:pointer;
begin
    new(baru);
    baru^.nama:=X;
    baru^.berikutnya:=nil;
    if L = nil then
    begin
        L:=baru;akhir:=baru;
    end
    else
    begin
        baru^.berikutnya:=L;
        L:=baru;
    end;
end;

procedure sisip_tengah(var L : pointer;X,Y:string);
var
    baru,bantu:pointer;
begin
    bantu:=L;
    while bantu^.berikutnya<> nil do
    begin
        if bantu^.nama=y then
        begin
            new(baru);
            baru^.nama:=x;
            baru^.berikutnya:=bantu^.berikutnya;
            bantu^.berikutnya:=baru;
        end;
        bantu:=bantu^.berikutnya;
    end;
end;

procedure masuk_belakang(var L:pointer;x:string);
var
    baru,bantu:pointer;
begin
    new(baru);
    baru^.nama:=X;
    baru^.berikutnya:=nil;
    bantu:=L;
    while bantu^.berikutnya <> nil do
        bantu:=bantu^.berikutnya;
    bantu^.berikutnya:=baru;
    { akhir^.next:=baru;
    akhir:=baru;akhir^.next:=nil;}
end;

procedure hapus_depan(var L:pointer);
var
    bantu:pointer;
begin
    bantu:=L;
    if L=Nil then writeln('List kososng..!')
    else
        begin
            L:=L^.berikutnya;
            dispose(bantu);
        end;
end;

procedure hapus_tengah(var L:pointer;X:string);
var
    bantu,hapus:pointer;
begin
    if L = nil then writeln('List Kosong')
    else
        begin
            bantu:=L;
            new(hapus);
            while bantu^.berikutnya <> nil do
            begin
                if bantu^.berikutnya^.nama=X then
                begin   
                    hapus:=bantu^.berikutnya;
                    bantu^.berikutnya:=hapus^.berikutnya;
                    dispose(hapus);
                end
                else
                    bantu:=bantu^.berikutnya;
            end;
        end;
end;

procedure hapus_belakang(var L:pointer);
var
    baru,bantu:pointer;
begin
    bantu:=L;
    if bantu = nil then writeln('List Kososng')
    else
        begin
            while bantu^.berikutnya^.berikutnya <> nil do
                bantu:=bantu^.berikutnya;
            new(baru);
            baru:=bantu^.berikutnya;
            bantu^.berikutnya:=nil;
            dispose(baru);
        end;
end;

procedure cetak(L:pointer);
var
    bantu:pointer;
begin
    bantu:=L;
    while bantu <> nil do
    begin
        write(bantu^.nama,' ');
        bantu:=bantu^.berikutnya;
    end;
end;

var namabaru,namasisip,namahapus:string;
    pil,n:integer;
    lagi:boolean;
begin
    lagi:=true;
    new(list);
    list:=nil;
    while lagi do
    begin
        clrscr;
        writeln('1. Tambah Depan');
        writeln('2. Tambah Belakang');
        writeln('3. Sisip Nama');
        writeln('4. Cetak List');
        writeln('5. Hapus Depan');
        writeln('6. Hapus Tengah');
        writeln('7. Hapus Belakang');
        writeln('8. Selesai');
        write('pilihan anda -> (1-8) ');readln(pil);
        case pil of
            1:
            begin
                writeln('MASUK DEPAN');
                write('Masukkan nama baru : ');readln(namabaru);
                masuk_depan(list,namabaru);
            end;
           
            2:
            begin   
                writeln('MASUK BELAKANG');
                write('Masukkan namabaru : ');readln(namabaru);
                masuk_belakang(list,namabaru);
            end;
           
            3:
            begin
                writeln('SISIP NAMA');
                write('masukkan nama yang akan disisipi : ');readln(namabaru);
                write('Disisipi Setelah nama : ');readln(namasisip);
                sisip_tengah(list,namabaru,namasisip);
            end;
           
            4:cetak(list);
           
            5:
            begin
                writeln('HAPUS DEPAN');
                hapus_depan(list);
                cetak(list);
                writeln;
            end;
           
            6:
            begin
                writeln('HAPUS TENGAH');
                write('masukkan nama yang akan dihapus : ');readln(namahapus);
                hapus_tengah(list,namahapus);
                cetak(list);
            end;
           
            7:
            begin
                writeln('HAPUS BELAKANG');
                hapus_belakang(list);
                cetak(list);
                writeln;
            end;
           
            8:
            begin
                writeln('Terima kasih sudah mencoba program ini');
                lagi:=false;
            end;
        end;
        readln;
    end;
end.

0 komentar:

Posting Komentar

 

ajeng diana Copyright © 2015 Design by ajengdiana dianastore