|
no dobra napisałem ta baze danych ale nie startuje
(wywale mu bład przy "procedura menu")
program baza;
uses crt, dos;
type ksiazka=record
nazwa:string[12];
autor:string;
rok:real;
wydanie:real;
cena:real;
end;
beer=array[1..100] of ksiazka;
var
fnazwa : string;
procedure wprowrec(var tab : beer; var n : byte);
var
z : char;
begin
repeat
inc(n); {licznik}
writeln('ksiazka nr: ',n);
with tab[n] do begin
writeln('nazwe ksiazki :');
readln(nazwa);
textcolor(red+128);
writeln('podaj autor :');
readln(autor);
textcolor(15);
writeln('podaj rok :');
readln(rok);
writeln('podaj wydani :');
readln(wydanie);
writeln('Podaj cene');
readln(cena);
end;
writeln('Czy wpisywac dalej T/N');
z:=readkey;
until UpCase(z)<>'T';
end;
procedure menu;
begin
writeln('1 - Otworz/Nowy plik');
writeln('2 - Zapisz dane');
writeln('3 - Wpisywanie danych');
writeln('4 - Sortowanie ');
writeln('5 - Koniec');
end;
procedure NowyPlik(var tab : beer; var n : byte);
var
f : file;
info : searchrec;
begin
clrscr;
write('Podaj nazwe istniejacego pliku lub nowa: ');
readln(fnazwa);
Assign(f, fnazwa);
FindFirst(fnazwa, anyfile, info);
if doserror=0 then
begin
Reset(f, 1);
BlockRead(f, n, 1);
BlockRead(f, tab, sizeof(tab));
writeln('Wczytalem ', n, ' rekordow.');
end else
begin
Rewrite(f, 1);
writeln('Utworzylem nowy plik');
n:=0;
end;
ReadKey;
Close(f);
end;
procedure ZapiszPlik(var tab : beer; var n : byte);
var
f : file;
ss : string;
begin
clrscr;
ss:=fnazwa;
write('Podaj nazwe pliku (aktualny=', fnazwa, ') : ');
ReadLn(fnazwa);
if fnazwa='' then fnazwa:=ss;
Assign(f, fnazwa);
Rewrite(f, 1);
BlockWrite(f, n, 1);
BlockWrite(f, tab, sizeof(tab));
writeln('Zapisalem plik pod nazwa: ', fnazwa, '.');
writeln('Zawiera ', n, ' rekordow.');
ReadKey;
Close(f);
end;
procedure Sortowanie(var tab : beer; var n : byte);
var
i, j : byte;
bufor : ksiazka;
begin
for i:=1 to n-1 do
for j:=1 to n-i do
if tab[j].autor>tab[j+1].autor then
begin
bufor:=tab[j];
tab[j]:=tab[j+1];
tab[j+1]:=bufor;
end;
end;
procedure Main;
var
n, i : byte;
tab : beer;
q : char;
begin
n:=0;
repeat;
clrscr;
menu;
writeln('Wybierz opcje:');
readln(q);
case q of
'1' : NowyPlik(tab, n);
'2' : ZapiszPlik(tab, n);
'3' : WprowRec(tab, n);
'4' : Sortowanie(tab, n);
end;
until q='5';
end;
begin
fnazwa:='';
Main
end.
__________________
Ostatnio zmieniany przez sight : 30.05.2005 o godz. 08:04
|