Электронный журнал

[Alexander_]

Электронный журнал

Условия написания:
Программа должна формировать динамические списки учеников с возможностью добавления новых и удаления имеющихся. Считать средний баллучащегося по предмету, по всем предметам. Выводить статистику в графическом и текстовом виде.
Каждый элемент списка должен содержать как минимум следующую информацию: название предмета, текущая дата, класс, оценка по предмету. Записывать информацию в файл и загружать из файла, сортировать списки по выбранному полю. Поиск по выбранной категории, вывод учеников со средним баллом ниже 5.

Вот мой код:

Program vedomost;
uses crt,dos;
type
link = ^kom;
kom = record
fio : string[15];
adres : string[40];
mat : integer;
fiz : integer;
rus : integer;
srb : real; {‘।*Ё© Ў*««}
next : link;
end;
fl = file of kom;
var
spisok, nach, nach2 : link;
z : kom;
i, n, menu, m : integer;
a : char;
f : fl;
FlName : string;
chis, mes, god, den:word;
{‚ў®¤ бЇЁбЄ* б Є«*ўЁ*вгал}
procedure create(var sp1, nach1:link; var z : kom);
begin
write('”*¬Ё«Ёп бв㤥*в*...: '); {‚ў®¤ ¤***ле б Є«*ўЁ*вгал}
readln(z.fio); {”*¬Ё«Ёп *¤аҐб ®жҐ*ЄЁ Ї® ЇаҐ¤¬Ґв*¬}
write('Ђ¤аҐб Їа®¦Ёў**Ёп...: ');
readln(z.adres);
repeat
write('Њ*⥬*вЁЄ*.........: ');
readln(z.mat);
write('”Ё§ЁЄ*.............: ');
readln(z.fiz);
write('ђгббЄЁ©............: ');
readln(z.rus);
until (z.mat in [0..10])and(z.fiz in [0..10])and(z.rus in [0..10]); {Їа®ўҐаЄ* ®жҐ*ЄЁ Ї® ¤ҐбпвЁЎ*«м*®© бЁб⥬Ґ}
writeln;
z.srb := (z.mat+z.rus+z.fiz)/3; {‘।*Ё© Ў*««}
z.next := nil;
if nach1 = nil then {”®а¬Ёа®ў**ЁҐ бЇЁбЄ* б Є«*ўЁ*вгал}
begin
new(nach1);
nach1^ := z;
sp1 := nach1; {‡*Ї®¬Ё**Ґ¬ ЇҐаўл© н«Ґ¬Ґ*в бЇЁбЄ*}
nach1^.next:=nil;
end
else
begin
new(sp1^.next); {‚뤥«Ґ*ЁҐ Ї*¬пвЁ}
sp1:=sp1^.next; {ЏҐаҐе®¤ Є б«Ґ¤го饩 п祩ЄҐ бЇЁбЄ*}
sp1^ := z; {ЏаЁбў®Ґ*ЁҐ п祩ЄҐ бЇЁбЄ* ўўҐ¤к*ле ¤***ле}
sp1^.next:=nil;
end;
end;{ create }

procedure hapka;
begin
write('|------------------------------------------------------------------------------|');
write('| | ”*¬Ё«Ёп | Ђ¤аҐб | ЋжҐ*ЄЁ : | ‘а.|'); {?*ЇЄ* в*Ў«Ёжл}
write('| ь | бв㤥*в* | Їа®¦Ёў**Ёп |Њ*в |”Ё§ |ђгб |Ў*««|');
write('|------------------------------------------------------------------------------|');
end;

procedure stroka(sp1 : link);
begin
gotoXY(5,whereY);write('|',sp1^.fio);
gotoXY(21,whereY);write('|',sp1^.adres); {ЏҐз*вм бва®ЄЁ Ё§ бЇЁбЄ*}
gotoXY(60,whereY);write('| ',sp1^.mat);
gotoXY(65,whereY);write('| ',sp1^.fiz);
gotoXY(70,whereY);write('| ',sp1^.rus);
gotoXY(75,whereY);write('|',sp1^.srb:0:2,'|');
end;

