Podgląd pojedynczego posta
Stary 29.05.2005, 12:14   #6
sight
Wymiatacz
 
Avatar użytkownika sight
 
Data rejestracji: 01.11.2004
Posty: 569
sight zaczyna zdobywać reputację <1 - 49 pkt>
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
sight jest offline   Odpowiedz cytując ten post