Database of students
Delphi & Pascal (česká wiki)
Category: KMP (Club of young programmers)
Author: Andrej Badinka
Program: Zozstud.pas
File exe: Zozstud.exe
Example: Student.txt, Student.dat
Author: Andrej Badinka
Program: Zozstud.pas
File exe: Zozstud.exe
Example: Student.txt, Student.dat
Database of students... Program allow add new items, open exist file, or export to text file... Not support mouse but you can use key Alt+letter key. Key is highlight.
{ 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 HM; begin okno(30,5,40,12,red); gotoxy(15,5); write(' '); gotoxy(15,6); write(' '); gotoxy(15,7); write(' '); gotoxy(15,8); write(' '); gotoxy(15,9); write(' '); gotoxy(15,10);write(' '); gotoxy(15,11);write(' '); end; procedure fileM; begin plocha; okno(12,4,19,9,green); textcolor(red);clrscr; gotoxy(1,1);write('********'); gotoxy(2,2);write('N');gotoxy(2,3);write('O');gotoxy(2,4); if otv=false then textcolor(black);write('M');textcolor(red); gotoxy(2,5);write('B');gotoxy(2,6);write('C'); textcolor(black); gotoxy(3,2);write('ew');gotoxy(3,3);write('pen'); gotoxy(3,4);write('ake');gotoxy(3,5);write('ack');gotoxy(3,6);write('lose'); end; procedure editM; begin plocha; okno(21,4,36,9,green);clrscr; textcolor(red); gotoxy(1,1);write('****************'); gotoxy(2,2);write('N');gotoxy(2,3);write('E');gotoxy(2,4);write('D'); gotoxy(2,6);write('B'); textcolor(black); gotoxy(3,2);write('ew student');gotoxy(3,3);write('dit student'); gotoxy(3,4);write('elete student');gotoxy(3,6);write('ack'); end; procedure aboutM; begin plocha; okno(30,4,44,9,green);clrscr; textcolor(red); gotoxy(1,1);write('***************'); gotoxy(2,2);write('V');gotoxy(2,3);write('C');gotoxy(2,4);write('daco'); gotoxy(2,6);write('B'); textcolor(black); gotoxy(3,2);write('ersion');gotoxy(3,3);write('redits');gotoxy(3,4); gotoxy(3,6);write('ack'); end; procedure buttonM; begin plocha; okno(17,8,63,15,blue);clrscr; gotoxy(12,2);write('>>> Key operating <<<');gotoxy(1,1); gotoxy(5,4);write('[Alt]+[highlighted letter] - shortkeys'); gotoxy(10,5);write('Arrows allows moving in menus.'); textcolor(red); gotoxy(40,7);write('B');textcolor(black);write('ack'); 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; {-------------------------------------} {-------------------------zac programu} 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; end.