{‚лў®¤ бЇЁбЄ* ** нЄа**}
procedure print(nach1 : link);
var
sp1 : link;
begin
sp1:=nach1;
i:=0;
if sp1=nil then writeln('‘ЇЁб®Є Їгбв!') {Їа®ўҐаЄ* Ґб«Ё «Ё ў бЇЁбЄҐ ¤***лҐ}
else
hapka;
while sp1<>nil do {ЇҐз*вм бЇЁбЄ*}
begin
i:=i+1;
write('| ',i,')');
stroka(sp1);
sp1:=sp1^.next;
end;
write('|------------------------------------------------------------------------------|');
writeln;
end; { print }


{“¤*«Ґ*ЁҐ н«Ґ¬Ґ*в* Ё§ бЇЁбЄ*}
procedure del(var nach1 : link; num : integer);
var
sp1, sp2 : link;
i : integer;
begin
if nach1<>nil then
begin
if num=1 then {“¤*«Ґ*ЁҐ ЇҐаў®Ј® н«Ґ¬Ґ*в* Ё§ бЇЁбЄ*}
begin
sp1:=nach1;
nach1:=nach1^.next;
dispose(sp1); {Ћбў®Ў®¦¤Ґ*ЁҐ Ї*¬пвЁ (г¤*«Ґ*ЁҐ н«Ґ¬Ґ*в*)}
end
else
begin {Ґб«Ё ўўҐ¤Ґ** *Ґ ЇҐаў*п Ї®§ЁжЁп ¤«п г¤*«Ґ*Ёпя}
i:=0; {ЁйҐ¬ ўўҐ¤Ґ**го Ї®§ЁжЁо зв®Ўл г¤*«Ёвм н«Ґ¬Ґ*в}
sp2:=nach1;
while (i<>num-2) and (sp2^.next<>nil) do {Ї®ЁбЄ ўўҐ¤Ґ**®© Ї®§ЁжЁЁ ¤«п г¤*«Ґ*Ёп н«Ґ¬Ґ*в*}
begin
i:=i+1;
sp2:=sp2^.next;
end;
if sp2^.next<>nil then
begin
sp1:=sp2^.next;
sp2^.next:=sp1^.next;
dispose(sp1); {®бў®Ў®¦¤Ґ*ЁҐ Ї*¬пвЁ (г¤*«Ґ*ЁҐ н«Ґ¬Ґ*в*)}
end;
end;
end;
end; { del }

