File

Uses Crt;

Var
    tes : Text;
    nama,nim : String;
    no,shift,pilih,i : byte;
    Tanya : Char;

Begin
Repeat
ClrScr;
        Writeln(' Program File Text Sederhana');
        Writeln(' ------------------------------');
        Writeln(' 1. Masukan Data Anda');
        Writeln(' 2. Lihat Data');
        Writeln(' 3. Hapus Data');
        Writeln(' 4. Keluar');
        Writeln(' ------------------------------');
        Write(' Pilihan Anda : ');Readln(Pilih);
        Case Pilih Of
        1 : Begin clrscr;
                Assign(tes,'praktikum.txt');
                rewrite(tes);
                Repeat
                inc(i);
                writeln(' Data - ',i);
                writeln(' -------------------------------------');
                write(' Nama     : '); readln(nama); writeln(tes,nama);
                write(' NIM      : '); readln(nim);  writeln(tes,nim);
                write(' Shift    : '); readln(shift);writeln(tes,shift);
                write(' No. Meja : '); readln(no);   writeln(tes,no);
                writeln(tes,' ');
                Write(' Memasukan Lagi (Y/T) : '); readln(tanya);
                writeln(' -------------------------------------');
                writeln;

                Until UpCase(tanya) = 'T';
                Close(tes);
             End;

        2 : Begin clrscr;
                Assign(tes,'praktikum.txt');
                reset(tes);
                i:= 0;
                   while not eof(tes) do
                   begin
                   inc(i);
                        readln(tes,nama);  readln(tes,nim);
                        readln(tes,shift); readln(tes,no);
                        readln(tes);
                        writeln(' Data - ',i);
                        writeln(' -------------------------------------');
                        writeln(' Nama     : ',nama);
                        writeln(' NIM      : ',nim);
                        writeln(' Shift    : ',shift);
                        writeln(' No. Meja : ',no);
                        writeln(' -------------------------------------');
                        writeln;
                   end; readln;
             End;

        3 : Begin clrscr;
                write(' Data akan dihapus [y/t] : '); readln(tanya);
                if upcase (tanya) = 'Y' then
                Assign(tes,'praktikum.txt');
                erase(tes);
            End;

       else End;
until pilih=4;
End.

Linked List

program linked_list;

uses crt;
type ptrdata = ^recorddata;
     recorddata = record
        item : string;
        berikut : ptrdata
     end;

var pd : ptrdata;
    elem : string;


procedure node_baru(var baru: ptrdata; elemen: string);
var ps: ptrdata;
begin
new(ps);
new(baru);
         baru^.item := elemen;
         baru^.berikut := nil;

end;


Procedure tambah_depan(Var depan : ptrData; elemen : string);
Var  ps :ptrdata;
Begin
new(ps);
new(depan);
                node_baru(ps,elemen);
        ps^.berikut  :=  pd;
        pd:=ps ;
End;


begin
clrscr;
 new(pd);
 elem := 'Nama          : Katon Galih Wicaksono';
        tambah_depan(pd, elem);
        writeln(pd^.item);

 elem := 'NIM           : J1F114028';
        tambah_depan(pd, elem);
        writeln(pd^.item);
        writeln;

 elem := 'Nama          : Ketut Mega Fortuna';
        tambah_depan(pd, elem);
        writeln(pd^.item);

  elem := 'NIM           : J1F114029';
        tambah_depan(pd, elem);
        writeln(pd^.item);

readln;
end.


Berikut Outputnya :

Pointer

uses crt;
var
judul,pengarang, tglpj, tglkem:^string;

begin
clrscr;
new(judul);
Judul^:='Judul Buku : Perahu kertas';
new(Pengarang);
Pengarang^:='Pengarang Buku : Dewi Lestari';
tglpj:='Tanggal pinjam: 10';
tglkem:='Tanggal kembali 20';



writeln(Judul^);
writeln(Pengarang^);
writeln(tglpj);
writeln(tglkem);

Judul := pengarang; writeln(Judul^);
Judul^:='Judul Buku : Perahu Kertas';
writeln(Judul^);
Pengarang^:='Pengarang Buku : Dewi Lestari';
writeln(Pengarang^);


readln;
end.


