Funkcje są podobne w tworzeniu do procedur z tym, że funkcja zazwyczaj zwraca pewną wartość. Przykładowymi funkcjami są np. pierwiastkowanie, sinus, cosinus
( funkcja nie musi koniecznie zwracać liczby, może to być każdy z typów zmiennych, np. char z ReadKey ).
Składnia: Length(S:string):integer;
Składnia: MkDir(nazwa:string); biblioteka: DOS
Składnia: GetDir(D:byte; var S:string); biblioteka: DOS
Składnia: ChDir(S:string); biblioteka: DOS
Składnia: RmDir(S:string); biblioteka: DOS
Składnia: GetDate(var Rok, Miesiac, Dzien, DzienTygodnia:word); biblioteka: DOS
Składnia: GetTime(var Godzina, Minuta, Sekunda, SetnaSekundy:word); biblioteka: DOS
Zrobimy sobie teraz prostą funkcję, która będzie nam zwracała kod wciśniętego klawisza z tym, że jeżeli to będzie klawisz rozszerzony to kod ten zostanie pomnożony przez 256. Dzięki temu klawisze zwykłe
będą miały zawsze kody poniżej 255 a rozszerzone powyżej.
Uses CRT;
Var
kl:word;
FUNCTION GetKey:word; {1}
Var
a1,a2:Char;
Begin
Repeat Until Keypressed; {2}
a1:=ReadKey; {3}
If a1=Chr(0) Then a2:=ReadKey; {4}
If a1<>Chr(0) Then GetKey:=Ord(a1) Else GetKey:=256*Ord(a2); {5}
End;
Begin
Repeat
kl:=GetKey; {6}
WriteLn(kl); {7}
Until kl=27; {8}
End.
{1} zdefiniuj funkcję GetKey
{2} czekaj na wciśnięcie klawisza
{3} podstaw pod zmienną a1 wciśnięty klawisz
{4} jeżeli to był klawisz rozszerzony to podstaw go pod zmienną a2
{5} jeżeli to nie był klawisz rozszerzony to zwróć w funkcji kod ASCII znaku, w przeciwnym wypadku zwróć w funkcji kod klawisza rozszerzonego pomnożonego przez 256.
{6} pobierz kod klawisza
{7} wyświetl go
{8} powtórz aż zostanie wciśnięty klawisz ESCAPE
Zobacz teraz, na jakiej zasadzie jest zwracana wartość funkcji, a dzieje się to w linii {5}. Do nazwy funkcji jest podstawiana liczba, która mieści się w zakresie typu word.
A musi się w nim mieścić gdyż zadeklarowaliśmy w linii {1}, że właśnie taki typ zwróci nam funkcja. Ot i cała filozofia :)
Funkcja Length
Funkcja zwraca długość zmiennej S np.
Var
s:string;
Begin
s:='Turbo Pascal';
WriteLn('tekst: "',s,'" zawiera ',Length(s),' znakow');
End.
Procedura MkDir
Procedura tworzy w bieżącym katalogu podkatalog "nazwa". Jeżeli już istnieje plik lub katalog "nazwa" to funkcja IOResult zwraca błąd 5 ( zabroniony dostęp do pliku ).
Jeżeli katalog został utworzony bez problemu IOResult=0.
Oto przykładowy program bez sprawdzania poprawności utworzenia katalogu:
Uses DOS;
Begin
MkDir('pascal');
End.
W tym wypadku, kiedy spróbujemy ponownie uruchomić program wyrzuci nam błąd "runtime error 5" ponieważ taki katalog już istnieje, a my nie obsługujemy błędów,
które mogą powstać w czasie operacji dyskowych.
Aby temu zaradzić należy wyłączyć kontrolę błędów przeprowadzaną przez system za pomocą dyrektywy {$i}:
Uses DOS;
Begin
{$i-} {1}
MkDir('pascal'); {2}
If IOResult<>0 Then WriteLn('Wystapil blad'); {3}
{$i+} {4}
End.
{1} Wyłączam obsługę błędów operacji dyskowych za pomocą dyrektywy kompilatora.
{2} Utwórz katalog 'pascal'
{3} Jeżeli wystąpił jakiś błąd (np. katalog już istniał to wyświetl komunikat)
{4} Włącz spowrotem obsługę błędów
Oczywiście linię {3} można pominąć albo przerobić ją tak, aby np. zapisywała wszystkie błędy, które wystąpią do pliku errors.log
Procedura GetDir
Procedura pobiera do zmiennej S, nazwę bieżącego katalogu na dysku określonym zmienną D. Zmienna D przyjmuje wartości:
0 - dysk bieżący
1 - dysk A:
2 - dysk B:
3 - dysk C:
4 - dysk D:
itd.
Uwaga ! Jeżeli nie istnieje dysk określony zmienną D to procedura zwraca wartość jakby to był katalog główny tego dysku.
np.
Uses DOS;
Var
katalog:string;
Begin
GetDir(0,katalog);
WriteLn('Aktualny dysk i katalog : ',katalog);
GetDir(1,katalog);
WriteLn('Aktualny katalog na dysku A : ',katalog);
GetDir(3,katalog);
WriteLn('Aktualny katalog na dysku C : ',katalog);
GetDir(4,katalog);
WriteLn('Aktualny katalog na dysku D : ',katalog);
GetDir(15,katalog);
WriteLn('Aktualny katalog na dysku O : ',katalog);
End.
Procedura ChDir
Procedura zmienia aktualny katalog i/lub dysk na ten, który był podany w parametrze S.
Uwaga ! Jeżeli procedura nie zostanie wykonana prawidłowo (np. brak podanego dysku lub katalogu ) to program zakończy się wyświetlając błąd "runtime error".
Aby temu zaradzić ( podobnie jak w przypadku MkDir ) należy wyłączyć obsługę błędów dyskowych. Jeżeli jednak to zrobimy to nie będziemy pewni, że procedura
wykonała się prawidłowo póki nie sprawdzimy zawartości funkcji IOResult np.
Uses DOS;
Begin
{$i-}
ChDir('pascal'); {1}
If IOResult<>0 Then WriteLn('Wystapil blad przy przejsciu do katalogu pascal');
ChDir('c:\dos'); {2}
If IOResult<>0 Then WriteLn('Wystapil blad przy przejsciu do katalogu c:\dos');
ChDir('c:\windows\pulpit'); {3}
If IOResult<>0 Then WriteLn('Wystapil blad przy przejsciu do katalogu c:\windows\pulpit');
ChDir('a:\'); {4}
If IOResult<>0 Then WriteLn('Wystapil blad przy przejsciu do katalogu a:\');
ChDir('d:'); {5}
If IOResult<>0 Then WriteLn('Wystapil blad przy przejsciu na dysk d:');
{$i+}
End.
{1} przechodzi do katalogu 'pascal' znajdującego się w bieżącym katalogu
{2} zmienia dysk na C ( jeżeli byliśmy na innym dysku ) i przechodzi do katalogu '\dos'
{3} zmienia dysk na C ( jeżeli byliśmy na innym dysku ) i przechodzi do katalogu '\windows\pulpit '
{4} zmienia dysk na A ( jeżeli byliśmy na innym dysku ) i przechodzi do katalogu głównego
{5} zmienia dysk na D ( ale nie zmienia w nim katalogu ! tzn. jeżeli przeniosłeś się najpierw na 'd:\dos' potem na 'c:\windows' a potem spowrotem na 'd:' to wracasz do katalogu,
który był bieżącym w momencie opuszczania tego dysku, czyli 'd:\dos')
Dzięki tej procedurze możemy sprawdzić np. jakie dyski mamy aktualnie dostępne w systemie np.
Uses DOS;
Var
t:byte;
s,stary:string;
Begin
GetDir(0,stary); {1}
{$i-} {2}
For t:=Ord('C') To Ord('Z') Do {3}
Begin
s:=Chr(t); {4}
ChDir(s+':'); {5}
If IOResult=0 Then Write(s,' + ') Else Write(s,' - '); {6}
End;
{$i+} {7}
Chdir(stary); {8}
End.
{1} zapisz w zmiennej "stary" aktualny katalog, aby wrócić do niego po skończeniu sprawdzania dysków
{2} wyłącz sprawdzanie błędów
{3} sprawdzaj wszystkie dyski od C do Z
{4} zamień liczbę na tekst, który będzie nazwą dysku
{5} dodaj do litery dysku znaczek ":" czyli np. 'C'+':'='C:' i przejdź na ten dysk
{6} jeżeli nie wystąpił błąd to wypisz nazwę dysku ze znaczkiem "+" a jeżeli wystąpił wyświetl nazwę dysku ze znaczkiem "-"
{7} włącz obsługę błędów
{8} powróć do katalogu, który był bieżącym w momencie uruchamiania programu
Procedura RmDir
Procedura usuwa katalog o nazwie "S". UWAGA !!! KATALOG KONIECZNIE MUSI BYĆ PUSTY !
Jeżeli procedura nie zostanie wykonana prawidłowo (np. brak podanego katalogu lub nie był on pusty ) to program zakończy się wyświetlając błąd "runtime error".
Aby temu zaradzić ( podobnie jak w przypadku MkDir i ChDir) należy wyłączyć obsługę błędów dyskowych. Jeżeli jednak to zrobimy to nie będziemy pewni, że procedura
wykonała się prawidłowo póki nie sprawdzimy zawartości funkcji IOResult np.
Uses DOS;
Var
blad:integer;
Begin
{$i-} {1}
RmDir('pascal'); {2}
blad:=IOResult; {3}
If blad=0 Then WriteLn('Katalog usunięty') Else {4}
If blad=3 Then WriteLn('Brak katalogu') Else {5}
If blad=5 Then WriteLn('Katalog nie jest pusty') Else {6}
WriteLn('Nieznany blad'); {7}
{$i+} {8}
End.
Zwróć teraz uwagę, że nie pobierałem tutaj za każdym razem informacji z funkcji IOResult tylko wstawiłem ją w zmienną "blad". Zrobiłem to dlatego gdyż
po odczytaniu kodu błędu z funkcji IOResult jest on kasowany i przy powtórnym odczycie uzyskalibyśmy wartość 0.
{1} wyłącz sprawdzanie błędów
{2} skasuj katalog 'pascal'
{3} wstaw do zmiennej "blad" kod błędu
{4} jeżeli nie było błędu to wyświetl tekst 'Katalog usunięty', w przeciwnym wypadku...
 {5} jeżeli wystąpił błąd 3 to wyświetl tekst 'Brak katalogu', w przeciwnym wypadku...
  {6} jeżeli wystąpił błąd 5 to wyświetl tekst 'Katalog nie jest pusty', w przeciwnym wypadku...
   {7} jeżeli wystąpił inny kod błędu ( czyli różny od 0,3 i 5 ) to wyświetl tekst 'Nieznany blad'
{8} włącz sprawdzanie błędów
Procedura GetDate
Procedura pobierająca aktualną datę systemową. Poszczególne zmienne mogą zawierać wartości:
Rok : 1980 - 2099
Miesiac : 1 - 12
Dzien : 1 - 31
DzienTygodnia - 0 - 6 ( 0 = niedziela, 1 = poniedziałek, ... , 6 = sobota )
Tak więc z tego widać, że Pascal jest odporny na problem roku 2000 :)
Przykładowy program:
Uses DOS;
Const
dni:array[0..6] of string=('Niedz','Pon','Wto','Sro','Czw','Pia','Sob'); {1}
Var
rok,mies,dzien,dztyg:word;
Begin
GetDate(rok,mies,dzien,dztyg);
WriteLn('Dzisiejsza Data : ',dni[dztyg],' ',dzien,'-',mies,'-',rok);
End.
Wynik tego programu to np. Dzisiejsza Data : Sob 9-10-1999
{1} Zastosowałem tu jeszcze jedną rzecz, której nie było do tej pory mianowicie tablicę ale STAŁYCH ! Zadeklarowałem po prostu 7 elementów typu string, którym nadałem z góry wiadome niezmienialne wartości.
Reszty chyba tłumaczyć nie trzeba :)
Procedura GetTime
Procedura pobierająca aktualny czas systemowy. np.
Uses DOS;
Var
godz,min,sek,sek100:word;
Begin
GetTime(godz,min,sek,sek100);
WriteLn('Aktualna Godzina : ',godz,':',min,':',sek,':',sek100);
End.
przykładowy wynik tego programu:
Aktualna Godzina : 14:6:1:81
Według mnie to trochę głupio wyglądają te minuty i sekundy takie pojedyncze cyferki, no i te setne możemy sobie podarować. Poprawiony programik wyglądałby mniej więcej tak:
Uses DOS;
Var
godz,min,sek,sek100:word;
sgodz,smin,ssek:string;
Begin
GetTime(godz,min,sek,sek100);
Str(godz,sgodz); {1}
If length(sgodz)=1 Then sgodz:='0'+sgodz; {2}
Str(min,smin); {1}
If length(smin)=1 Then smin:='0'+smin; {2}
Str(sek,ssek); {1}
If length(ssek)=1 Then ssek:='0'+ssek; {2}
WriteLn('Aktualna Godzina : ',sgodz,':',smin,':',ssek);
End.
Teraz wynik programu wygląda tak:
Aktualna Godzina : 14:06:01
Zasada działania jest prosta najpierw zamieniamy zmienną na tekst {1} i jeżeli długość tekstu jest jeden znak to dopisujemy do niego na początek '0' {2}. Na sam koniec wyświetlamy godzinę i gotowe.
Ja bym w tym momencie pokusił się jeszcze o stworzenie własnej funkcji, która będzie zwracać godzinę już uformowaną w tekst.
Uses DOS;
FUNCTION AktualnyCzas:string; {1}
Var
godz,min,sek,sek100:word; {2}
sgodz,smin,ssek,tmps:string; {3}
Begin
GetTime(godz,min,sek,sek100);
Str(godz,sgodz);
If length(sgodz)=1 Then sgodz:='0'+sgodz;
Str(min,smin);
If length(smin)=1 Then smin:='0'+smin;
Str(sek,ssek);
If length(ssek)=1 Then ssek:='0'+ssek;
tmps:=sgodz+':'+smin+':'+ssek; {4}
AktualnyCzas:=tmps; {5}
End;
Begin
WriteLn(AktualnyCzas); {6}
End.
{1} utwórz funkcję AktualnyCzas
{2}{3} zmienne zamiast globalnie można zadeklarować lokalnie wewnątrz funkcji
{4} podstaw pod zmienną tmps aktualny czas
{5} zwróć wynik funkcji
{6} wyświetl zawartość funkcji
A jak jeszcze wrzucisz tą funkcję do naszej biblioteki GIGIKURS to program będzie wyglądać tak:
Uses DOS,GIGIKURS;
Begin
WriteLn(AktualnyCzas);
End.
Prawda, że przejrzyście ? No to doszła nam kolejna funkcja :)
Na tym zakończymy tą lekcję. Na następnej będę kontynuował obsługę DOS'a już niewiele zostało ;-)