PDA

Zobacz pełną wersję : Proszę o Pomoc



meaner
04-03-08, 19:31
Witam napisałem program do "Księgarnia" ale mam problem w ostatniej procedurze "case". Mógłby mi kto¶ pomóc i je¶li może to poprawić ??


program Ksiazki;

{$APPTYPE CONSOLE}

uses
SysUtils;
Const
LKsiazek=5;
type
Ksiazka=record
Tytul:string[80];
Autor:string[60];
Cena:real;
IleSztuk:integer;
end;
Ksiegozbior=array[1..LKsiazek] of Ksiazka;
var
znak:char;
Ksiazke:Ksiegozbior;
nr:integer;

procedure wczytaj ( Ksiazka:Ksiegozbior);

begin
for nr:=1 to LKsiazek do
begin
write('Podaj tytul: ');readln(Ksiazke[nr].Tytul);
write('Podaj autora: ');readln(Ksiazke[nr].Autor);
write('Podaj cene: ');readln(Ksiazke[nr].Cena);
write('Ile na polce');readln(Ksiazke[nr].IleSztuk);
writeln;
end;
end;
procedure wyswietl ( Ksiazka:Ksiegozbior);
begin
for nr:=1 to LKsiazek do
begin
writeln('Nr ksiazki: ',nr);
writeln('Tytul: ',Ksiazke[nr].Tytul);
writeln('Autor: ',Ksiazke[nr].Autor);
writeln('Cena: ',Ksiazke[nr].Cena:0:2,'zl');
writeln('Ile na polce: ',Ksiazke[nr].IleSztuk);
writeln;
end;
end;
procedure remanent ( Ksiazka:Ksiegozbior);
var
LiczbaWszy:integer;
WartoscWszy:real;
begin
LiczbaWszy:=0;
WartoscWszy:=0;
for nr:=1 to LKsiazek do
Begin
LiczbaWszy:=LiczbaWszy+Ksiazke[nr].IleSztuk;
WartoscWszy:=WartoscWszy+Ksiazke[nr].IleSztuk*Ksiazke[nr].Cena;
end;
writeln('Liczba ksiazek w ofercie: ',LiczbaWszy);
writeln('Wartosc ksiazek w ofercie: ',WartoscWszy:0:2,'zl');
end;
procedure kwgceny (Ksiazka:Ksiegozbior; var buforek:Ksiazka);
var
oddo:integer;
begin
for nr:=1 to LKsiazek-1 do
for oddo:=LKsiazek downto nr+1 do
if Ksiazke[oddo].Cena<Ksiazke[oddo-1].Cena then
begin
buforek:=Ksiazke[oddo];
Ksiazke[oddo]:=Ksiazke[oddo-1];
Ksiazke[oddo-1]:=buforek;
end;
end;
procedure kwgautora (Ksiazka:Ksiegozbior; var buforek:Ksiazka) ;
var
oddo:integer;
begin
for nr:=1 to LKsiazek-1 do
for oddo:=LKsiazek downto nr+1 do
if Ksiazke[oddo].Autor<Ksiazke[oddo-1].Autor then
begin
buforek:=Ksiazke[oddo];
Ksiazke[oddo]:=Ksiazke[oddo-1];
Ksiazke[oddo-1]:=buforek;
end;
end;
procedure swgautora (Ksiazka:Ksiegozbior);
var
x:integer;
begin
for nr:=1 to LKsiazek do
begin
write('Podaj autora: ');readln(Ksiazke[nr].Autor);
x:=pos(Ksiazke[nr].Autor,Ksiazke[nr].Autor);
if x=0 then
writeln('nie podałes autora',Ksiazka[nr].Autor)
else
writeln('wynik wyszukiwania',Ksiazka[nr].Autor);
end;
end;
procedure swgtytulu (Ksiazka:Ksiegozbior);
var
x:integer;
begin
for nr:=1 to LKsiazek do
begin
write('Podaj autora: ');readln(Ksiazke[nr].Tytul);
x:=pos(Ksiazke[nr].Autor,Ksiazke[nr].Tytul);
if x=0 then
writeln('nie podałes autora',Ksiazka[nr].Tytul)
else
writeln('wynik wyszukiwania',Ksiazka[nr].Tytul);
end;
end;
Procedure koniec;
begin
readln
end;
begin
Repeat
writeln('1-Wczytaj ksiazke');
writeln('2-Wyswietl ksiazke');
writeln('3-Remanent');
writeln('4-Szukaj wg.autora');
writeln('5-szukaj wg.tytulu');
writeln('6-Ksiazki wg.ceny');
writeln('7-Ksiazki wg.autora');
writeln('K-Koniec');
readln(znak);
case znak of
'1':wczytaj;
'2':wyswietl;
'3':remanent;
'4':swgautora;
'5':swgtytulu;
'6':kwgceny;
'7':kwgautora;
'K':koniec;
end ;
until upcase(znak)='K';


readln;
end.