Паскаль / курсовые / Курсовая Pascal Компьютерная фирма / Курсовая

Program Kursovoy;
Uses crt,graph,dos;
Const
norm=$17; {梥⠭Ґўл¤Ґ«Ґ­­®Ј® Їг­Єв }
sel=$6; {梥⠢뤥«Ґ­­®Ј® Їг­Єв  }
k=6;
type
tovar=record
regnom:integer;{ॣЁбва жЁ®­­л© ­®¬Ґа}
name:string;{­ Ё¬Ґ­®ў ­ЁҐ}
haracter:string;{е аҐЄвҐаЁбвЁЄЁ}
data:string; {¤ в  Ё§Ј®в®ў«Ґ­Ёп}
garant:string; {ба®Є Ј а ­вЁЁ}
cenaopt:real; {®Їв®ў п 業 }
cenarozn:real; {१­Ёз­ п 業 }
end;
ps=^dan;
dan=record
tv:tovar;
l:ps;
end;
{-------------а §¤Ґ« ЇҐаҐ¬Ґ­­ле------------------------------}
Var
menu:array[1 .. k] of string[20]; {­ §ў ­Ёп Їг­Єв®ў ¬Ґ­о}
men:array[1 .. 2] of string[10];
punkt:integer; {­®¬Ґа ўҐ¤Ґ«Ґ­­®Ј® Їг­Єв }
dey,mes,god:word;
C,h,ch:char; {ўўҐ¤Ґ­­л© бЁ¬ў®«}
x,y:integer; {Є®®а¤Ё­ вл ЇҐаў®© бва®ЄЁ ¬Ґ­о}
baza:file of tovar; {ЇҐаҐ¬Ґ­­ п д ©«  б Ў §®©}
buf:tovar;
p,top,t,n:ps;
{----------------------Їа®жҐ¤гал--------------------------------}
Procedure Menutoscr; {ўлў®¤ ¬Ґ­о ­  нЄа ­}
var i:integer;
begin
clrscr;
punkt:=1; x:=5; y:=5; textattr:=norm;
window(x*3,y*3,x,y+20);

for i:=1 to k do begin
gotoxy(x,y+i-1);
write ( menu[i] );
end;
{textattr - ЇаҐ¤®ЇаҐ¤Ґ«Ґ­­ п ЇҐаҐ¬Ґ­­ п, ®вўҐз ой п §  梥в д®­  Ё бЁ¬ў®«®ў}
textattr:=sel;
gotoxy(x,y+punkt-1);
write( menu[punkt] ); {ўл¤Ґ«Ё¬ бва®Єг ¬Ґ­о}
textattr:=norm;

end;



Procedure spisok_file(var top:ps); {ᮧ¤ ­ЁҐ бЇЁбЄ  Ё§ д ©« }
begin
rewrite(baza);
t:=top;
while t<>nil do
begin
buf:=t^.tv;
write(baza,buf);
t:=t^.l;
end;
end;

Procedure file_spisok(var top:ps); { Ё§ д ©«  бЇЁбЄ}
begin
if filesize(baza)<>0 then
begin
reset(baza);
top:=nil;
repeat
read(baza,buf);
new(n);
n^.tv:=buf;
t:=top;p:=nil;
while (n^.tv.name>t^.tv.name) And (t<>nil) do
begin
p:=t; {гЄ § вҐм а бв ўЁ¬ ­  гЄ § вҐ«м t}
t:=t^.l; {ЇҐаҐЎЁа Ґ¬ бЇЁб®Є}
end;
if p=nil then begin
n^.l:=top; {б«Ґ¤ ­®ў®Ј® н«Ґ¬Ґ­в  гбв ­ ў«Ёў Ґ¬ ­  ўҐаиЁ­г}
top:=n; {ўҐаиЁ­г гбв ­ ў«Ёў Ґ¬ ­  ­®ўл© н«Ґ¬Ґ­в}
end {§ ­®бЁ¬ н«Ґ¬Ґ­в ў ­ з «® бЇЁбЄ }
else
begin
n^.l:=p^.l; {‘в ўЁ¬ гЄ § вҐ«м ­®ў®Ј® н«Ґ¬Ґ­в  ­  гЄ § вҐ«м ⥪г饣® }
p^.l:=n {гЄ § вҐ«м ⥪г饣® ­  Ё­д з бвм ­®ў®Ј}
end; {§ ­®бЁ¬ н«Ґ¬Ґ­в ў бҐаҐ¤Ё­г бЇЁбЄ }