{Џ®ЁбЄ н«Ґ¬Ґ*в* ў бЇЁбЄҐ}
Procedure FindElement(nach : link; m : integer);
var
sp1, sp2 : link;
i : integer;
z : kom;
eps : real; {¤®Ў®ў«Ґ*ЁҐ ЇҐаҐ¬Ґ**®© real **Ё¬Ґ*®ў**ЁҐ srb, зв®Ўл г z Ўл«® z.srb}
begin
clrscr;
eps:=0.01; {в*Є Є*Є ЇҐаҐ¬Ґ**лҐ *Ґ 楫®Ј® вЁЇ* а*ў*л Ўлў*ов ®зҐ*м ।Є® в® вॡгҐвбп ўўҐбвЁ в®з*®бвм}
sp1 := nach; {гЄ*§*⥫м ** ЇҐаўго §*ЇЁбм}
i:=0;
if sp1=nil then writeln('‘ЇЁб®Є Їгбв');
case m of {Џ®ЁбЄ н«Ґ¬Ґ*в* ў бЇЁбЄҐ Ї® ᮮ⢥бвўго饬г гб«®ўЁо}
1 : begin
write('”*¬Ё«Ёп бв㤥*в*: '); {Ї® ”*¬Ё«ЁЁ}
readln(z.fio);
writeln;
while sp1 <> nil do {ЇҐаҐЎЁа*Ґ¬ бЇЁб®Є}
begin
if sp1^.fio = z.fio then {Ґб«Ё **室Ё¬ б®ўЇ*¤Ґ*ЁҐ}
begin
i:=i+1; {ЇҐз*в*Ґ¬ бЇЁб®Є}
if i=1 then hapka;
write('| ',i,')');
stroka(sp1);
sp1:=sp1^.next;
end
else {Ґб«Ё *Ґ**室Ё¬ ¤ўЁЈ*Ґ¬бп ¤*«миҐ Ї® бЇЁбЄг}
sp1 := sp1^.next;
end;
if i=0 then {Ґб«Ё б®ўЇ*¤Ґ*Ё© *Ґ **©¤Ґ*®}
begin
writeln;
writeln('‚ бЇЁбЄҐ *Ґвбв㤥*в* б в*Є®© **¤ЇЁбмо');
writeln;
end
else
write('|------------------------------------------------------------------------------|');
writeln;
end;
2 : begin
write('Ђ¤аҐб Їа®¦Ёў**Ёпя: '); {Ї® *¤аҐбг}
readln(z.adres);
writeln;
while sp1 <> nil do
begin
if sp1^.adres = z.adres then
begin
i:=i+1;
if i=1 then hapka;
write('| ',i,')');
stroka(sp1);
sp1:=sp1^.next;
end
else
sp1 := sp1^.next;
end;
if i=0 then
begin
writeln;
writeln('‚ бЇЁбЄҐ *Ґв бв㤥*в* б в*ЄЁ¬ *¤аҐб®¬');
writeln;
end
else
write('|------------------------------------------------------------------------------|');
writeln;
end;
3 : begin
write('‘।*Ё© Ў*««: '); {Џ® б।*Ґ¬г Ў*««г}
readln(z.srb);
writeln;
while sp1 <> nil do
begin
if abs(sp1^.srb-z.srb)<=eps then
begin
i:=i+1;
if i=1 then hapka;
write('| ',i,')');
stroka(sp1);
sp1:=sp1^.next;
end
else
sp1 := sp1^.next;
end;
if i=0 then
begin
writeln;
writeln('‘ бЇЁбЄҐ *Ґв бв㤥*в* б в*ЄЁ¬ б।*Ё¬ Ў*««®¬');
writeln;
end
else
write('|------------------------------------------------------------------------------|');
writeln;
end;
end;
end;

{‘®авЁа®ўЄ* Ї® д*¬Ё«ЁЁ}
procedure AddInSortSpisok(z: kom; var nach2: link);
var
sp1, sp2, t: link ;
begin
new(t);
t^ := z; {*®ўл© н«Ґ¬Ґ*в}
sp1 := nach2;
sp2 := nil;
while (sp1<>nil) and (sp1^.fio<z.fio) do {ЁйҐ¬ ¬Ґбв® ЇаЁўп§ЄЁ Ї® д*¬Ё«ЁЁ}
begin
sp2 := sp1;
sp1:= sp1^.next;
end;
t^.next := sp1; {ўбв*ўЄ* ЇаЁўп§Є* *г¦*®Ґ ¬Ґбв® ¬Ґ¦¤г а Ё аЄ}
if sp2 = nil then nach2 := t {ЇҐаўл© н«Ґ¬Ґ*в ў бЇЁбЄҐ}
else
sp2^.next := t;
end;

