Neposlusni program

Code:

Program Tel_imenik;
Uses Crt;
Type osoba=record
     ime:string[10];
     prezime:string[15];
     fiksni:string[15];
     mob:string[15];
     adresa:string[30];
     broj:integer;
     end;

Var br:integer;
    mem:array [1..100] of osoba;
    o:char;
    prikaz:boolean;


procedure unos;
var o:char;
begin
window (20,5,50,15);
textbackground (1);
Repeat
clrscr;
with mem[br] do
     begin
     broj:=br;
     writeln ('UNOS BROJ ',br);
     writeln;
     write ('IME: ');
     readln (ime);
     write ('PREZIME: ');
     readln (prezime);
     write ('BROJ FIKSNOG TEL: ');
     readln (fiksni);
     write ('BROJ MOBILNOG TEL: ');
     readln (mob);
     write ('ADRESA: ');
     readln (adresa);
     end;
writeln;
writeln ('Novi unos D/N?');
o:=readkey;
inc(br,1);
Until (o='n') or (o='N');
end;

procedure ispis (var n:integer);
var i:integer;
    o:char;
    b:boolean;
begin
if n>br then n:=1;
window (20,5,50,20);
textbackground (1);
Repeat
clrscr;
if br=1 then b:=false else b:=true;
if b then
   begin
   with mem[n] do
        begin
        writeln ('UNOS BROJ ',n);
        writeln;
        writeln ('IME: ',ime);
        writeln ('PREZIME: ',prezime);
        writeln ('BROJ FIKSNOG TEL: ',fiksni);
        writeln ('BROJ MOBILNOG TEL: ',mob);
        writeln ('ADRESA: ',adresa);
        writeln;
        writeln ('NASTAVI ISPIS D/N?;');
        o:=readkey;
        inc(n,1);
        if n>br then n:=1;
   end;
end
else
   begin
   writeln ('MEMORIJA PRAZNA!');
   o:='n';
   readln;
   end;
until (o='n') or (o='N');
end;

procedure pretrazi;
var o,i:integer;
    podatak:string;
    odg:char;
begin
window (20,5,50,15);
textbackground (red);
clrscr;
writeln ('PRETRAZI PO:');
writeln ('1) IMENU');
writeln ('2) PREZIMENU');
writeln ('3) ADRESI');
writeln ('4) BROJU FIKSNOG TEL.');
writeln ('5) BROJU MOBILNOG TEL.');
writeln ('6) BROJU UNOSA');
writeln;
write ('>');
readln (o);
clrscr;
case o of
1: begin
   writeln ('UNESI IME: ');
   readln (podatak);
   for i:=1 to br do
   if mem[i].ime=podatak then
   ispis(mem[i].broj);
   end;
2: begin
   writeln ('UNESI PREZIME: ');
   readln (podatak);
   for i:=1 to br do
   if mem[i].prezime=podatak then
   ispis(mem[i].broj);
   end;
3: begin
   writeln ('UNESI ADRESU: ');
   readln (podatak);
   for i:=1 to br do
   if mem[i].adresa=podatak then
   ispis(mem[i].broj);
   end;
4: begin
   writeln ('UNESI BR. FIKSNOG TELEFONA: ');
   readln (podatak);
   for i:=1 to br do
   if mem[i].fiksni=podatak then
   ispis(mem[i].broj);
   end;
5: begin
   writeln ('UNESI BR. MOB. TELEFONA: ');
   readln (podatak);
   for i:=1 to br do
   if mem[i].mob=podatak then
   ispis(mem[i].broj);
   end;
6: begin
   writeln ('REDNI BROJ UNOSA: ');
   readln (i);
   ispis(i);
   end;
end;
clrscr;
prikaz:=false;
write ('NOVA PRETRAGA D/N?');
odg:=readkey;
if (odg='d') or (odg='D') then pretrazi;
end;

procedure upozorenje;
begin
window (20,5,43,11);
textbackground (red);
clrscr;
writeln ('         PAZNJA!');
writeln ('Unosenje novih podataka');
writeln ('ce izbrisati stare pod.');
writeln ('sa odgovarajuce lokacije');
writeln;
writeln ('       NASTAVI D/N?');
end;

procedure izmjeni;
var o:char;
    n:integer;
