Hej!
Dziwna sprawa. Najpierw tworzę plik typu rekordowego, potem "przelewam" do niego dane ze zmiennej. Problem jest taki, że program jakby nie czytał danych z pliku (a może on ich jednak nie zapisuje?) Tzn kiedy próbuję coś odczytać otrzymuję puste stringi, a zmienne byte równe 0. Czasem program wręcz się wywala...
Nie wiem gdzie może leżeć problem (w końcu całość się kompiluje), więc publikuję cały kod (kopiujta i nawet zarabiajta - ja się tylko uczę ;-)).
Może ktoś będzie wiedział o co chodzi?
Dodam jedynie, że całość jest pisana pod FPC dla Mac OS X, więc trzeba coś pewnie pozmieniać, by odpalić pod Win.
Acha, plik ustawień śmiga bez problemu - wszystko rypie się na plikach z zadaniami...
{
Do zrobienia:
* mozliwosc wylaczenia potwierdzen
* kreator importu/eksportu zestawow (przenies pliki pdz na biurko i kliknij ok)
* sprawdzanie czy dany/aktywny zestaw istnieje
* podczas edycji zadania pytaj czy zastosowac do przyszlych dni
Uwagi:
* 1 dzien to ~2.8KB czyli rok zajmuje ~1MB
}
PROGRAM DoZrobienia;
USES
EmptyPlaceHolderUnit,
SysUtils,
Crt;
{ ====================================== }
TYPE
Tustawienia = record
aktywny : string;
wyswietlajPotwierdzenia : boolean;
end;
Twykonanie = record
ileZrobione, ileDoZrobienia : byte;
opisJednostki : string;
end;
Tzadanie = record
nazwa : string;
wykonanie : array [1..366] of Twykonanie; // dzien roku
end;
Tzestaw = record
liczbaZadan : byte;
zadanie : array [1..10] of Tzadanie; // 10 zadan na zestaw
end;
{ ====================================== }
CONST
sciezka = 'Library/Preferences/DoZrobienia/';
roz = '.pdz';
{ ====================================== }
VAR
menu :array[1..5] of string; //zawiera nazwy kolejnych pozycji w menu glownym
plikUstawien :file of Tustawienia;
Ustawienia :Tustawienia;
plikZestawu :file of Tzestaw;
zestaw :Tzestaw;
{ ====================================== }
{ ====================================== }
{ Wypisuje dany znak okreslona liczbe razy }
PROCEDURE PiszZnak(liczbaznakow:byte ; znaczek:char);
var i:byte;
begin
for i := 1 to liczbaznakow do write(znaczek);
end;
PROCEDURE WriteXY(wspX,wspY:byte ; napis:string);
begin
GoToXY(wspX,wspY);
Write(napis);
end;
PROCEDURE BoldXY(wspX,wspY:byte ; napis:string);
begin
TextColor(15);
WriteXY(wspX,wspY , napis);
TextColor(0);
end;
PROCEDURE RysujRamke;
var i:byte;
begin
ClrScr;
PiszZnak(80,'*');
for i:=1 to 22 do
begin
WriteLn;
write('*'); PiszZnak(78,' '); write('*');
end;
writeln;
PiszZnak(80,'*');
end;
{ ====================================== }
PROCEDURE ZapiszNaDysk(co:string);
Begin
If co = 'Ustawienia' Then
begin
Reset(plikUstawien);
Write(plikUstawien , Ustawienia);
Close(plikUstawien);
end;
If co = 'zestaw' Then
begin
Reset(plikZestawu);
Write(plikZestawu , zestaw);
Close(plikZestawu);
end;
End;
PROCEDURE CzytajZDysku(co:string);
Begin
If co = 'Ustawienia' Then
begin
Reset(plikUstawien);
Read(plikUstawien , Ustawienia);
Close(plikUstawien);
end;
If co = 'zestaw' Then
begin
Reset(plikZestawu);
Write(plikZestawu , zestaw);
Close(plikZestawu);
end;
End;
{ ====================================== }
{ ====== OBSLUGA ZADAN W ZESTAWIE ====== }
{ ====================================== }
PROCEDURE UsunZadanie(ktore:byte);
Begin
End;
PROCEDURE EdytujZadanie(ktore:byte);
Begin
if zestaw.zadanie[ktore].nazwa = '@! dodaj nowe zadanie !@' then
begin
Inc(zestaw.liczbaZadan);
zestaw.zadanie[ktore+1].nazwa := '@! dodaj nowe zadanie !@';
end;
with zestaw.zadanie[ktore] do
begin
RysujRamke;
If nazwa = '@! dodaj nowe zadanie !@' Then
begin
WriteXY(5,5,'Podaj nazwę: ');
ReadLn(nazwa);
WriteXY(5,7,'Podaj opis: ');
ReadLn(wykonanie[1].opisJednostki);
WriteXY(5,9,'Podaj ile razy ma byc wykonane: ');
ReadLn(wykonanie[1].ileDoZrobienia);
end
else
begin
GoToXY(5,5); Write('Stara nazwa to "',nazwa,'". Podaj nową: ');
ReadLn(nazwa);
GoToXY(5,7); Write('Stary opis to "',wykonanie[1].opisJednostki,'". Podaj nowy: ');
ReadLn(wykonanie[1].opisJednostki);
GoToXY(5,9); Write('Wczesniej byly ',wykonanie[1].ileDoZrobienia,' wykonania. Podaj ile teraz: ');
ReadLn(wykonanie[1].ileDoZrobienia);
end;
end;
End; // EdytujZadanie
PROCEDURE WybierzDate;
Begin
End;
PROCEDURE WyswietlWykonanie(ktore:byte);
Begin
If zestaw.zadanie[ktore].nazwa <> '@! dodaj nowe zadanie !@' Then
with zestaw.zadanie[ktore].wykonanie[1] do // tymczasowa data
begin
GoToXY(40,5);
Write(ileZrobione,'/',ileDoZrobienia);
end;
End;
PROCEDURE ZmniejszZrobione(ktore:byte);
Begin
if zestaw.zadanie[ktore].wykonanie[1].ileDoZrobienia > 0 then
begin
Dec(zestaw.zadanie[ktore].wykonanie[1].ileZrobione); // tymczasowa data
WyswietlWykonanie(ktore);
end;
End;
PROCEDURE ZwiekszZrobione(ktore:byte);
Begin
with zestaw.zadanie[ktore].wykonanie[1] do // tymczasowa data
begin
if ileZrobione < ileDoZrobienia then
begin
Inc(ileZrobione);
WyswietlWykonanie(ktore);
end;
end;
End;
PROCEDURE WyswietlZadania(ktore,kolor:byte);
Begin
TextColor(kolor);
If zestaw.zadanie[ktore].nazwa = '@! dodaj nowe zadanie !@' Then
WriteXY(5,5+ktore , '< Dodaj nowe zadanie... >')
Else
WriteXY(5,5+ktore , zestaw.zadanie[ktore].nazwa);
End;
PROCEDURE PZadania;
Var
c1, c2 : char;
p : byte;
Begin
Repeat // (1)
RysujRamke;
WriteXY(2,2,'Zadania do Zrobienia');
for p:=1 to zestaw.liczbaZadan do WyswietlZadania(p,0); // wypisuje wszystkie pozycje menu
p := 1; // ustawi nas na pierwsza pozycje menu
Repeat // (2)
WyswietlZadania(p,15); // podswietla aktualna pozycje menu
c1 := ReadKey; // czekamy na wcisniecie klawisza
c2 := ' ';
If c1=chr(0) Then c2:=ReadKey; // wczytujemy, jesli wcisniety klawisz rozszerzony
WyswietlZadania(p,0);
If c2 = 'H' Then Dec(p); // kursor w gore
If c2 = 'P' Then Inc(p); // kursor w dol
If c2 = 'M' Then ZmniejszZrobione(p); // kursor w lewo
If c2 = 'K' Then ZwiekszZrobione(p); // kursor w prawo
If p = 0 Then p := zestaw.liczbaZadan;
If p = zestaw.liczbaZadan+1 Then p := 1;
Until ( c1 = chr(27) ) or ( c1 = chr(13) ) or ( c1 = chr(8) ); // (2) esc, enter, backspace
TextColor(0);
If c1 = Chr(8) Then UsunZadanie(p); // usuniecie zadania jesli wcisniety BACKSPACE
If c1 = Chr(13) Then EdytujZadanie(p); // edycja zadania jesli wcisniety ENTER
If c1 = ' ' Then WybierzDate; // kalendarz jesli wcisnieta SPACJA
Until c1 = chr(27); // (1) koniec jesli ESC
ZapiszNaDysk('zadania');
End; // PZadania
{ ====================================== }
FUNCTION LiczbaPlikow :byte;
var
i :byte;
znalezionyPlik :TSearchRec;
sciezkaNazwaRozszerzenie :string;
Begin
sciezkaNazwaRozszerzenie := sciezka+'*'+roz;
i := 0;
{ FindFirst i FindNext zwracaja 0 jesli znalazly jakis plik }
If FindFirst(sciezkaNazwaRozszerzenie , faAnyFile , znalezionyPlik) = 0 Then
Repeat
Inc(i);
Until FindNext(znalezionyPlik) <> 0;
FindClose(znalezionyPlik);
LiczbaPlikow := i;
End;
FUNCTION NazwaPliku (ktory:byte) :string;
var
i :byte;
znalezionyPlik :TSearchRec;
sciezkaNazwaRozszerzenie :string;
Begin
sciezkaNazwaRozszerzenie := sciezka+'*'+roz;
{ FindFirst zwraca 0 jesli znalazl jakis plik }
If FindFirst(sciezkaNazwaRozszerzenie , faAnyFile , znalezionyPlik) = 0 Then
For i:=1 to ktory do
if i<>ktory then FindNext(znalezionyPlik);
FindClose(znalezionyPlik);
NazwaPliku := Copy( znalezionyPlik.name,1,length(znalezionyPlik.name)-4 );
End;
PROCEDURE WyswietlListePlikow;
var i :byte;
Begin
RysujRamke;
WriteXY(5,3,'Aktywny plik to');
BoldXY(22,3 , Ustawienia.aktywny);
WriteXY(5,5,'Dostepne pliki to:');
for i:=1 to LiczbaPlikow do
begin
GoToXY(10,5+i);
Write(i , '. ' , NazwaPliku(i));
end;
End;
PROCEDURE UtworzNowyPlikZestawu;
var
nazwa :string;
sciezkaNazwaRozszerzenie :string;
Begin
RysujRamke;
WriteXY(5,5,'Podaj nazwe pliku:');
GoToXY(25,5); Readln(nazwa);
sciezkaNazwaRozszerzenie := sciezka + nazwa + roz;
Assign(plikZestawu, sciezkaNazwaRozszerzenie);
Rewrite(plikZestawu);
Write(plikZestawu , zestaw);
Close(plikZestawu);
zestaw.liczbaZadan := 1;
zestaw.zadanie[1].nazwa := '@! dodaj nowe zadanie !@';
ZapiszNaDysk('zestaw');
End;
PROCEDURE ZaladujPlik;
var
doZaladowania :byte;
Begin
If LiczbaPlikow = 0 then //jesli brak jest plikow to utworz nowy
begin
UtworzNowyplikZestawu;
doZaladowania :=1;
end
Else
begin
WyswietlListePlikow;
WriteXY(5,5, 'Podaj cyfre pliku, ktory ma byc aktywnym:');
GoToXY(48,5);
readln(doZaladowania);
end;
Ustawienia.aktywny := NazwaPliku(doZaladowania);
ZapiszNaDysk('Ustawienia');
End;
PROCEDURE UsunPlik;
var
ktory :byte;
Begin
CzytajZDysku('Ustawienia');
if LiczbaPlikow = 0 then
begin
RysujRamke;
WriteXY(5,5,'Nie ma plikow do usuniecia.');
ReadKey;
end
else
begin
WyswietlListePlikow;
WriteXY(5,5, 'Podaj cyfre pliku do usuniecia:');
GoToXY(37,5);
Readln(ktory);
{ jesli usuwamy Aktywny plik to trzeba go deaktywowac }
if NazwaPliku(ktory) = Ustawienia.aktywny then
begin
Ustawienia.aktywny := '< brak >';
ZapiszNaDysk('Ustawienia');
end;
DeleteFile( sciezka + NazwaPliku(ktory) + roz );
end;
End;
{ ====================================== }
PROCEDURE PlayTheGame;
Begin
If Ustawienia.aktywny = '< brak >' Then ZaladujPlik;
Assign(plikZestawu , sciezka+Ustawienia.aktywny+roz);
CzytajZDysku('zestaw');
PZadania;
End;
{ ====================================== }
PROCEDURE WyswietlZMenu(ktory,kolor:byte);
Begin
TextColor(kolor);
WriteXY(32,8+ktory*2 , menu[ktory]);
End;
PROCEDURE PMenu;
Var
c1,c2 :char;
p :byte;
Begin
CzytajZDysku('Ustawienia');
RysujRamke;
WriteXY(5,3,'Aktywny plik to');
BoldXY(22,3 , Ustawienia.aktywny);
for p:=1 to 5 do WyswietlZMenu(p,0); // wypisuje wszystkie pozycje menu
p:=1; // ustawi nas na pierwsza pozycje menu
Repeat
WyswietlZMenu(p,15); // podswietla aktualna pozycje menu
c1:=ReadKey; // czekamy na wcisniecie klawisza
c2:=' ';
If c1=chr(0) Then c2:=ReadKey; // wczytujemy, jesli wcisniety klawisz rozszerzony
WyswietlZMenu(p,0);
If c2='H' Then Dec(p);
If c2='P' Then Inc(p);
If p=0 Then P:=5;
If P=6 Then P:=1;
If c1=chr(27) Then p:=5; // jesli ESC to exit
Until (c1=chr(27)) or (c1=chr(13)); // koniec wybierania jesli ESC lub ENTER
TextColor(0);
Case p of
1:PlayTheGame;
2:ZaladujPlik;
3:UtworzNowyplikZestawu;
4:UsunPlik;
5:begin ClrScr; Writeln('Dawid Nowak, MacDada[[małpa]]MyApple.pl'); Halt; end;
End;
End;
{ ====================================== }
BEGIN
{ tworzymy teczke z ustawieniami jesli nie istnieje }
If DirectoryExists('Library/Preferences/DoZrobienia') = false
Then Mkdir('Library/Preferences/DoZrobienia');
Assign(plikUstawien, sciezka+'Ustawienia');
{ tworzymy plik ustawien jesli nie istnieje }
{$I-} Reset(plikUstawien); {$I+}
if IOResult=2 then
begin
Close(plikUstawien);
Ustawienia.aktywny := '< brak >';
Rewrite(plikUstawien);
Write(plikUstawien , Ustawienia);
Close(plikUstawien);
end;
menu[1]:='Odpal plik';
menu[2]:='Wczytaj plik';
menu[3]:='Nowy plik';
menu[4]:='Usun plik';
menu[5]:='Koniec';
Repeat PMenu; Until 1=2;
END.