until eof(baza);
end;
end;

Procedure spisoc(top:ps); {ЇҐз вм бЇЁбЄ  }
var i:integer;
begin
t:=top;
textattr:=112;
clrscr;
writeln(' Џ…ђ…—…Ќњ ’Ћ‚ЂђЋ‚ ЌЂ•Ћ„џ™€•‘џ ЌЂ ‘Љ‹Ђ„…');
{----------ЇҐз вм---------------------------}
textattr:=30;
gotoxy(1,3);
i:=1;
writeln('ЌЂ€Њ…ЌЋ‚ЂЌ€… ’Ћ‚ЂђЂ ','ЉЋ„',' ЋЏ’Ћ‚Ђџ –…ЌЂ ',' •ЂђЂЉ’…ђ€‘’€Љ€ ');
textattr:=112;
while t<>nil do begin
if t^.tv.cenarozn=0 then begin
write(t^.tv.name);
Gotoxy(27,wherey);
write(t^.tv.regnom);
Gotoxy(36,wherey);
write(t^.tv.cenaopt:8:2);
Gotoxy(58,wherey);
writeln(copy(t^.tv.haracter,0,20));
end;
t:=t^.l;
end;
textattr:=norm;
readln;
end;




Procedure priem(var top:ps); {ђ…ѓ€’‘ђЂжЁп ­®ў®Ј® в®ў а }
var
c,i:byte;
begin
textattr:=112;
clrscr;
new(n);
textattr:=30;
writeln;
writeln(' ђ…ѓ€’‘’ђЂ–€џ ЌЋ‚ЋѓЋ ’Ћ‚ЂђЂ ');
textattr:=112;
textattr:=112;
GOTOXY(whereX+19,WHEREY+1);
write('ђ…ѓ€‘’ђЂ–€ЋЌЌ›‰ ЌЋЊ…ђ');
textattr:=112;
GOTOXY(45,whereY);
readln(n^.tv.regnom);
t:=top;
c:=0;
while t<>nil do begin
if t^.tv.regnom=n^.tv.regnom then
begin
c:=1;
clrscr;
textattr:=140;
writeln;
gotoxy(whereX+30,10);
writeln(' Ћ€ЃЉЂ: ');
textattr:=112;
write(' ‚®©¤ЁвҐ ў Їа®жҐ¤гаг § ­®ў® Ё § аҐЈҐбваЁаг©вҐ в®ў а Ї®¤ ¤агЈЁ¬ ­®¬Ґа®¬');
BREAk;
end;
t:=t^.l;
end;
if c=0 then begin
gotoxy(whereX+19,whereY);
write('ЌЂ€Њ…ЌЋ‚ЂЌ€…');
GOTOXY(45,whereY);
readln(n^.tv.name);
if (160<=ord(n^.tv.name[1])) and (ord(n^.tv.name[1])<=175) then begin
i:=ord(n^.tv.name[1])-32;
Delete(n^.tv.name,0,1);
n^.tv.name:=chr(i)+n^.tv.name;
end;
if (224<=ord(n^.tv.name[1])) and (ord(n^.tv.name[1])<=239) then begin
i:=ord(n^.tv.name[1])-80;
Delete(n^.tv.name,0,1);
n^.tv.name:=chr(i)+n^.tv.name;
end;
gotoxy(whereX+19,whereY);
write('–…ЌЂ ЋЏ’Ћ‚Ђџ');
GOTOXY(45,whereY);
readln(n^.tv.cenaopt);
gotoxy(whereX+19,whereY);
write('„Ђ’Ђ €‡ѓЋ’Ћ‚‹…Ќ€џ');
GOTOXY(45,whereY);
readln(n^.tv.data);
gotoxy(whereX+19,whereY);
write('‘ђЋЉ ѓЂђЂЌ’€€');
GOTOXY(45,whereY);
readln(n^.tv.garant);
Textcolor(1);
write('******************************•ЂђЂЉ’…ђ€‘’€Љ€************************************');
write(' ');
write(' ');
write(' ');
write(' ');
write(' ');
write(' ');
write('********************************************************************************');
gotoxy(1,wherey-7);
textcolor(0);
read(n^.tv.haracter);
n^.tv.cenarozn:=0;
n^.l:=nil;
t:=top;p:=nil;
while (n^.tv.name>t^.tv.name) And (t<>nil) do
begin
p:=t; {гЄ § вҐм а бв ўЁ¬ ­  гЄ § вҐ«м t}
t:=t^.l; {ЇҐаҐЎЁа Ґ¬ бЇЁб®Є}
end;
if p=nil then begin
n^.l:=top; {б«Ґ¤ ­®ў®Ј® н«Ґ¬Ґ­в  гбв ­ ў«Ёў Ґ¬ ­  ўҐаиЁ­г}
top:=n; {ўҐаиЁ­г гбв ­ ў«Ёў Ґ¬ ­  ­®ўл© н«Ґ¬Ґ­в}
end {§ ­®бЁ¬ н«Ґ¬Ґ­в ў ­ з «® бЇЁбЄ }
else
begin
n^.l:=p^.l; {‘в ўЁ¬ гЄ § вҐ«м ­®ў®Ј® н«Ґ¬Ґ­в  ­  гЄ § вҐ«м ⥪г饣® }
p^.l:=n {гЄ § вҐ«м ⥪г饣® ­  Ё­д з бвм ­®ў®Ј}
end; {§ ­®бЁ¬ н«Ґ¬Ґ­в ў бҐаҐ¤Ё­г бЇЁбЄ }

