argon bulletin board

Експертно търсене  

Новини:

Регистрирането на нови потребители е временно деактивирано.

Автор Тема: спешно задача на паскал !!!  (Прочетена 969 пъти)

ronaldina

  • Неактивен Неактивен
  • Публикации: 22
спешно задача на паскал !!!
« -: 03.04.2009, 18:29:40 »

Имам да пиша задача на паскал,написала сам я горе доло ама не може и не може да тръгне.Някой ако може да помогне да ми пише какво да поправя.
Задачата е следната:
Съставете програма за обслужване на фирма за шампоани:
1.Създаване на начална база от данни за шампоаните,съдуржаща за всеки:име,единична цена,бройки ,обща стойност.
2.Извеждане на справки от вида:
-списък на всички шампоани с въведение данни за тях.
-списък на тези шампоани,чиято единична цена е по-голяма от определената стойност
-списък с имената на шампоаните, а накрая на списъка да се изведе шампоанът с най-ниска цена.
3.Актуализация на данните за един шампоан,включващ обичайните обработки-като допълване,изтриване или променяне на данните за един шампоан.
4.Сортиране на шампоаните по обща стойност:
-низходящ ред.
това е задачката,аз сам написала това:

program fshampoan;
const L=20;
type shampoan=record
ime:string[L];
edcena:real;
broi:string[10];
obstoinost:real;
end;
var fvar:file of shampoan;
n:integer;
procedure pause;
begin
writeln;
write('Natisnete Enter');
readln;
end;
function ExistFile(FileName:string):boolean;
var FileVar:file;
begin
assing(FileVar,FileName);
reset(FileVar);
if ioresult=0 then
begin
ExistFile=True;
Close(FileVar);
end else ExistFile:=False;
end;
procedure add;
var sh:shampoan;
begin
if existfile('shampoan.dta')then
begin reset(fvar);n:=filesize(fvar);seel(fvar,n);end else
begin rewrite(fvar);n:=0;end;
repeat
n:=n+1;
write('Ime:');readln(sh.ime);
if sh.ime=''then begin n:=n-1;close(fvar);exit end;
write('EdCena:');readln(sh.edcena);
write('Broi:');readln(sh.broi);
write('Obstastoinos:');readln(sh.obstoinost);
write(fvar,sh);
until false;
end;
procedure spr_A;
var sh:shampoan;i:integer;
begin
writeln('ime',' ':L-2,'edcena','   broi','  obstoinost');
reset(fvar);i:=0;
while not eof(fvar) do
begin
read(fvar,sh);i:=i+1;
with sh do writeln(i,'.',ime,' ':L-lenght(ime),edcena:5,' ',broi:5:2,' ',obstoinost:5:2);
end;
close(fvar);
pause;
end;
procedure spr_B;
var min:real;
sh:shampoan;
begin
write('Vavedete minimalna cena:');readln(min);
writeln('ime',' ':L-3,'edcena','  broi','  obstoinost');
reset(fvar);
while not eof(fvar) do
begin
read(fvar,sh);
with sh do if edcena>min then
writeln(ime,' ':L-lenght(ime),edcena:5,' ',broi:5:2,' ',obstoinost:5:2);
end;
close(fvar);
pause;
end;
procedure spr_C;
var ime:string[30];
begin
reset(fvar);
writeln('Danni za shampoan s nai-niska cena:');
write('Vavedete cena:');readln(ime);
while not eof(fvar) do
begin
read(fvar,sh);
if sh.ime=shampoan then
begin
writeln('ime:',sh.ime);
end;
end;
close(fvar);
pause;
end;
procedure change;
var sh:shampoan;nomer:integer;
begin
writeln('Vavedi nomer');readln(nomer);
reset(fvar);
seek(fvar,nomer-1);
read(fvar,sh);
writeln('vavedi nova edcena');
readln(sh.shampoan);
seek(fvar,filepos(fvar)-1);
write(fvar,sh);
close(fvar);
end;
procedure delete;
var i,j:integer;nomer:integer;
sh:shampoan;
begin
writeln('vavedi nomer');readln(nomer);
reser(fvar);
i:=nomer;
for j:=i to n-1  do
begin seek(fvar,j);read(fvar,sh);
seek(fvar,j-1);write(fvar,sh);
end;
n:=n-1;
seek(fvar,n);
truncate(fvar);
writeln('Zapisat e iztrit:');
pause;
close(fvar);
end;
procedure sort_1(var sh:shampoan;i:ime);
var i,j,ind:byte;
max:shampoan;
begin
for i:=1 to shampoan-1 do
begin
max:=sh;ind:=i;
for j:=i+1 to shampoan do
if max.ime<sh[j].ime then
begin
max:=sh[j];ind:=j;
end;
sh[ind]:=sh;
sh:=max;
end;
end;
procedure menu;
var nch:byte;
begin
repeat
writeln('   <0>Izhod');
writeln('   <1>Dobavqne na danni za shampoani');
writeln('   <2>Iztrivane na danni za shampoani');
writeln('   <3>Promqna na danni za shampoani');
writeln('   <4>Spravka1');
writeln('   <5>Spravka2');
writeln('   <6>Spravka3');
writeln('   <7>Sortirovka v nizhodqst red');
repeat
write('  Izberete:');
readln(nch)
until nch in [0..7]
case nch of
1:add;
2:delete;
3:change;
4:spr_A;
5:spr_B;
6:spr_C;
7:sort_1;
end;
until nch=0;
end;
begin
assign(fvar,'shampoan.dta');
if existfile('shampoan.dta') then
begin reset(fvar);n:=filesize(fvar);close(fvar);
end else n:=0;
menu;
end.
« Последна редакция: 03.04.2009, 20:53:53 от Kelli_Mutu™ »
Активен
""Believe in your dreams, but above all believe in yourself.""