Добавил:
Sergo
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:KURSOV~1 / FFILE
.PASunit ffile;
interface
uses dos,crt,ffind,mouse;
type dimas=array[1..1] of integer;
type base = record
name:string[25];
nd:longint;
de:longint;
ri:longint;
otn1:real;
otn2:real;
otn3:real;
otn4:real;
end;
var
zt,t:base;
a,j,n,i,d,c:integer;
max,min,sume,sumi:longint;
ch:char;
nmax,nmin:string;
log,load:0..1;
var sr: real;
var nz:integer;
x,y,x0,y0,k,p, p1, p2, p3:byte;
path,path_o,s,st,ss,sss,namef,name:string;
dmas:^dimas;
fo,f,ftm:file of base;
palka:char;
swp1,swp2:base;
o,q:integer;
Procedure Help;
Procedure SelectF;
Procedure RemZap(d:byte);
procedure AddZap;
procedure create;
procedure print;
procedure save;
procedure PrintSt(St:string);
procedure testdisk;
procedure ReCalc;
Procedure obramlenie(xn,yn,xk,yk,a,b,c:byte);
Procedure nsave;
implementation
Procedure nsave;
begin
clrscr;
{$I-}
repeat
clrscr;
window(1,1,80,25);
clrscr;
obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);
textcolor(0);
gotoxy(3,3);
write('BўҐ¤ЁвҐ Ё¬п д ©« ¤«п १г«мв в®ў Ё«Ё Esc ¤«п ®в¬Ґл:');
window(14,11,65,11);
textbackground(9);
textcolor(15);
clrscr;
ch:=readkey; if ch=#27 then begin window(1,1,80,25);exit;end;
write (ch);
readln(path_o);
path_o:=ch+path_o;
assign (fo,path_o);
reset (fo);
window(14,12,65,15);
textcolor(0);
textbackground(7);
k:=ioresult;
if k=0 then begin
repeat
gotoxy(10,5);
writeln;
writeln (' ',path_o, '-㦥 бгйҐбвўгҐв. ЏҐаҐ§ ЇЁб вм ?(Y/N)');
cursor(off);
ch:=upcase(readkey)
until ch in ['N', 'Y'];
if ch='Y' then begin rewrite (fo); log:=1;end
else k:=1;
end
else begin rewrite (fo); k:=0;log:=1; end;
if k>0 then
writeln (path_o, '-гЄ § ®Ґ Ё¬п ҐўҐа®, Ї®Їа®Ўг©вҐ Ґйс а §');
cursor(on);
until k=0;
{$I+}
window(1,1,80,25);
clrscr;
end;
Procedure testdisk;
var lenfr, lensz, i: longint; n:word; g,st:string;
begin
n:=0; st:='⥪гйЁ©';
repeat
lenfr:=diskfree(n);
lensz:=disksize (n);
if lensz>0 then begin
gotoxy(13,3);
textcolor(0);
write(' „ЁбЄ - ');
textcolor(4);
write(st);writeln;textcolor(0);
gotoxy(11,4);
writeln ('Џ®«л© ®Ўкс¬ ў Ў ©в е:', lensz);
gotoxy(11,5);
writeln ('‘ў®Ў®¤л© ®Ўс¬ ў Ў ©в е:', lenfr);
end
else begin gotoxy(11,9);writeln ('„ЁбЄ Ґ ©¤Ґ');readkey;
clrscr;obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);end;
gotoxy(11,7);
write ('Џа®вҐбвЁа®ў вм ¤агЈ®© ¤ЁбЄ? Y/N: ');
readln(g);
clrscr;
obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);
textcolor(0);
if g='y' then begin
gotoxy(11,2);
write ('0 ⥪гйЁ©, 1 - A, 2 - B, 3 - C ');
readln (n);
case n of
0: st:='⥪гйЁ©';
1: st:='A';
2: st:='B';
3: st:='C';
end;
end;
until g='n'; end;
procedure SelectF;
Var
PathName : String[5];
FileName : String[13];
Begin
clrscr;
obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);
textcolor(0);
gotoxy(3,3);
Write('‚ўҐ¤ЁвҐ а биЁаҐЁҐ : ');
ReadLn(PathName);
PathName:='*.'+PathName;
path := Select_File(PathName,$7f,$1f,20,11,20,1);
TextAttr := $07;
ClrScr;
If path = '?' then WriteLn('ЌҐв д ©«®ў б а биЁаҐЁҐ¬ ',PathName)
else
If path = '' then WriteLn('Џ®ЁбЄ ЇаҐаў ')
else
load:=1;
getmem(dmas,sizeof(integer));
for i:=1 to nz do dmas^[i]:=i;
assign(f,path);
reset(f);
nz:=filesize(f);
close(f);
getmem(dmas,sizeof(integer));
for i:=1 to nz do dmas^[i]:=i;
clrscr;
{obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);
textcolor(0);
gotoxy(8,6);
PrintSt(' “бЇҐи® § Јаг¦Ґл ¤ лҐ Ё§ ');
textcolor(red);
PrintSt(path);}
print;
readkey;
end;
{----------------------}
PROCEDURE RemZap(d:byte);
var
j:word;
begin
assign(f,path);
reset(f);
j:=d;
seek(f,j);
while not eof(f) do begin
read(f,zt);
seek(f,j-1);
write(f,zt);
j:=j+1;seek(f,j);end;
seek(f,j-1);
truncate(f);
close(f);
dec(nz);
for j:=1 to nz do dmas^[j]:=j;
Recalc;
end;
{------------------}
procedure AddZap;
label 1,2,3,4;
begin
if load=0 then begin
obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);
textcolor(0);
gotoxy(6,6);
Writeln('„ лҐ Ґ § Ја㦥л, ¤®Ў ў«ҐЁҐ Ґў®§¬®¦®');
Readkey;
end else begin
assign(f,path);
reset(f);
clrscr;
writeln;
textbackground(13);
clrscr;
window(1,1,80,25);
obramlenie(1,1,80,25,26,$9,$f);
textbackground(9);
gotoxy(14,2);
textcolor($a);
writeln (' ‚ўҐ¤ЁвҐ ®ўлҐ ¤ лҐ Ё«Ё ENTER ¤«п ўл室 ');
textcolor(15);
gotoxy(3,3);
writeln('ЪДДДДДДДДДДДДДДВДДДДДДДДДДДДДДДДДДДДВДДДДДДДДДДДДДДДДДДДВДДДДДДДДДДДДДДДДДДї');
gotoxy(3,4);
writeln('і ‘ва і Ќ жЁ® «мл© ¤®е®¤ і „®е®¤ ®в нЄбЇ®ав і ђ б室 Ё¬Ї®ав і');
gotoxy(3,5);
writeln('АДДДДДДДДДДДДДДБДДДДДДДДДДДДДДДДДДДДБДДДДДДДДДДДДДДДДДДДБДДДДДДДДДДДДДДДДДДЩ');
gotoxy(3,6);
y:=7;
textcolor($f);
4:gotoxy (5,y);
readln (swp2.name);
if zt.name='' then goto 4;
{$i-}
textcolor($a);
repeat
1:gotoxy (25,y);
ch:=readkey;
if ord(ch) = 13 then goto 1 else
begin
write(ch);
readln(swp2.nd);
end;
k:=ioresult;
if k>0 then
begin
textbackground(4);
gotoxy(23,y);
cursor(off);
write('ЋиЁЎЄ ўў®¤ !');
readkey;
textbackground(1);
textcolor(1);
gotoxy(23,y);
write(' ');
textcolor($a);
gotoxy(25,y);
cursor(on);
end;
until k=0;
repeat
2:gotoxy(45,y);
ch:=readkey;
if ord(ch) = 13 then goto 2 else
begin
write(ch);
readln(swp2.de);
end;
k:=ioresult;
if k>0 then
begin
textbackground(4);
gotoxy(43,y);
cursor(off);
write('ЋиЁЎЄ ўў®¤ !');
readkey;
textbackground(1);
textcolor(1);
gotoxy(43,y);
write(' ');
textcolor($a);
gotoxy(45,y);
cursor(on);
end;
until k=0;
repeat
3:gotoxy(65,y);
ch:=readkey;
if ord(ch) = 13 then goto 3 else
begin
write(ch);
readln(swp2.ri);
end;
k:=ioresult;
if k>0 then
begin
textbackground(4);
gotoxy(63,y);
cursor(off);
write('ЋиЁЎЄ ўў®¤ !');
readkey;
textbackground(1);
textcolor(1);
gotoxy(63,y);
write(' ');
textcolor($a);
gotoxy(65,y);
cursor(on);
end;
until k=0;
{$i+}
j:=1;
while not eof(f) do
begin
read(f,swp1);
if swp1.name > swp2.name then
begin
seek(f,j-1);
write(f,swp2);
swp2:=swp1;
end;
j:=j+1;
end;
write(f,swp2);
Close(f);
inc(nz);
for j:=1 to nz do dmas^[j]:=j;
recalc;
print;
readkey;
end;
end;
procedure PrintSt(St:string);
var l, i:integer;
begin
l:=length(st);
for i:=1 to l do begin
write(st[i]);
delay(50);
end;
end;
{--------------------------}
procedure save;
var txt:text;
st:string;
begin
if load=0 then begin
obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);
textcolor(0);
gotoxy(8,6);
Writeln('„ лҐ Ґ § Ја㦥л, б®еа ҐЁҐ Ґў®§¬®¦®');
readkey;
end else begin
if log=0 then nsave;
assign(f,path);
assign(fo,path_o);
assign(txt,'rezult.txt');
rewrite(txt);
reset(f);
rewrite(fo);
palka:=chr(179);
writeln(txt,'ЪДДДДДДДДДДВДДДДДДДДВДДДДДДДДВДДДДДДДДВДДДДДДДДВДДДДДДДДВДДДДДДДДВДДДДДДДДї');
Writeln(txt,'і ‘ва і „®е®¤ і ќЄбЇ®аві €¬Ї®авіќЄб-в(%)і €¬в/ќЄбіќЄб-в(%)і€¬Ї-в(%)і');
writeln(txt,'ГДДДДДДДДДДЕДДДДДДДДЕДДДДДДДДЕДДДДДДДДЕДДДДДДДДЕДДДДДДДДЕДДДДДДДДЕДДДДДДДДґ');
for i:=1 to nz do
begin
seek(f,dmas^[i]-1);
read(f,zt);
write(fo,zt);
Writeln(txt,palka,zt.name:10,palka,zt.nd:8,palka,zt.de:8,palka,zt.ri:8,palka,
zt.otn1:8:2,palka,zt.otn2:8:2,palka,zt.otn3:8:2,palka,zt.otn4:8:2,palka);
end;
writeln(txt,'АДДДДДДДДДДБДДДДДДДДБДДДДДДДДБДДДДДДДДБДДДДДДДДБДДДДДДДДБДДДДДДДДБДДДДДДДДЩ');
obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);
textcolor(0);
gotoxy(5,5);
if log=1 then begin
st:='„ лҐ гбЇҐи® б®еа Ґл ў '+path_o;
PrintSt(st);
gotoxy(5,6);
st:='ђҐ§г«мв в ў ⥪бв®ў®¬ ўЁ¤Ґ ';
PrintSt(st);
textcolor(red);
PrintSt('Result.txt');
end;
readkey;
window(1,1,80,25);
close(txt);
close(fo);
close(f);
end;
end;
Procedure create;
var ft:text;
p:byte;
cena: real;
x,y,sklad, sht_den: integer;
ifl, ift: string;
kod:integer;
ch:char;
label 1,2,3;
Begin
clrscr;
obramlenie(1,1,80,25,26,$9,$f);
{crfile;}
clrscr;
{$I-}
repeat
clrscr;
window(1,1,80,25);clrscr;
obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);
textcolor(0);
gotoxy(3,3);
write('BўҐ¤ЁвҐ Ё¬п д ©« ¤«п § ЇЁбЁ Ё«Ё Esc ¤«п ®в¬Ґл:');
window(14,11,65,11);
textbackground(9);
textcolor(15);
clrscr;
ch:=readkey; if ch=#27 then begin window(1,1,80,25);exit;end;
write (ch);
readln(path);
path:=ch+path;
assign (f,path);
reset (f);
window(14,12,65,15);
textcolor(0);
textbackground(7);
k:=ioresult;
if k=0 then begin
repeat
gotoxy(10,5);
writeln;
writeln (' ',path, '-㦥 бгйҐбвўгҐв. ЏҐаҐ§ ЇЁб вм ?(Y/N)');
cursor(off);
ch:=upcase(readkey)
until ch in ['N', 'Y'];
if ch='Y' then rewrite (f)
else k:=1;
end
else begin rewrite (f);k:=0; end;
if k>0 then
writeln (path, '-гЄ § ®Ґ Ё¬п ҐўҐа®, Ї®Їа®Ўг©вҐ Ґйс а §');
cursor(on);
until k=0;
{$I+}
window(1,1,80,25);
clrscr;
clrscr;
writeln;
textbackground(13);
clrscr;
window(1,1,80,25);
obramlenie(1,1,80,25,26,$9,$f);
textbackground(9);
gotoxy(14,2);
textcolor($a);
writeln (' ‚ўҐ¤ЁвҐ ¤ лҐ Ё«Ё ENTER ¤«п ўл室 ');
textcolor(15);
gotoxy(3,3);
writeln('ЪДДДДДДДДДДДДДДВДДДДДДДДДДДДДДДДДДДДВДДДДДДДДДДДДДДДДДДДВДДДДДДДДДДДДДДДДДДї');
gotoxy(3,4);
writeln('і ‘ва і Ќ жЁ® «мл© ¤®е®¤ і „®е®¤ ®в нЄбЇ®ав і ђ б室 Ё¬Ї®ав і');
gotoxy(3,5);
writeln('АДДДДДДДДДДДДДДБДДДДДДДДДДДДДДДДДДДДБДДДДДДДДДДДДДДДДДДДБДДДДДДДДДДДДДДДДДДЩ');
gotoxy(3,6);
y:=7;
while True do
begin
{window(8,4,72,22);}
textcolor($f);
gotoxy (5,y);
readln (zt.name);
if zt.name='' then break;
{$i-}
textcolor($a);
repeat
1:gotoxy (25,y);
ch:=readkey;
if ord(ch) = 13 then goto 1 else
begin
write(ch);
readln(zt.nd);
end;
k:=ioresult;
if k>0 then
begin
textbackground(4);
gotoxy(23,y);
cursor(off);
write('ЋиЁЎЄ ўў®¤ !');
readkey;
textbackground(1);
textcolor(1);
gotoxy(23,y);
write(' ');
textcolor($a);
gotoxy(25,y);
cursor(on);
{clrscr;
textbackground(25);
clrscr;}
end;
{window(8,4,72,22);}
{textbackground(25);
textcolor(26);}
until k=0;
{ window(8,4,72,22);}
repeat
2:gotoxy(45,y);
ch:=readkey;
if ord(ch) = 13 then goto 2 else
begin
write(ch);
readln(zt.de);
end;
k:=ioresult;
if k>0 then
begin
textbackground(4);
gotoxy(43,y);
cursor(off);
write('ЋиЁЎЄ ўў®¤ !');
readkey;
textbackground(1);
textcolor(1);
gotoxy(43,y);
write(' ');
textcolor($a);
gotoxy(45,y);
cursor(on);
end;
{ window(8,4,72,22);}
{ textbackground(25);
textcolor(26); }
until k=0;
{ window(8,4,72,22);}
repeat
3:gotoxy(65,y);
ch:=readkey;
if ord(ch) = 13 then goto 3 else
begin
write(ch);
readln(zt.ri);
end;
k:=ioresult;
if k>0 then
begin
textbackground(4);
gotoxy(63,y);
cursor(off);
write('ЋиЁЎЄ ўў®¤ !');
readkey;
textbackground(1);
textcolor(1);
gotoxy(63,y);
write(' ');
textcolor($a);
gotoxy(65,y);
cursor(on);
end;
{ window(8,4,72,22);}
{ textbackground(25);
textcolor(26);}
until k=0;
{$i+}
{ window(8,4,72,22);}
write(f,zt);
inc(n);
inc(y);
end;
load:=1;
nz:=n;
seek(f,0);
for i:=1 to nz-1 do
for j:=i+1 to nz do
begin
seek(f,i-1);read(f,swp1);
seek(f,j-1);read(f,swp2);
if swp1.name>swp2.name then
begin
t:=swp1;
seek(f,i-1);write(f,swp2);
seek(f,j-1);write(f,t);
end;
end;
close(f);
getmem(dmas,sizeof(integer));
for i:=1 to nz do dmas^[i]:=i;
reset(f);
{ textbackground(26);
textcolor(25);
window (1,1,80,25);
clrscr;}
obramlenie(1,1,80,25,9,9,$f);
s:=('ЪДДДДДДДДДДДДВДДДДДДДДДДДДВДДДДДДДДДДДДВДДДДДДДДДДДДї');
ss:=('ГДДДДДДДДДДДДЕДДДДДДДДДДДДЕДДДДДДДДДДДДЕДДДДДДДДДДДДґ');
sss:=('АДДДДДДДДДДДДБДДДДДДДДДДДДБДДДДДДДДДДДДБДДДДДДДДДДДДЩ');
palka:=chr(179);
y:=7;
gotoxy(13,4);
Writeln(s);
gotoxy(13,5);
WriteLn('і ‘ва і „®е®¤ і ќЄбЇ®ав і €¬Ї®ав і');
gotoxy(13,6);
Writeln(ss);
seek(f,0);
while not eof(f) do
begin
read(f,zt);
{sume:=sume+zt.de;
sumi:=sumi+zt.ri; }
gotoxy(13,y);
WriteLn(palka,zt.name:12,palka,zt.nd:12,palka,zt.de:12,palka,zt.ri:12,palka);
inc(y);
end;
gotoxy(13,y);
writeln(sss);
Recalc;
{------------}
gotoxy(30,20);
cursor(off);
write ('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг... ');
readln;clrscr;
end;
{--------------------------}
procedure ReCalc;
begin
assign(f,path);
reset(f);
assign(ftm,'temp.dat');
rewrite(ftm);
seek(f,0);
nz:=0;
sume:=0;
sumi:=0;
while not eof(f) do
begin
read(f,zt);
sume:=sume+zt.de;
sumi:=sumi+zt.ri;
inc(nz);
end;
seek(f,0);
while not eof(f) do
begin
read(f,zt);
zt.otn1:=(zt.de/zt.nd)*100;
zt.otn2:=(zt.ri/zt.de)*100;
zt.otn3:=zt.de/sume*100;
zt.otn4:=zt.ri/sumi*100;
write(ftm,zt);
end;
close(ftm);
close(f);
reset(ftm);
rewrite(f);
seek(ftm,0);
while not eof(ftm) do
begin
read(ftm,zt);
write(f,zt);
end;
close(ftm);
close(f);
end;
procedure print;
begin
if load=0 then begin
obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);
textcolor(0);
gotoxy(8,6);
Writeln('„ лҐ Ґ § Ја㦥л, Їа®б¬®ва Ґў®§¬®¦Ґ');
end else begin
assign(f,path);
reset(f);
obramlenie(1,1,80,25,9,9,$f);
s:=('ЪДДДДДДДДДДВДДДДДДДДВДДДДДДДДВДДДДДДДДВДДДДДДДДВДДДДДДДДВДДДДДДДДВДДДДДДДДї');
ss:=('ГДДДДДДДДДДЕДДДДДДДДЕДДДДДДДДЕДДДДДДДДЕДДДДДДДДЕДДДДДДДДЕДДДДДДДДЕДДДДДДДДґ');
sss:=('АДДДДДДДДДДБДДДДДДДДБДДДДДДДДБДДДДДДДДБДДДДДДДДБДДДДДДДДБДДДДДДДДБДДДДДДДДЩ');
palka:=chr(179);
y:=7;
gotoxy(2,4);
Writeln(s);
gotoxy(2,5);
WriteLn('і ‘ва і „®е®¤ і ќЄбЇ®аві €¬Ї®авіќЄб-в(%)і €¬в/ќЄбіќЄб-в(%)і€¬Ї-в(%)і');
gotoxy(2,6);
Writeln(ss);
seek(f,0);
for i:=1 to nz do
begin
seek(f,dmas^[i]-1);
read(f,zt);
gotoxy(2,y);
WriteLn(palka,zt.name:10,palka,zt.nd:8,palka,zt.de:8,palka,zt.ri:8,palka,
zt.otn1:8:2,palka,zt.otn2:8:2,palka,zt.otn3:8:2,palka,zt.otn4:8:2,palka);
inc(y);
end;
gotoxy(2,y);
writeln(sss);
close(f);
end;
end;
{a-fon, b-fon okna, c-text}
Procedure obramlenie(xn,yn,xk,yk,a,b,c:byte);
var lx,ly:integer;
begin
textbackground(a);
window(xn,yn,xk,yk);
clrscr;textbackground(b);clrscr;
textcolor(c);
lx:=xk-xn;
ly:=yk-yn+1;
{gorizontal'}
for i:=2 to lx-1 do begin
gotoxy(i,1);write(chr(196));end;
for i:=2 to lx-1 do begin
gotoxy(i,ly);write(chr(196));
end;
{ugli}
gotoxy(1,1);write(chr(218));
gotoxy(1,ly);write(chr(192));
gotoxy(lx,1);write(chr(191));
gotoxy(lx,ly);write(chr(217));
{vertikal'}
for i:= 2 to ly-1 do begin
gotoxy(1,i);writeln(chr(179));
end;
for i:=2 to ly-1 do begin
gotoxy(lx,i);writeln(chr(179));
end;
end;
procedure help;
var ft:text;
stext:string;
begin
assign(ft,'help.txt');
reset(ft);
obramlenie(11,3,68,23,0,$3,$f);
window(12,4,67,23);
textcolor(0);
while not eof(ft) do
begin
readln(ft,stext);
writeln(' ',stext);
end;
readkey;
close(ft);
end;
end.
Соседние файлы в папке KURSOV~1