end;
readln;
clrscr;
textattr:=norm;
end;

Procedure prodaja(var p,t,top:ps);
var
dd{¤Ґ­м},mm{¬Ґбп},gg{Ј®¤},dn{¤Ґ­м ­Ґ¤Ґ«Ё}:word;
den,mes,god:string[4];
c:char;
name:string;
nom:integer;
i,w,w1,fl:integer;
begin
if top=nil then writeln('Ќ…’ ЃЂ‡›')
else
begin
w:=0;
textattr:=112;
clrscr;
textattr:=30;
writeln;
writeln(' ЏђЋ„Ђ†Ђ TЋ‚ЂђЂ ');
textattr:=112;
gotoxy(whereX+10,whereY);
write(' ‚‚…„€’… ЌЂ€Њ…ЌЋ‚ЂЌ€…');
GOTOXY(50,whereY);
readln(name);
t:=top;fl:=0;
writeln;
while t<>nil do
begin
if (name=t^.tv.name) and (t^.tv.cenarozn=0) then
begin
if fl=0 then
begin
textattr:=30;
write(' ђ…ѓ€‘’ђЂ–€ЋЌЌ›‰ ЌЋЊ…ђ ',' –…ЌЂ „Ђ’Ђ €‡ѓЋ’Ћ‚‹…Ќ€џ ‘ђЋЉ ѓЂђЂЌ’€€ ');
textattr:=112;
writeln;
fl:=1;
end;
Gotoxy(2,wherey); write(t^.tv.regnom);
Gotoxy(25,wherey); write(t^.tv.cenaopt*1.25:8:2);
Gotoxy(43,wherey); write(t^.tv.data);
Gotoxy(68,wherey);
if length(t^.tv.garant)>0 then writeln(t^.tv.garant, ' Њ…‘(Ђ)') else writeln;

writeln('----------------------------------•ЂђAЉ’…ђ€‘’€Љ€--------------------------------');

writeln(t^.tv.haracter);
writeln('--------------------------------------------------------------------------------');
w:=1;
end;
t:=t^.l;
end;
if w=0 then
begin
textattr:=140;
writeln;
gotoxy(whereX+30,10);
textattr:=112;
write('’®ў а ў Ў §Ґ ­Ґ ­ ©¤Ґ­ ў®©¤ЁвҐ ў Їа®жҐ¤гаг § ­®ў®');
end
else
begin
write(' ‚‚…„€’… ђ…ѓ€‘’ђЂ–€ЋЌЌ›‰ ЌЋЊ…ђ');
gotoxy(47,wherey);
readln(nom);
writeln;
writeln;
t:=top;w1:=0;
while t<>nil do
begin
if (nom=t^.tv.regnom) and (t^.tv.cenarozn=0) then
begin
w1:=1;
p:=t;
write(' Esc-Ћв¬Ґ­  Enter-Џа®¤ вм');
c:=readkey;
if c= chr(13) then { ­ ¦ в  Є« ўЁи  <Enter>}
begin
t^.tv.cenarozn:=t^.tv.cenaopt*1.25;
getdate(gg,mm,dd,dn);
str(dd,den);str(mm,mes);str(gg,god);
t^.tv.data:=den+'.'+mes+'.'+god;
end;
break;
end;
t:=t^.l;
end;
if w1=0 then
begin
clrscr;
textattr:=140;
writeln;
gotoxy(whereX+30,10);
writeln(' Ћ€ЃЉЂ: ');
textattr:=112;
end;
end;
end;
if fl=0 then
begin
clrscr;
textattr:=140;
writeln;
gotoxy(whereX+30,10);
writeln(' Ћ€ЃЉЂ: ');
textattr:=112;
READLN;
end;
textattr:=17;
end;