Berikut Hasil Outputnya :

Program gabungan Sorting dan Searching

uses crt;
const
  nmin = 1;
  nmax = 100;
type
penunjukbrg = ^catatanbrg;
catatanbrg = record
kode :integer;
nama : string[25];
harga :real;
end;
var
databrg : array [nmin..nmax] of penunjukbrg;
i, j : byte;
temp : catatanbrg;
a: integer;
 indeks : integer;
  function seqsearch1(xx : integer): integer;
begin
clrscr;
write('masukkan data barang:'); readln(a);
for i := 1 to a do
begin
writeln;
writeln('Barang ke ', i:2, ' :');
new(databrg[i]);
with databrg[i]^ do
begin
write('Kode Barang  : ');readln(kode);
write('Nama Barang  : ');readln(nama);
write('Harga Barang : Rp.');readln(harga);
end;
end;
writeln('Data Barang Belanjaan :');
writeln('-----------------------');
writeln;
writeln('Kode Barang    Nama Barang     Harga Barang ');
writeln;
for i := 1 to a do
with databrg[i]^ do
writeln(kode:5, Nama:15, Harga:20:2);
writeln; writeln;
writeln('Data Berdasarkan Abjad Barang :');
writeln;
writeln('Kode barang    Nama Barang     Harga Barang ');
begin
for i := 1 to a do
for j := 1 to a do
with databrg[i]^ do
if databrg[i]^.nama < databrg[j]^.nama then
Begin
temp := databrg[i]^;
databrg[i]^ := databrg[j]^;
databrg[j]^ := temp;
end;
for i := 1 to a do
with databrg[i]^ do
writeln(kode:5, Nama:15, Harga:20:2);
 writeln;
 end;
 end;
 begin
 with databrg[i]^ do
begin
  clrscr;
  write('Nilai yang dicari = '); readln(kode);
  writeln;
  indeks:=seqsearch1(kode);
  if indeks <> 0 then
    write(kode,' ditemukan pada indeks ke-',indeks)
    else
    write(kode,' tidak ditemukan');
  writeln;
writeln;
end;
readkey;
end.

Berikut Output akhirnya :

Sorting Pada Pemrograman Pascal

uses crt ;

var

    nama    : array[1..3] of string ;

    xnama   : string ;

    jmldata : byte ;

    i, j    : byte ;

begin

     jmldata := 3 ;

     for i := 1 to jmldata do

     begin

       write('Nama ke ',i,':') ; readln(nama[i]) ;

     end;

     clrscr;

     for i := 1 to jmldata do

     begin

          writeln ('Nama ke ',i,':', nama[i]) ;

     end;

     for i:= 1 to jmldata-1 do

     begin

          for j:= jmldata-1 downto i do

          begin

              if nama[j] > nama[j+1] then

              begin

                   xnama     := nama[j] ;

                   nama[j]   := nama[j+1] ;

                   nama[j+1] := xnama   ;

              end;

          end;

     end;

     writeln;

     for i := 1 to 3 do

     begin

          writeln ('Nama ke ',i,':', nama[i]) ;

     end;

     readln;

end.





Dan berikut output akhirnya :

Program Deret Fibonacci pada Pascal

uses crt;

var

a,i: longint;

function fibonacci(n:integer):integer;

begin

if(n=1) then

fibonacci:=1

else

if (n=2) then

fibonacci:=1

else

fibonacci:= fibonacci(n-1)+fibonacci(n-2);

end;

begin

clrscr;

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

writeln('|    DERET FIBONACCI  |');

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

writeln('|  input value :      |');

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

gotoxy(17,4);readln(a);

writeln;

for i := 1 to a do

write(fibonacci(i),'  ');

readln;

end.

Inilah Output Program Deret Fibonacci:

TUGAS PRAKTIKUM

ALGORITMA DAN PEMROGRAMAN II

"ARRAY OF RECORD"

Nama     : Katon Galih Wicaksono

  NIM    : J1F114028

KEMENTERIAN RISET TEKNOLOGI  DAN PENDIDIKAN TINGGI

UNIVERSITAS LAMBUNG MANGKURAT

FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM

PROGRAM STUDI S1 ILMU KOMPUTER

BANJARBARU

2015