Umístnení souboru www.TrSek.com/cover/badinka/zozstud.pas{ ZOZSTUD.PAS Copyright (c) Andrej Badinka }
{ Zoznam na studentov... Daju sa vytvarat nove zoznamy, otvarat }
{ existujuce, alebo exportovat do prehladneho textaku... }
{ mys nefunguje ale ovladanie je pomocou klavesy Alt+prislusna }
{ klavesa ktora je zvyraznena. }
{ }
{ Datum:14.11.2006 http://www.trsek.com }
program studenti;
uses crt,dos;
const AltM = #50; AltB = #48; AltS = #31; AltV = #47; esc = #27;
AltA = #30; AltO = #24; AltD = #32;
AltE = #18; AltF = #33; AltU = #22;
AltQ = #16; AltN = #49; AltC = #46;
type tstudent=record
Meno:string[20];
priezvisko:string[20];
odbor:string[30];
kruzok:string[7];
obluba:1..5;
end;
zoznam=file of tstudent;
var key:char;katalog:zoznam;
otv,koniec:boolean;nazov:string;
{*****************************************************************************************}
{********************************************************************* procedury s oknami }
{*****************************************************************************************}
procedure okno(xl,yh,xp,yd:integer;farba:word);
begin
textbackground(farba);
window(xl,yh,xp,yd);clrscr;
end;
procedure plocha;
var iHM,iHM2,i:byte;
st:Tstudent;
begin
okno(10,3,70,20,cyan);
textcolor(0);
if otv=true then
begin
textcolor(red);gotoxy(2,3);write('N');
gotoxy(6,3);write('Name');
gotoxy(19,3);write('Surname');
gotoxy(32,3);write('Field of study');
gotoxy(52,3);write('Class');
gotoxy(58,3);write('Fav');
for i:=1 to filesize(katalog) do
begin
seek(katalog,i-1);
textcolor(black);
read(katalog,st);
with st do
begin
gotoxy(2,3+i);write(i);
gotoxy(6,3+i);write(meno);
gotoxy(19,3+i);write(priezvisko);
gotoxy(32,3+i);write(odbor);
gotoxy(51,3+i);write(kruzok);
gotoxy(58,3+i);write(obluba);
end;
end
end;
for iHM:=1 to 18 do
begin
gotoxy(1,iHM);
if (iHM=17)or(iHM=2)
then for iHM2:=1 to 59 do
begin
gotoxy(61-iHM2,iHM);
write('*');
end
else if (iHM>2)and(iHM<17) then
begin
gotoxy(3,iHM);write('|');
gotoxy(17,iHM);write('|');
gotoxy(30,iHM);write('|');
gotoxy(50,iHM);write('|');
gotoxy(57,iHM);write('|');
gotoxy(1,iHM);write('*');
gotoxy(61,iHM);write('*');
end;
if iHM=1 then
begin
textbackground(black);
textcolor(yellow);
gotoxy(2,1);write(' F');gotoxy(13,1);
write('E');gotoxy(22,1);write('A');
if otv=false then begin
gotoxy(13,1);
textcolor(darkGray);
write('Edit ');
end;
textcolor(red);
gotoxy(5,1);write('ile ');gotoxy(14,1);
if otv=true then write('dit ');gotoxy(23,1);
writeln('bout Zoznamcek ');
if otv=true then begin
gotoxy(50-length(nazov)-6,iHM);
textbackground(blue);
write(' ',nazov,'.dat ');
end
else begin
gotoxy(40,1);
textcolor(darkgray);
write('No file');
end;
textbackground(cyan);textcolor(black)
end;
if iHM=18 then
begin
textcolor(yellow);textbackground(black);
gotoxy(2,18);write(' u');
gotoxy(41,18);write('Q');
textcolor(4);
gotoxy(15,18);write('B');gotoxy(17,18);write('tton control ');
gotoxy(42,18); write('uit ');
textcolor(black);textbackground(cyan);
end;
end;
end;
procedure credM;
begin
plocha;
okno(20,7,60,14,blue);clrscr;
gotoxy(15,2);write('ZOZNAMCEK');
gotoxy(2,4);write('Copyrighted (c) 2006 Bloodgarbage soft.');
gotoxy(10,5);write('Developer Andrei Badinka');
textcolor(red);gotoxy(33,7);write('B');textcolor(black);write('ack');
end;
procedure versM;
begin
plocha;
okno(25,8,55,13,blue);clrscr;
gotoxy(2,2);write('Version 1.0.0.');
gotoxy(2,3);write('Built on: 08.05.2006 04:15:36');
gotoxy(23,5);textcolor(red);write('B');textcolor(black);write('ack');
end;
procedure clear;
begin okno(1,1,80,25,black);
end;
procedure setcursor(s,e:byte);
var regs:registers;
begin
regs.ah:=01;
regs.cl:=e;
regs.ch:=s;
intr($10,regs);
end;
procedure cursoroff;
begin
setcursor($20,$20);
end;
{*****************************************************************************************}
{************************************************************** procedury so subormi }
{*****************************************************************************************}
function skusksub(nazov:string):boolean;
begin
{$I-}
assign(katalog,nazov); reset(katalog);{$I+}
if ioresult=0 then begin skusksub:=true; close(katalog); end
else skusksub:=false;
end;
procedure novysub;
begin
if otv=true then begin
close(katalog);
otv:=false;
end;
plocha;
okno(25,8,55,12,blue);clrscr;gotoxy(10,2);write('Name of file');
okno(27,11,52,11,red);clrscr;readln(nazov);
assign(katalog,nazov);rewrite(katalog);otv:=true;plocha;
end;
procedure otvsub;
begin
if otv=true then begin
close(katalog);
otv:=false;
end;
plocha;
okno(25,8,55,12,blue);clrscr;gotoxy(10,2);write('Name of file');
okno(27,11,52,11,red);clrscr;readln(nazov);
if skusksub(nazov) then begin
assign(katalog,nazov);
reset(katalog);otv:=true;plocha;
end
else begin
plocha;
okno(25,8,55,12,red);clrscr;
gotoxy(5,2);write('File "',nazov,'.dat" not found!!!');
gotoxy(25,4);textcolor(yellow);write('B');
textcolor(black);write('ack');readkey;plocha;
end;
end;
procedure vlozTstud;
var st:Tstudent;
begin
with st do
begin
plocha;
okno(20,7,50,12,blue); clrscr;okno(21,8,49,12,blue);clrscr;
writeln('Name:':7);readln(meno);clrscr;
writeln('Surname:':10);readln(priezvisko);clrscr;
writeln('Field of study:':17);readln(odbor);clrscr;
writeln('Class:':8);readln(kruzok);clrscr;
writeln('Favour (1 up to 5):':20);readln(obluba);clrscr;
end;
seek(katalog,filesize(katalog));
write(katalog,st);
plocha;
end;
procedure upravTstud;
var porcis:byte;
st:Tstudent;
begin
plocha;
okno(18,8,60,12,blue);clrscr;
gotoxy(4,2);writeln('Write number of student to edit');
okno(25,11,44,11,red);readln(porcis);plocha;
if (porcis<1) or (porcis>FileSize(katalog)) then
begin
okno(15,9,65,11,blue);clrscr;okno(16,10,62,10,red);clrscr;
gotoxy(2,1);
write(' Student with number ',porcis,' not found!!! (B)ack ');
end
else begin
seek(katalog,porcis-1);
okno(20,5,60,15,blue);
gotoxy(10,2);write('Student');
with st do
begin
read(katalog,st);
gotoxy(5,4);write('Name: ',meno,' Surname: ',priezvisko);
gotoxy(6,5);write('Field of study: ',odbor);
gotoxy(6,6);write('Class: ',kruzok);
gotoxy(6,7);write('Favour: ',obluba);
gotoxy(4,9);textcolor(red);write('E');
textcolor(black);write('dit???');
gotoxy(30,9);textcolor(red);write('B');
textcolor(black);write('ack');
end;
key:=readkey;
if key=#0 then key:=readkey;
case key of
AltB: begin
plocha;
okno(25,8,55,12,blue);clrscr;
gotoxy(5,2);write('Student left unchanged.');
gotoxy(25,4);textcolor(red);write('B');
textcolor(black);write('ack');
end;
AltE: begin
seek(katalog,porcis-1);
okno(20,5,60,16,blue);read(katalog,st);
with st do
begin
gotoxy(10,2);write('What do you want to change:');
gotoxy(16,4);textcolor(red);write('N');
textcolor(black);write('ame: ',meno);
gotoxy(16,5);textcolor(red);write(' S');
textcolor(black);write('urname: ',priezvisko);
gotoxy(16,6);textcolor(red);write('F');
textcolor(black);write('ield of study: ',odbor);
gotoxy(16,7);textcolor(red);write('C');
textcolor(black);write('lass: ',kruzok);
gotoxy(16,8);textcolor(black);write('Favour: ',obluba);
gotoxy(17,8);textcolor(red);write('a');
gotoxy(35,10);textcolor(red);write('B');
textcolor(black);write('ack');
end;
key:=readkey;
if key=#0 then key:=readkey;
with st do
begin
case key of
AltN: begin
okno(25,8,55,12,blue);clrscr;
gotoxy(5,2);write('Write the new name:');
okno(26,10,54,10,red);clrscr;readln(meno);plocha;
end;
AltS: begin
okno(25,8,55,12,blue);clrscr;
gotoxy(5,2);write('Write the new surname:');
okno(26,10,54,10,red);clrscr;readln(priezvisko);plocha;
end;
AltF: begin
okno(25,8,55,12,blue);clrscr;
gotoxy(3,2);write('Write the new field of study:');
okno(26,10,54,10,red);clrscr;readln(odbor);plocha;
end;
AltC: begin
okno(25,8,55,12,blue);clrscr;
gotoxy(5,2);write('Write the new class:');
okno(26,10,54,10,red);clrscr;readln(kruzok);plocha;
end;
AltA: begin
okno(25,8,55,12,blue);clrscr;
gotoxy(5,2);write('Write the new favour:');
okno(26,10,54,10,red);clrscr;readln(obluba);plocha;
end;
AltB: begin
plocha;
okno(25,8,55,12,blue);clrscr;
gotoxy(5,2);write('Student left unchanged.');
gotoxy(25,4);textcolor(red);write('B');
textcolor(black);write('ack');
end;
end;
end;
if key<>AltB then
begin
seek(katalog,porcis-1);
write(katalog,st);
okno(25,8,55,12,blue);clrscr;
gotoxy(5,2);write('Student was changed.');
gotoxy(25,4);textcolor(red);write('B');
textcolor(black);write('ack');
end;
end;
end;
end;
end;
procedure zmazTstud;
var st:Tstudent;
porcis,pom:byte;
volba:char;i:byte;
begin
plocha;
okno(18,8,60,12,blue);clrscr;
gotoxy(4,2);writeln('Write number of student to delete');
okno(25,11,44,11,red);readln(porcis);plocha;
if (porcis<1) or (porcis>FileSize(katalog)) then
begin
okno(15,8,65,12,blue);clrscr;okno(18,10,62,10,red);clrscr;
gotoxy(2,1);
write(' Student with number ',porcis,' not found!!! (B)ack ');
end
else begin
seek(katalog,porcis-1);
okno(20,5,60,15,blue);
gotoxy(10,2);write('Student');
with st do
begin
read(katalog,st);
gotoxy(5,4);write('Name: ',meno,' Surname: ',priezvisko);
gotoxy(6,5);write('Field of study: ',odbor);
gotoxy(6,6);write('Class: ',kruzok);
gotoxy(6,7);write('Favour: ',obluba);
gotoxy(4,9);textcolor(red);write('D');
textcolor(black);write('elete???');
gotoxy(30,9);textcolor(red);write('B');
textcolor(black);write('ack');
end;
repeat
key:=readkey;
if key=#0 then key:=readkey;
case key of
AltB: begin
plocha;
okno(25,8,55,12,blue);clrscr;
gotoxy(5,2);write('Student left unchanged.');
gotoxy(25,4);textcolor(red);write('B');
textcolor(black);write('ack');
end;
AltD: begin
for i:=porcis to filesize(katalog)-1 do
begin
Read(Katalog,sT);
Seek(katalog,I-1);
write(Katalog,sT);
Seek(Katalog,I+1);
end;
seek(katalog,filesize(katalog)-1);
truncate(katalog);
plocha;
okno(25,8,55,12,blue);clrscr;
gotoxy(5,2);write('Student was deleted.');
gotoxy(25,4);textcolor(red);write('B');
textcolor(black);write('ack');
end;
end;
until (key=AltD) or (key=AltB);
end;
end;
procedure urobtxt;
var txt:text;
textak:string;st:Tstudent;
porcis,i:byte;
begin
plocha;
okno(25,8,55,12,blue);clrscr;gotoxy(8,2);write('Name of text file');
okno(27,11,52,11,red);clrscr;readln(textak);plocha;
textak:=textak+'.txt';
assign(txt,textak);rewrite(txt);
writeln(txt);
write(txt,'List of students from file ',nazov,'.dat');
writeln(txt);writeln(txt);
writeln(txt,'Students:':13);writeln(txt);
writeln(txt,' ':5,'Name':10,'Surname':20,'Field of study':25,'Class':13,' Favour');
writeln(txt);
for porcis:=1 to filesize(katalog) do
begin
seek(katalog,porcis-1);
read(katalog,st);
with st do
begin
writeln(txt,porcis:5,' ':3,
Meno,' ':20-length(meno),
priezvisko,' ':20-length(priezvisko),
odbor,' ':20-length(odbor),
kruzok,' ':7-length(kruzok),
obluba,' ':3);
end;
end;
close(txt);
end;
begin
textbackground(black);
clrscr;
koniec:=false;otv:=false;
cursoroff;
plocha;{HM};
repeat
key:=readkey;
if key=#0 then key:=readkey;
case key of
AltQ: begin
key:=#0;
repeat
okno(25,9,50,11,red);clrscr;
gotoxy(4,1);write(' ');
gotoxy(4,2);write(' Really end??? Y/N ');
gotoxy(4,3);write(' ');
key:=readkey;
if (key='y')or(key='z') then begin
if otv=true then begin close(katalog);otv:=false;end;
koniec:=true;
end
else plocha;
until (key='y')or(key='n')or(key='z');
end;
AltF: begin
fileM;
key:=readkey;
if key=#0 then key:=readkey;
case key of
AltN: begin
novysub;
end;
AltO: begin
otvsub;
end;
AltM: begin
if otv=true then begin
urobtxt;
end;
end;
AltC: begin
if otv=true then close(katalog);
otv:=false;plocha;
end;
AltB: plocha; end;
end;
AltE: begin
if otv=true then
begin
editM;
key:=readkey;
if key=#0 then key:=readkey;
case key of
AltN: begin
vlozTstud;
end;
AltE: begin
upravTstud;
end;
AltD: begin
zmazTstud;
end;
AltB: plocha; end;
end;
end;
AltA: begin
aboutM;
key:=readkey;
if key=#0 then key:=readkey;
case key of
AltC: begin
credM;
end;
AltV: begin
versM;
end;
AltB: plocha;
end;
end;
AltU: begin
buttonM;
repeat
key:=readkey;
if key=#0 then key:=readkey;
until (key=AltB)or(key=esc);
plocha;
end;
AltB: begin
plocha;
end;
end;
until koniec=true;