Procedure vozvrat(var top:ps);
var
cC,dd{¤Ґ­м},ME,ms,mm{¬Ґбп},gg{Ј®¤},dn{¤Ґ­м ­Ґ¤Ґ«Ё}:word;
q,M,i:integer;
DATA,d,mes,g:string;
zz,vv:real;
c:char;
t:ps;
begin
textattr:=112;
clrscr;
textattr:=30;
writeln;
writeln(' ‚Ћ‡‚ђЂ’ ’Ћ‚ЂђЂ ');
textattr:=112;
textattr:=112;
GOTOXY(whereX+19,WHEREY+1);
write('ђ…ѓ€‘’ђЂ–€ЋЌЌ›‰ ЌЋЊ…ђ');
textattr:=112;
GOTOXY(45,whereY);
readln(m);
t:=top;
DATA:=t^.tv.data;
D:=''; MES:='';G:='';
q:=1;
while t<>nil do
begin
if (m=t^.tv.regnom) and (t^.tv.cenarozn>0) then begin
i:=1;
while data[i]<>'.'do begin
d:=d+data[i];
i:=i+1;
end;
i:=i+1;
while t^.tv.data[i]<>'.' do begin
mes:=mes+t^.tv.data[i];
i:=i+1;
end;
i:=i+1;
while i<=length(data) do begin
g:=g+t^.tv.data[i];
i:=i+1;
end;

val(D,dey,cc);
val(MES,me,cc);
val(G,god,cc);
val(copy(t^.tv.garant,1,2),ms,cc);
zz:=int(ms/12); vv:=frac(ms/12);
WRITELN;
getdate(gg,mm,dd,dn);
Writeln(' ’…Љ“™Ђџ „Ђ’Ђ ',DD,'.',MM,'.',GG);
WRITELN;
writeln(' „Ђ’Ђ ЏђЋ„Ђ†€ ',d,'.',MES,'.',G);
if (god+zz>=gg) and (me+vv>=mm) then
begin
Writeln ;
Writeln ;

Writeln(' ЏаЁ­пвм ў ў®§ўа в ',t^.tv.name,' ?');
Writeln ;
Writeln ;

write(' Esc-Ћв¬Ґ­  Enter-Џа®¤ вм');
c:=readkey;
q:=0;
if c= chr(13) then t^.tv.cenarozn:=t^.tv.cenarozn*(-1);
end ;



end;

t:=t^.l;
end;
if q=1 then BEGIN
textattr:=140;
writeln;
gotoxy(whereX+30,10);
writeln(' Ћ€ЃЉЂ: ');
textattr:=112;
write(' ’®ў а ў®§ўа вг ­Ґ Ї®¤«Ґ¦Ёв');
readln;

end;
textattr:=norm;
end;


Procedure Analiz(top,t:ps; VAR c:char); {ўлў®¤ ¬Ґ­о ­  нЄа ­}
var
cC,dd{¤Ґ­м},ms,mm{¬Ґбп},gg{Ј®¤},dn{¤Ґ­м ­Ґ¤Ґ«Ё}:word;
b,a:real;
ff,i:integer;

begin
textattr:=112;
clrscr;
writeln;
textattr:=30;
writeln;
writeln(' ЂЌЂ‹€‡ Џђ€Ѓ›‹€ € “Ѓ›’ЉЋ‚ ');
textattr:=112;
textattr:=112;

a:=0;b:=0;
textattr:=112;
getdate(gg,mm,dd,dn);
t:=top;
while t<>nil do begin
val(copy(t^.tv.data,1,2),dey,cc);
val(copy(t^.tv.data,4,2),mes,cc);
val(copy(t^.tv.data,7,4),god,cc);
IF (MM-31>MES) and (gg>=god) AND (t^.tv.CENAROZN>0)and (dd>=dey) THEN A:=A+t^.tv.CENAROZN;
iF (MM-31>MES) and (gg>=god) AND (t^.tv.CENAROZN<0) and (dd>=dey) THEN b:=b+t^.tv.CENAROZN;
t:=t^.l;
end;