{‘®авЁа®ўЄ* бв㤥*в®ў Ї® ¬Ґбв㠯஦Ёў**Ёп=ЊЁ*бЄ Ё б।*Ґ¬г Ў*««г ўлиҐ 4}
procedure NewSpisokPorjadok(nach : link; var nach2 : link); {Ќ®ўл© бЇЁб®Є}
var
sp1 : link; {“Є*§*⥫м ** **з*«® в®«мЄ® б® бв㤥*в*¬Ё Ё§ ЊЁЈбЄ*}
begin
nach2 := nil; {Ќ®ўл© бЇЁб®Є}
sp1:= nach;
while sp1 <> nil do
begin
z := sp1^;
if (z.srb>=4) and (pos('Minsk',z.adres) > 0) then {ЋЇаҐ¤Ґ«Ґ*ЁҐ Є®«ЁзҐбвў* бв㤥*в®ў,}
AddInSortSpisok(z, nach2); {Їа®¦Ёў*ойЁе ў Ј®а®¤Ґ ЊЁ*бЄҐ}
sp1:= sp1^.next; {б® б।*Ё¬ Ў*««®¬ *Ґ *Ё¦Ґ 4}
end;
end;

{ЋвЄалвЁҐ бЇЁбЄ Ё§ д*©«*}
procedure SpisokFromFile(var f: fl; var nach: link);
var
flag:boolean; {true=д*©« бгйҐбвўгҐв }
sp1: link;
begin
clrscr;
repeat
flag:=true;
write('‚ўҐ¤ЁвҐ Ё¬п д*©«* ¤«п ®вЄалвЁп: ');
readln(FlName);
assign(f, FlName); {‘гйҐбвў®ў**ЁҐ д*©«* *Ґ ®Ўп§*⥫м*®}
reset(f);
if IOResult<>0 then
begin
writeln('’*Є®Ј® д*©«* *Ґ бгйҐбвўгҐв.');
flag:=false;
end;
until flag;
nach := nil;
sp1:= nil;
while not eof(f) do {”®а¬Ёа®ў**ЁҐ бЇЁбЄ* Ё§ д*©«*}
begin
read(f, z); {звҐ*ЁҐ д*©«*}
z.next := nil;
if nach = nil then
begin
new(nach);
nach^ := z;
sp1 := nach;
nach^.next:=nil;
end
else
begin
new(sp1^.next);
sp1:=sp1^.next;
sp1^ := z;
sp1^.next:=nil;
end;
end;
close(f);
end;

{‘®еа**Ґ*ЁҐ ў д*©«}
procedure SpisokToFile(var f: fl; var nach: link);
var
sp1: link;
begin
clrscr;
write('‚ўҐ¤ЁвҐ Ё¬п д*©«* б ¤***л¬Ё: ');
readln(FlName);
assign(f, FlName); {д*©« ¬®¦Ґв Ё *Ґ бгйҐбвў®ў*вм}
rewrite(f); {ЇҐаҐ§*ЇЁ¬м ¤***ле}
sp1:= nach;
while sp1<>nil do {б®еа**Ґ*ЁҐ бЇЁбЄ* ў д*©«}
begin
z := sp1^;
write(f, z);
sp1:=sp1^.next;
end;
close(f);
end;


