PROGRAM PASCAL MENGGUNAKAN LINKED LIST

uses crt;
  type pointer=^typedata;
  typedata = record
   nilai : integer;
   berikut : pointer;
   end;


  var list :pointer;

  procedure mas_dep(var L : pointer; x : Integer);
  var baru : pointer;

 begin
  new(baru);
  baru^.Nilai:=x;
  baru^.Berikut:= nil;
  if L= nil then L:=baru
  else
  begin
  baru^.berikut :=L;
  L:= baru;
  end;
 end;

 procedure cetak (L:pointer);
 var bantu : pointer;
 begin
  bantu:= L;
  while bantu <> nil do
  begin
  write (bantu^.Nilai:3);
  Bantu:=bantu^.Berikut;
   end;
  end;

  var bil, bil2 : integer;
  JB : char;

  begin
  clrscr;
  new(list);
  list:=nil;
  jb:='Y';
  writeln;
  writeln (' ===Program Linked List===');
  writeln;
  writeln ('  Masuk depan');
  while upcase(Jb)='Y' do
  begin
  writeln;
   write ('Masukkan bilangan : '); readln(bil);
   mas_dep(list,bil);
   write ('Lagi [Y/T]  : '); readln(Jb);
   end;
   cetak(list);
   writeln;
   readln;
   end.

Program Pointer Menggunakan Bahasa Pascal

Source Code

uses crt;

type pointer=^string;

var

a,b, c, d : pointer;

       nilai : String;

begin

clrscr;

nilai := 'ini adalah string nilai';

a := @nilai;

New(b);

New(d);

b^ := 'ini isi pointer b';

c := b; {c menunjuk ke yang ditunjuk b}

d^ := b^;

writeln('alamat pointer a = ', seg(a^):4,' : ', ofs(a^):4, ' isi pointer a = ', a^);

writeln('alamat pointer b = ', seg(b^):4,' : ', ofs(b^):4, ' isi pointer b = ', b^);

writeln('alamat pointer c = ', seg(c^):4,' : ', ofs(c^):4, ' isi pointer c = ', c^);

writeln('alamat pointer d = ', seg(d^):4,' : ', ofs(d^):4, ' isi pointer d = ', d^);

readln;

end.

PROGRAM SEARCHING PADA PASCAL

 Source Code

program searching;

uses crt;

label awal;

var pil:char;

    lg :char;

const nmin = 1;

      nmax = 100;

type  arrint = array [nmin..nmax] of integer;

var tabint : arrint;

    x,n,i,indeks,max,min,maks : integer;

function seqsearch1(xx : integer): integer;

  var i : integer;

  begin

    i := 1;

    while ((i<n) and (tabint[i] <> xx)) do

      i:=i+1;

      if tabint[i] = xx then

        seqsearch1:=i

        else

        seqsearch1:=0;

  end;

function maksimum (tabint: arrint; n : integer) : integer;

  var i, max : integer;

  begin

   for i:=2 to n do

   if max<tabint[i] then

   max:=tabint[i];

   maksimum:=max;

  end;

function minimum (tabint: arrint; n : integer) : integer;

  var i, min : integer;

  begin

   for i:=1 to n do

   if min>tabint[i] then

   min:=tabint[i];

   minimum:=min;

  end;

begin

  clrscr;

  writeln;

  write('Masukkan Jumlah Data = '); readln(n);

  writeln;

  Clrscr;

  for i:=1 to n do

    begin

       write('   Data[',i,'] = '); readln(tabint[i]);

     end;

    writeln;

        write ('  Nilai yang dicari : '); readln(x);

    indeks:=seqsearch1(x);

      if indeks <> 0 then

      write ('  Nilai : ',x,' ditemukan pada indeks ke-',indeks)

       else

      write('   Nilai : ',x,'tidak ditemukan !');

      writeln;

    begin

    writeln;

    maks:=maksimum(tabint,n);

    min:=minimum(tabint,n);

    writeln;

    writeln ('  Nilai maksimum : ',maks);

    writeln ('  Nilai minimum  : ',min );

    readkey;

    end;

         end.

PROGRAM SORTING DENGAN MENGGUNAKAN BAHASA PASCAL (Descending)

Source Code

uses crt;

type data= record

nama, nim: string;

ipk : real;

end;

var

mhs : array [1..10] of data;

i, j, n, temp : integer;

pilih : char;

procedure input;

begin

clrscr;

write('Masukkan Jumlah Mahasiswa : '); readln(n);

for i := 1 to n do

begin

clrscr;

writeln('Masukkan Data ke- ', i);

writeln('=====================');

write ('Nama  : '); readln(mhs[i].nama);

write ('NIM   : '); readln(mhs[i].nim);

write ('IPK   : '); readln(mhs[i].ipk);

end;

end;

procedure hasil;

begin

clrscr;

writeln('=========');

writeln('= HASIL =');

writeln('=========');

for i:=1 to n do

begin

writeln;

writeln('Hasil Data Ke-',i);

writeln('NIM  : ',mhs[i].nim);

writeln('NAMA : ',mhs[i].nama);

writeln('IPK  : ',mhs[i].ipk:2:2);

end;

readkey;

end;

procedure seleksi;

var max: integer;

temp: data;

begin

for i:=1 to n-1 do

begin

max:=i;

for j:= i+1 to n do

if mhs[j].ipk> mhs[max].ipk then

max:=j;

temp:= mhs[max];

mhs[max]:= mhs[i];

mhs[i]:= temp;

end;

hasil;

end;

begin

input;

seleksi;

end.