Friday 2 June 2017

A Pascal database that uses a coloured window

program records1(input, output);
uses crt;
{const maxsize = 99;}
type
address = record
name : string[40];
street : string[40];
area : string[40];
town : string[40];
county : string[40];
postcode : string[40];
telephone : string[40];
email : string[40];
end;

var
book : array[1..50] of address;
diskfile : file of address;
counter : integer;
choice : integer;
output : text;

procedure save;
var
loop : integer;
begin
assign(diskfile,'address.data');
rewrite(diskfile);
for loop := 1 to counter  do
write(diskfile,book[loop]);
close(diskfile);
end;

procedure load;
begin
assign(diskfile,'address.data');
reset(diskfile);
while not eof(diskfile) do
begin
counter:= counter + 1;
read(diskfile, book[counter]);
end;
close(diskfile);
end;

procedure newaddress;
begin
counter := counter +1;
textbackground (cyan);
window(1, 1, 40, 40);
writeln('Enter name: ');
readln(book[counter].name);
writeln('Enter street: ');
readln(book[counter].street);
writeln('Area / district: ');
readln(book[counter].area);
writeln('Enter town / city: ');
readln(book[counter].town);
writeln('Enter county: ');
readln(book[counter].county);
writeln('Enter postcode: ');
readln(book[counter].postcode);
writeln('Enter telephone number: ');
readln(book[counter].telephone);
writeln('Enter email address: ');
readln(book[counter].email);
end;


procedure display;
var
loop : integer;
begin
textbackground (green);
window(1, 1, 40, 40);
for loop := 1 to counter  do
begin
writeln('RECORD NO. ',loop);
writeln(book[loop].name);
writeln(book[loop].street);
writeln(book[loop].area);
writeln(book[loop].town);
writeln(book[loop].county);
writeln(book[loop].postcode);
writeln(book[loop].telephone);
writeln(book[loop].email);
writeln('');
end;
end;

procedure search;
var
loop : integer;
target : string[40];
begin
window(1, 1, 40, 40);
textbackground(magenta);
writeln('Enter name to search for: ');
readln(target);
for loop := 1 to counter do
if book[loop].name = target
then begin
writeln(book[loop].name);
writeln(book[loop].street);
writeln(book[loop].area);
writeln(book[loop].town);
writeln(book[loop].county);
writeln(book[loop].postcode);
writeln(book[loop].telephone);
writeln(book[loop].email);
writeln('');
end;
end;

procedure delete;
var
target : integer;
loop : integer;
begin
window(1, 1, 40, 40);
textbackground(red);
writeln('Record number? ');
readln(target);
if(target>0) and (target<=counter)
then begin
for loop := target to counter-1  do
book[loop] := book[loop+1];
counter := counter -1;
end;
end;

procedure sort;
var
noswaps : boolean;
current : address;
x : integer;
begin
repeat
noswaps := true;
for x := 1 to counter -1 do
begin
if book[x].name > book[x + 1].name then
begin
current := book[x];
book[x] := book[x+1];
book[x+1] := current;
noswaps := false;
end;
end;
until noswaps;
end;

procedure print;
var
loop : integer;
begin
assign(output,'printout.prn');
rewrite(output);

for loop := 1 to counter do
with book[loop] do
begin
writeln(output,book[loop].name);
writeln(output,book[loop].street);
writeln(output,book[loop].town);
writeln(output,book[loop].county);
writeln(output,book[loop].postcode);
writeln(output,book[loop].telephone);
writeln(output,book[loop].email);
writeln(output);
writeln(output);
end;
close(output);
end;


begin
counter:= 0;
repeat
window(1, 1, 40, 30);
textbackground(blink);
writeln('');
writeln('Address book');
writeln('Load file 1');
writeln('New address 2');
writeln('Display addresses 3');
writeln('Select by name 4');
writeln('Delete record 5');
writeln('Sort records 6');
writeln('Save 7');
writeln('Print file 8');
writeln('Exit 9');
writeln('Choose ...');
readln(choice);

if choice = 1 then load;
if choice = 2 then newaddress;
if choice = 3 then display;
if choice = 4 then search;
if choice = 5 then delete;
if choice = 6 then sort;
if choice = 7 then save;
if choice= 8 then print;
until choice = 9;
end.