Witam
Piszę w Lazarusie i mam problem z przeistoczeniem daty wypożyczenia książki w programie Biblioteka tak, żeby data podawana przez człowieka była akceptowalna przez program.
oto kod programu:
//PROGRAM GŁÓWNY:
program biblioteka;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, ProcUnit
{ you can add units after this };
var
opcja1, opcja2: integer;
wybor1, wybor2: boolean;
begin
// menu programu
repeat
writeln(PL('Wybierz opcję:'));
writeln(PL(' 1: wypisanie książek z bazy'));
writeln(PL(' 2: dopisanie nowej książki'));
writeln(PL(' 3: usuinięcie książki'));
writeln(PL(' 4: zmiana danych książki'));
writeln(PL(' 5: wypożyczenie ksiazki'));
writeln(PL(' 6: zwrot książki'));
writeln(PL(' 9: zarządzanie osobami'));
writeln(PL(' 0: wyjście z programu'));
wybor1:=False;
repeat
try
write(PL('Twoj wybór: '));
readln(opcja1);
wybor1:=True;
except
writeln(PL('**niepoprawny parametr!'));
end;
until wybor1=True;
case opcja1 of
1: begin
writeln('WypiszKsiazki');
WypiszKsiazki();
end;
2: begin
writeln('DodajKsiazke');
DodajKsiazke();
end;
3: begin
writeln('UsunKsiazke');
UsunKsiazke();
end;
4: begin
writeln('ZmienKsiazke');
ZmienKsiazke();
end;
5: begin
writeln('WypozyczKsiazke');
WypozyczKsiazke(True);
end;
6: begin
writeln('ZwrotKsiazki');
WypozyczKsiazke(False);
end;
9: begin
// menu programu
repeat
writeln(PL(' Wybierz opcję:'));
writeln(PL(' 1: wypisanie osób z bazy'));
writeln(PL(' 2: dopisanie nowej osoby'));
writeln(PL(' 3: usuinięcie osoby'));
writeln(PL(' 4: zmiana danych osoby'));
writeln(PL(' 0: powrót do menu głównego'));
wybor2:=False;
repeat
try
write(PL('Twoj wybór: '));
readln(opcja2);
wybor2:=True;
except
writeln(PL('**niepoprawny parametr!'));
end;
until wybor2=True;
case opcja2 of
1: begin
writeln('WypiszOsoby');
WypiszOsoby();
end;
2: begin
writeln('DodajOsobe');
DodajOsobe();
end;
3: begin
writeln('UsunOsobe');
UsunOsobe();
end;
4: begin
writeln('ZmienOsobe');
ZmienOsobe();
end;
else
writeln(PL('**funkcja niezdefiniowana!'));
end;
until opcja2=0;
end;
0: writeln(PL('Do widzenia :)'));
else
writeln(PL('**funkcja niezdefiniowana!'));
end;
until opcja1=0;
readln();
end.
//FUNKCJE I PROCEDURY W MODULE:
unit ProcUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LazUTF8;
const
bazaOsob = 'osoby.dat';
bazaKsiazek = 'ksiazki.dat';
type
TAdres = record
miasto: String[80];
kod: String[6];
ulica: String[80];
nr: String[10];
end;
TOsoba = record
nr: integer;
imie: String[80];
nazwisko: String[80];
adres: TAdres;
end;
TKsiazka = record
tytul: String[160];
autor: String[120];
rok: integer;
case wypozyczona: boolean of
True: (
dataWyp: TDateTime;
osoba: TOsoba;
);
False: ();
end;
function PL(tekst: String): String;
function WypiszOsoby(): integer;
procedure DodajOsobe();
function WypiszKsiazki(): integer;
procedure DodajKsiazke();
procedure ZmienOsobe();
procedure UsunOsobe();
procedure UsunKsiazke();
procedure ZmienKsiazke();
procedure WypozyczKsiazke(wypozyczona:boolean);
implementation
function PL(tekst: String): String;
begin
result:=UTF8ToConsole(tekst);
end;
function WypiszOsoby(): integer;
var
osoba: TOsoba;
licz: integer;
plik: file of TOSoba;
begin
licz:=0;
if FileExists(bazaOsob) then
begin
assign(plik,bazaOsob);
reset(plik);
while not EoF(plik) do
begin
read(plik,osoba);
writeln(licz:4,' : (',format('%.4d',[osoba.nr]),') ',osoba.imie,' ',osoba.nazwisko);
writeln(' ',osoba.adres.ulica,' ',osoba.adres.nr,', ',
osoba.adres.kod,' ',osoba.adres.miasto);
inc(licz);
end;
close(plik);
end
else
writeln(PL('Nie ma pliku z bazą osób!'));
result:=licz;
end;
procedure DodajOsobe();
var
osoba: TOsoba;
plik: file of TOsoba;
recCount: integer;
begin
writeln(PL('Podaj dane osoby:'));
write(PL('Podaj numer karty: ')); readln(osoba.nr);
write(PL('Podaj imię: ')); readln(osoba.imie);
write(PL('Podaj nazwisko: ')); readln(osoba.nazwisko);
write(PL('Podaj ulicę: ')); readln(osoba.adres.ulica);
write(PL('Podaj numer domu: ')); readln(osoba.adres.nr);
write(PL('Podaj kod pocztowy: ')); readln(osoba.adres.kod);
write(PL('Podaj miasto: ')); readln(osoba.adres.miasto);
assign(plik,bazaOsob);
if FileExists(bazaOsob) then
begin
FileMode:=2; // R/W
reset(plik);
recCount:=FileSize(plik);
seek(plik,recCount);
end
else
rewrite(plik);
write(plik,osoba);
close(plik);
end;
function WypiszKsiazki(): integer;
var
ksiazka: TKsiazka;
licz: integer;
plik: file of TKsiazka;
begin
licz:=0;
if FileExists(bazaKsiazek) then
begin
assign(plik,bazaKsiazek);
reset(plik);
while not EoF(plik) do
begin
read(plik,ksiazka);
writeln(licz:4,' : ', ksiazka.autor,' "',ksiazka.tytul,' [',
ksiazka.rok,']');
if ksiazka.wypozyczona then
writeln(' wypozyczona dnia: ',DateToStr(ksiazka.dataWyp),
' przez (',format('%.4d',[ksiazka.osoba.nr]),') ',
ksiazka.osoba.imie,' ',ksiazka.osoba.nazwisko);
inc(licz);
end;
close(plik);
end
else
writeln(PL('Nie ma pliku z bazą książek!'));
result:=licz;
end;
procedure DodajKsiazke();
var
ksiazka: TKsiazka;
plik: file of TKsiazka;
recCount: integer;
begin
writeln(PL('Podaj dane książki:'));
write(PL('Podaj autora: ')); readln(ksiazka.autor);
write(PL('Podaj tytuł: ')); readln(ksiazka.tytul);
write(PL('Podaj rok wydania: ')); readln(ksiazka.rok);
ksiazka.wypozyczona:=False;
assign(plik,bazaKsiazek);
if FileExists(bazaKsiazek) then
begin
FileMode:=2; // R/W
reset(plik);
recCount:=FileSize(plik);
seek(plik,recCount);
end
else
rewrite(plik);
write(plik,ksiazka);
close(plik);
end;
procedure ZmienOsobe();
var
nrOsoby, liczbaOsob: integer;
plik: file of TOsoba;
osoba: TOsoba;
begin
writeln(PL('Wybierz osobę do zmiany danych:'));
liczbaOsob:=WypiszOsoby();
if (liczbaOsob>0) then
begin
repeat
writeln('Podaj numer osoby: '); readln(nrOsoby);
until (nrOsoby>=0) and (nrOsoby<liczbaOsob);
assign(plik,bazaOsob);
FileMode:=2;
reset(plik);
seek(plik,nrOsoby);
read(plik,osoba);
writeln(PL('Podaj dane osoby:'));
write(PL('Podaj numer karty: ')); readln(osoba.nr);
write(PL('Podaj imię ['),osoba.imie,']: '); readln(osoba.imie);
write(PL('Podaj nazwisko ['),osoba.nazwisko,']: '); readln(osoba.nazwisko);
write(PL('Podaj ulicę: ')); readln(osoba.adres.ulica);
write(PL('Podaj numer domu: ')); readln(osoba.adres.nr);
write(PL('Podaj kod pocztowy: ')); readln(osoba.adres.kod);
write(PL('Podaj miasto: ')); readln(osoba.adres.miasto);
seek(plik,nrOsoby);
write(plik,osoba);
close(plik);
end;
end;
procedure UsunOsobe();
var
nrOsoby, liczbaOsob, recCount, i: integer;
plik: file of TOsoba;
tablicaOsob: array of TOsoba;
begin
writeln(PL('Wybierz osobę do usunięcia:'));
liczbaOsob:=WypiszOsoby();
if (liczbaOsob>0) then
begin
repeat
writeln('Podaj numer osoby: '); readln(nrOsoby);
until (nrOsoby>=0) and (nrOsoby<liczbaOsob);
assign(plik,bazaOsob);
FileMode:=2;
reset(plik);
recCount:=FileSize(plik);
SetLength(tablicaOsob,recCount);
for i:=0 to recCount-1 do
read(plik,tablicaOsob[i]);
close(plik);
for i:=nrOsoby to recCount-2 do
tablicaOsob[i]:=tablicaOsob[i+1];
SetLength(tablicaOsob,recCount-1);
rewrite(plik);
for i:=0 to Length(tablicaOsob)-1 do
write(plik,tablicaOsob[i]);
close(plik);
end;
end;
procedure UsunKsiazke();
var
nrKsiazki, liczbaKsiazek, recCount, i: integer;
plik: file of TKsiazka;
tablicaKsiazek: array of TKsiazka;
begin
writeln(PL('Wybierz książkę do usunięcia:'));
liczbaKsiazek:=WypiszKsiazki();
if (liczbaKsiazek>0) then
begin
repeat
writeln('Podaj numer ksiazki: '); readln(nrKsiazki);
until (nrKsiazki>=0) and (nrKsiazki<liczbaKsiazek);
assign(plik,bazaKsiazek);
FileMode:=2;
reset(plik);
recCount:=FileSize(plik);
SetLength(tablicaKsiazek,recCount);
for i:=0 to recCount-1 do
read(plik,tablicaKsiazek[i]);
close(plik);
for i:=nrKsiazki to recCount-2 do
tablicaKsiazek[i]:=tablicaKsiazek[i+1];
SetLength(tablicaKsiazek,recCount-1);
rewrite(plik);
for i:=0 to Length(tablicaKsiazek)-1 do
write(plik,tablicaKsiazek[i]);
close(plik);
end;
end;
procedure ZmienKsiazke();
var
nrKsiazki, liczbaKsiazek: integer;
plik: file of TKsiazka;
ksiazka: TKsiazka;
begin
writeln(PL('Wybierz książkę do zmiany danych:'));
liczbaKsiazek:=WypiszKsiazki();
if (liczbaKsiazek>0) then
begin
repeat
writeln(PL('Podaj numer książki: ')); readln(nrKsiazki);
until (nrKsiazki>=0) and (nrKsiazki<liczbaKsiazek);
assign(plik,bazaKsiazek);
FileMode:=2;
reset(plik);
seek(plik,nrKsiazki);
read(plik,ksiazka);
writeln(PL('Podaj dane książki:'));
write(PL('Podaj autora: ')); readln(ksiazka.autor);
write(PL('Podaj tytuł: ')); readln(ksiazka.tytul);
write(PL('Podaj rok wydania: ')); readln(ksiazka.rok);
seek(plik,nrKsiazki);
write(plik,ksiazka);
close(plik);
end;
end;
procedure WypozyczKsiazke(wypozyczona:boolean);
var
nrKsiazki, liczbaKsiazek,liczbaOsob,nrOsoby: integer;
plik: file of TKsiazka;
ksiazka: TKsiazka;
begin
case wypozyczona of
True:
begin
writeln(PL('Wybierz książkę, którą wypożyczamy: '));
liczbaKsiazek:=WypiszKsiazki();
if (liczbaKsiazek>0) then
begin
repeat
writeln(PL('Podaj numer książki: ')); readln(nrKsiazki);
until (nrKsiazki>=0) and (nrKsiazki<liczbaKsiazek);
assign(plik,bazaKsiazek);
FileMode:=2;
reset(plik);
seek(plik,nrKsiazki);
read(plik,ksiazka);
writeln(PL('Podaj datę wypożyczenia książki:')); readln(ksiazka.dataWyp);
liczbaOsob:=WypiszOsoby();
repeat
writeln(PL('Podaj numer osoby, która wypożycza: ')); readln(nrOsoby);
until (nrOsoby>=0) and (nrOsoby<liczbaOsob);
//dataWyp: TDateTime;
//osoba: TOsoba;
end;
end;
False:
//begin
end;
end;
end.
Proszę o pomoc w ostatniej Procedurze, WypozyczKsiazke
, którą piszę , bo niby mam koncepcję ale nie wiem czy zadziała.