begin
upozorenje;
o:=readkey;
if (o='d') or (o='D') then
   begin
   window (20,5,50,20);
   textbackground (1);
   clrscr;
   write ('IMJENI LOKACIJU: ');
   readln (n);
   with mem[n] do
     begin
     broj:=n;
     writeln ('UNOS BROJ ',n);
     write ('IME: ');
     readln (ime);
     write ('PREZIME: ');
     readln (prezime);
     write ('BROJ FIKSNOG TEL: ');
     readln (fiksni);
     write ('BROJ MOBILNOG TEL: ');
     readln (mob);
     write ('ADRESA: ');
     readln (adresa);
     end;
   readln;
   end;
end;

procedure sacuvaj;
var buffer:text;
    ime:string;
    o,i:integer;
    odg:char;
begin
upozorenje;
odg:=readkey;
if (odg='d') or (odg='D') then
begin
window (20,5,52,11);
textbackground (3);
clrscr;
writeln ('1) SNIMI NA DEFAULT LOKACIJU');
writeln ('2) SNIMI NA PROIZVOLJNU LOKACIJU');
writeln;
write ('>'); readln (o);
clrscr;
if o=2 then
   begin
   writeln ('UNESI ADRESU DATOTEKE ');
   write ('>'); readln (ime);
   end
else
   begin
   writeln ('UNESI IME DATOTEKE');
   readln (ime);
   ime:='C:/'+ime;
   end;
assign (buffer,ime);
rewrite (buffer);
clrscr;
writeln ('DATOTEKA ',ime,' JE OTVORENA.');
delay (1000);
writeln (buffer,br-1);
writeln (buffer);
for i:=1 to br do
    with mem[i] do
       begin
       writeln (buffer,ime);
       writeln (buffer,prezime);
       writeln (buffer,fiksni);
       writeln (buffer,mob);
       writeln (buffer,adresa);
       writeln (buffer);
       end;
close (buffer);
writeln;
writeln ('       ----------------');
writeln ('       PODACI SNIMLJENI');
writeln ('       ----------------');
readln;
end;
end;

procedure ucitaj;
var buffer:text;
    ime:string;
    o,i,a:integer;
begin
window (20,5,60,10);
clrscr;
writeln ('1) UCITAJ SA DEFAULT LOKACIJE');
writeln ('2) UCITAJ SA PROIZVOLJNE LOKACIJE');
writeln;
write ('>'); readln (o);
clrscr;
if o=2 then
   begin
   writeln ('UNESI ADRESU DATOTEKE ');
   write ('>'); readln (ime);
   end
else
   begin
   writeln ('UNESI IME DATOTEKE');
   readln (ime);
   ime:='C:/'+ime;
   end;
clrscr;
writeln ('UCITAVANJE ',ime);
delay (1000);
assign (buffer,ime);
reset (buffer);
readln (buffer,br);
readln (buffer);
writeln ('NADJENIH UNOSA: ',br);
for i:=1 to br do
with mem[i] do
      begin
      readln (buffer,ime);
      readln (buffer,prezime);
      readln (buffer,fiksni);
      readln (buffer,mob);
      readln (buffer,adresa);
      readln (buffer);
      end;
close (buffer);
writeln;
writeln ('             --------------');
writeln ('             PODACI UCITANI');
writeln ('             --------------');
readln;
end;


procedure opcije;
var o:integer;
begin
window (20,5,36,10);
textbackground (3);
clrscr;
writeln ('1) IZMJENI');
writeln ('2) UCITAJ');
writeln ('3) SACUVAJ');
writeln ('4) POVRATAK');
writeln;
write ('>');
readln (o);
case o of
     1: izmjeni;
     2: ucitaj;
     3: sacuvaj;
     end;
end;

procedure meni;
var i:integer;
begin
window (1,1,80,30);
textbackground (black);
clrscr;
textcolor (yellow);
write ('N');
gotoxy (15,1);
write ('P');
gotoxy (30,1);
write ('I');
gotoxy (45,1);
write ('O');
gotoxy (60,1);
write ('Z');
textcolor (white);
gotoxy (1,2);
for i:=1 to 66 do
write ('_');
gotoxy (2,1);
write ('ovi unos');
gotoxy (16,1);
write ('retrazi');
gotoxy (31,1);
write ('spisi');
gotoxy (46,1);
write ('pcije');
gotoxy (61,1);
write ('atvori');
gotoxy (1,24);
for i:=1 to 66 do
write ('_');
gotoxy (1,25);
write ('Made by IVAN');
gotoxy (52,25);
write ('ivan.r@blic.net');
o:=readkey;
case o of
'n','N': unos;
'p','P': pretrazi;
'i','I': ispis(i);
'o','O': opcije;
end;
end;

begin
clrscr;
br:=1;
repeat
meni
until (o='z') or (o='Z');
end.