begin
clrscr;
nach := nil;
spisok:= nil;
menu:=1;
while menu<>0 do
begin
getdate(god, mes, chis, den);
writeln('’ҐЄгй*п ¤*в*:',chis,'.',mes,'.',god);
writeln;
writeln('1 - „®Ў®ў«Ґ*ЁҐ н«Ґ¬Ґ*в* ў ўҐ¤®¬®бвм.');
writeln('2 - ‚лў®¤ ўҐ¤®¬®бвЁ ** нЄа**.');
writeln('3 - “¤*«Ґ*ЁҐ н«Ґ¬Ґ*в* Ё§ ўҐ¤®¬®бвЁ.');
writeln('4 - Џ®ЁбЄ н«Ґ¬Ґ*в* Ї® Ї®«о.');
writeln('5 - ‘®авЁа®ўЄ* бв㤥*в®ў Ї® *«д®ўЁвг(Ђ¤аҐб=ЊЁ*бЄ ‘।*Ё© Ў*«« ўлиҐ 4).');
writeln('6 - ‡*ЇЁбм ўҐ¤®¬®бвЁ ў д*©«.');
writeln('0 - ‚л室');
writeln;
write('‚ўҐ¤ЁвҐ Їг*Єв ¬Ґ*о: ');
readln(menu);
if (menu in [1..7,0]) then {Є®*ва®«м ўў®¤*}
begin
case menu of {ѓ«*ў*®Ґ ¬Ґ*о Їа®Ја*¬¬л}
1 : begin
clrscr;
repeat
create(spisok,nach,z);
write('„«п ўл室* **¦¬ЁвҐ - 0 ');
readln(a);
until (a = '0');
clrscr;
end;
2 : begin
clrscr;
print(nach);
end;
3 : begin
writeln;
write('‚ўҐ¤ЁвҐ *®¬Ґа н«Ґ¬Ґ*в* Є®в®ал© *Ґ«Ўе®¤Ё¬® г¤*«Ёвм: ');
readln;
writeln;
del(nach,n);
clrscr;
end;
4 : begin
clrscr;
writeln('‚ўҐ¤ЁвҐ Ї®«Ґ Ї® Є®в®а®¬г *Ґ®Ўе®¤Ё¬® ўлЇ®«*Ёвм Ї®ЁбЄ: ');
writeln;
writeln('1 - Џ®ЁбЄ Ї® д*¬Ё«ЁЁ.');
writeln('2 - Џ®ЁбЄ Ї® Ђ¤аҐбг.');
writeln('3 - Џ®ЁбЄ Ї® ‘।*Ґ¬г Ў*««г.');
writeln('0 - ‚л室.');
writeln;
repeat
write('‚лЎҐаЁвҐ Їг*Єв ¬Ґ*о: ');
readln(m);
writeln;
if m in [1..3,0] then
begin
case m of
1 : FindElement(nach,m);
2 : FindElement(nach,m);
3 : FindElement(nach,m);
end;
end
else
begin
writeln('„®бвгЇ*г в®«мЄ® Їг*Євл 1, 2, 3, 0'); {Џ®¤¬Ґ*о Їа®Ја*¬¬л}
writeln;
end;
until m in [1..3,0];
end;
5 : begin
clrscr;
AddInSortSpisok(z,nach2);
NewSpisokPorjadok(nach,nach2);
if nach2 = nil then
begin
writeln('‘ЇЁб®Є *Ґ ᮤҐа¦Ёв ЊЁ*з** б® ‘।*Ё¬ Ў*««®¬ ўлиҐ 4');
writeln;
end
else
begin
writeln(' ‘ЇЁб®Є ЊЁ*з** б® б।*Ё¬ Ў*««®¬ ўлиҐ 4 Ї® нЄ§*¬Ґ**¬:');
print(nach2);
end;
end;
6 : begin
clrscr;
repeat
writeln('1 - ЋвЄалвм д*©«');
writeln('2 - ‘®еа**Ёвм д*©«');
writeln;
write('ўлЎЁаЁвҐ ¤Ґ©бвўЁҐ б д*©«®¬: ');
readln(m);
if m in [1,2] then {Џ®¤¬Ґ*о Їа®Ја*¬¬л}
begin
case m of
1 : SpisokFromFile(f,nach);
2 : SpisokToFile(f,nach);
end;
end
else
begin
writeln;
writeln('ЌҐўҐа*л© ўў®¤ ¤®бвгЇ*л в®«мЄ® Їг*Євл 1, 2');
writeln;
end;
writeln;
until m in [1,2];
end;
end; {case}
end
else
begin
writeln;
writeln('„®бвгЇ*л в®«мЄ® Їг*Євл ¬Ґ*о 1,2,3,4,5,6,0');
writeln;
end;
end; {while}
end.

 

[Alexander_]

Как добавлять несколько оценок по одному предмету?

 

[Alexander_]

исходник в архиве