textattr:=112;
Men[1]:=' Џђ€Ѓ›‹њ ';
men[2]:=' “Ѓ›’Љ€ ';
gotoxy(20,25); WRITELN('„‹џ ‚›•Ћ„Ђ ЌЂ†Њ€’… "Esc"');
punkt:=1; x:=5; y:=5; textattr:=112;
for i:=1 to 2 do begin
gotoxy(x,y+i-1);
write ( men[i] );
end;
{textattr - ЇаҐ¤®ЇаҐ¤Ґ«Ґ­­ п ЇҐаҐ¬Ґ­­ п, ®вўҐз ой п §  梥в д®­  Ё бЁ¬ў®«®ў}
textattr:=sel;
gotoxy(x,y+punkt-1);
write( men[punkt] );
gotoxy(wherex-1,wherey);
textattr:=112;
FF:=1;
REPEAT
c:=readkey;
if ch<>chr(0) then case c of
chr(80): begin
textattr:=112;
clrscr;
writeln;
textattr:=30;
writeln;
writeln(' ЂЌЂ‹€‡ Џђ€Ѓ›‹€ € “Ѓ›’ЉЋ‚ ');
textattr:=112;
gotoxy(20,25); WRITELN('„‹џ ‚›•Ћ„Ђ ЌЂ†Њ€’… "Esc"');
punkt:=1; x:=5; y:=5;
for i:=1 to 2 do begin
gotoxy(x,y+i-1);
write ( men[i] );
end;
textattr:=sel;
gotoxy(x,y+punkt);
write( men[2] );
gotoxy(wherex-1,wherey);
textattr:=112;
FF:=2;
end;
chr(72):Analiz(top,t,c);
chr(13): BEGIN
IF FF=1 THEN begin
gotoxy(20,10);
WRITELN(' Џђ€Ѓ›‹њ ‡Ђ ЏђЋ…„€‰ Њ…‘џ– ',a:10:2);
end;

IF FF=2 THEN begin
gotoxy(20,10);
WRITELN(' “Ѓ›’Љ€ ‡Ђ ЏђЋ…„€‰ Њ…‘џ– ',abs(b):10:2);
end;
END;
end;

until c=chr(27) ;
textattr:=norm;
End;

{--------------------------------®б­®ў­ п Їа®Ја ¬¬ ----------------------------------}
Begin
assign(baza,'c:\BP\firma.dat'); {Ё­Ё «Ё§ жЁп д ©« }
{$I-}reset(baza);{$I+}
if ioresult<>0 then top:=nil
else file_spisok(top);
Menu[1]:=' ‡Ђђ…ѓ€‘’ђ€ђЋ‚Ђ’њ ';
menu[2]:=' ЏђЋ‘ЊЋ’ђ ';
menu[3]:=' ЏђЋ„Ђ†Ђ ';
menu[4]:=' ‚Ћ‡‚ђЂ’ ';
menu[5]:=' ЂЌЂ‹€‡ ';
menu[6]:=' ЉЋЌ…– ';
punkt:=1; x:=5; y:=5; textattr:=norm;
Menutoscr;
repeat
ch:=ReadKey;
if ch=chr(0) then
begin
ch:=ReadKey;
case ch of
chr(80) : { бв५Є  ў­Ё§ }
if (punkt<k) then begin
gotoxy(x,y+punkt-1);
write(menu[punkt]);
punkt:=punkt+1;
textattr:=sel;
gotoxy(x,y+punkt-1);
write(menu[punkt]);
textattr:= norm;
end;
chr(72) : { бв५Є  ўўҐае }
if (punkt<=k) and (punkt>1) then begin
gotoxy(x,y+punkt-1);
write(menu[punkt]);
punkt:=punkt-1;
textattr:=sel;
gotoxy(x,y+punkt-1);
write(menu[punkt]);
textattr:= norm;
end;
end; {case : of }
end
else
if ch=chr(13) then { ­ ¦ в  Є« ўЁи  <Enter>}
begin
case punkt of
1 : priem(top);
2 : spisoc(top); {д®а¬Ёа㥬 бЇЁб®Є}
3 : prodaja(t,p,top);
4 : Vozvrat(top);
5 : Analiz(top,t,C);
6 : ch:=chr(27) ; {ўл室}
end;
Menutoscr;
End;
until ch= chr(27) ; {27 - Є®¤ <Esc>}
spisok_file(top);
close(baza);
End.