: 17.03.2013
: 3
() : 0
0 () 0
: 10
|
:
. , . .
: , , , . , . , 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(n);
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.
|
|
17.03.2013, 02:06
