Elementy programowania w Turbo Pascalu

Opracowane na podstawie: T. Sadowski, Praktyczny kurs Turbo Pascala, Helion, Gliwice 1996

 

Prosty program

 

Program Napis;

 

begin

  writeln('Napis');

  write(' drugi napis');

end.

 

Za realizację działań odpowiedzialne są operatory.

 

Operatory arytmetyczne:

 

Operator

Operacja

typ argumentu

typ wyniku

+

dodawanie (dwuargumentowe)

całkowity

rzeczywisty

całkowity

rzeczywisty

-

odejmowanie (dwuargumentowe)

całkowity

rzeczywisty

całkowity

rzeczywisty

-

znak minus (jednoargumentowy)

całkowity

rzeczywisty

całkowity

rzeczywisty

*

mnożenie

całkowity

rzeczywisty

całkowity

rzeczywisty

/

dzielenie

całkowity

rzeczywisty

całkowity

rzeczywisty

div

dzielenie całkowite

całkowity

całkowity

mod

reszta z dzielenia (tzw. operator modulo)

całkowity

całkowity

 

Operatory relacyjne

 

=

równy

<>

różny

<

mniejszy

>

większy

<=

mniejszy równy

>=

większy równy

 

Wzór:

należy zapisać jako:

1/(2*3)   co da 0.16666

 

nie należy pisać 1/2*3 bo to daje 1.5

 

Naukowy zapis liczby:

 

1.99e3

 

(wykładnik powinien być liczbą całkowitą)

 

Typy zmiennych

 

Typy proste

-     Typy porządkowe

-     Typ wyliczeniowy

-     Typy całkowite

-     Typy logiczne

-     Typ znakowy

-     Typy okrojone

-     Typy rzeczywiste

Typy łańcuchowe

Typy strukturalne

-     Typy tablicowe

-     Typ rekordowy

-     Typ zbiorowy

-     Typ plikowy

Typy wskaźnikowe

Typy proceduralne

Typ obiektowy

 

Deklaracja zmiennych

 

program mnożenie;

 

var

a, b : real;

 

begin

readln(a);

readln(b);

writeln(a*b);

end.

 

Zmienną należy zadeklarować a następnie nadać jej wartość.

 

Do najczęściej stosowanych typów prostych należą:

 

integer

liczba całkowita za znakiem

real

liczba rzeczywista

char

pojedynczy znak kodu ASCII

Boolean

wartość logiczna: prawda lub fałsz (true, false)

 

Operatory logiczne:

 

not

negacja logiczna

and

iloczyn logiczny (daje true gdy wszystkie argumenty maja wartość true)

or

suma logiczna (true gdy co najmniej jeden argument ma wartość true)

xor

suma modulo 2, (daje true, gdy nieparzysta liczna argumentów ma wartość true)

 

program Mnozenie2;

 

var

  Liczba1, Liczba2 : real;

 

begin

  write('Podaj pierwsza liczbe: ');

  readln(Liczba1);

  write('Podaj druga liczbe: ');

  readln(Liczba2);

  writeln('Iloczyn podanych liczb wynosi',

              Liczba1*Liczba2);

  readln

end.

 

Formaty:

 

: szerokość pola : liczba miejsc dziesiętnych

 

program Formaty;

 

begin

  writeln(123456:12);

  writeln(123456:4);  

  writeln(1e-3:12:6);  

  writeln(1e-3:12);     

  writeln(12345e-6:6:2);

  writeln(123456e+6:6:2);

  writeln('a':24);  

  writeln('To jest napis':16) 

end.

 

Nazwa

Zakres

Długość

Liczba całkowita ...

integer

-32768..32768

2 bajty

ze znakiem

shortint

-128..127

1 bajt

krótka ze znakiem

longint

-2147483648..2147483647

4 bajty

długa ze znakiem

byte

0..255

1 bajt

krótka bez znaku (bajt)

word

0..65535

2 bajty

bez znaku (słowo)

 

Nazwa

Zakres

Długość

Dokładność (cyfr)

real

2.9e-39..1.7e38

6 bajtów

11..12

single

1.5e-45..4.0e38

4 bajty

7..8

double

5.0e-324..1.7e308

8 bajtów

15..16

extended

3.4e-4932..1.1e4932

10 bajtów

19..20

comp

-9.2e18..9.2e18

8 bajtów

19..20

 

Funkcje warunkowe.

 

if  warunek  then  instrukcja  else  instrukcja

 

 

program Dzielenie;

 

var

  Dzielna, Dzielnik : real;

 

begin

  write('Podaj dzielna: ');

  readln(Dzielna);

  write('Podaj dzielnik: ');

  readln(Dzielnik);

  if Dzielnik = 0 then

    writeln('Nie lubie dzielic przez zero !')

  else

    begin

      write('Iloraz podanych liczb wynosi ');

      writeln(Dzielna/Dzielnik)

    end

end.

 

case przełącznik of

wartość_1 : instrukcja_1 ;

...

wartość_n : instrukcja_n ;

else instrukcja

end;

 

przełącznik - dowolne wyrażenie typu porządkowego (np.: char lub integer)

 

Nadawanie wartości odbywa się z wykorzystaniem symbolu :=

Po lewej stronie operatora := nie może znajdować się stała ani wyrażenie. powinna być zachowana zgodność typów.

 

program Kalkulator;

 

var

  Liczba1, Liczba2, Wynik : real;

  Dzialanie : char;

  Blad : Boolean;

 

begin

  write('Podaj pierwsza liczbe: ');

  readln(Liczba1); 

  write('Podaj druga liczbe: ');

  readln(Liczba2);

  write('Rodzaj dzialania (+ - * /): ');

  readln(Dzialanie);

  Blad:=false;

  case Dzialanie of

    '+' : Wynik:=Liczba1+Liczba2;

    '-' : Wynik:=Liczba1-Liczba2;

    '*' : Wynik:=Liczba1*Liczba2;

    '/' : if Liczba2 <> 0 then 

            Wynik:=Liczba1/Liczba2

         else Blad:=true;

  else

      Blad:=true

  end;

  if not Blad then

    writeln(Liczba1,' ',Dzialanie,Liczba2,' = ',Wynik)

  else

    writeln('Blad argumentu lub operatora.');

  readln

end.

 

Instrukcje pętli.

 

while warunek {dopóki spełniony}

do instrukcja

 

warunek sprawdzany na początku pętli.

 

repeat instrukcja      {powtarzaj instrukcję}

until warunek          {dopóki warunek nie spełniony}

 

warunek sprawdzany na końcu

 

Dwa przykłady:

 

program DzielenieWKolko_While;

{ wersja while-do }

 

var

  Dzielna,Dzielnik : real;

 

begin

while Dzielna < 1e37 do

begin

      write('Podaj dzielna: ');

      readln(Dzielna);

      write('Podaj dzielnik: ');

      readln(Dzielnik);

      if Dzielnik = 0 then

        writeln('Nie lubie dzielic przez zero !')

      else

        begin

          write('Iloraz podanych liczb wynosi ');

          writeln(Dzielna/Dzielnik)

end

end

end.

 

program DzielenieWKolko_Repeat;

{ wersja repeat-until}

 

var

  Dzielna,Dzielnik : real;

 

begin

  repeat

    write('Podaj dzielna: '); 

    readln(Dzielna);

    write('Podaj dzielnik: ');

    readln(Dzielnik);

    if Dzielnik = 0 then

      writeln('Nie lubię dzielić przez zero !')

    else

      begin

        write('Iloraz podanych liczb wynosi ');

        writeln(Dzielna/Dzielnik)

      end

  until Dzielna > 1e37

end.

 

Instrukcja pętli for

 

for licznik:=wartość_poczatkowa to wartość_końcowa do instrukcja

for licznik:=wartość_poczatkowa downto wartość_końcowa do instrukcja

 

program Petelka;

 

var

  i : integer;

 

begin

  for i:=1 to 10 do

    write(i:3)

end.

 

Obliczamy wartość średnią:

 

 

program ObliczanieSredniej;

{ oblicza srednia arytmetyczna wpisanych liczb }

 

var

  Licznik : integer;

  Suma    : real;   

  Srednia : real;   

  Liczba  : real;   

 

begin

  Licznik := 0;

  Suma := 0.0;

  repeat

    write('Podaj liczbe (1E+38 - koniec): ');

    readln(Liczba);

    if Liczba < 1e37 then

      begin

        Licznik:=Licznik+1;

        Suma:=Suma+Liczba

      end

  until Liczba > 1e37;

  if Licznik > 0 then 

    begin      

      Srednia := Suma/Licznik;

      writeln('Wpisales ',licznik,' liczb');

      writeln('Ich średnia wynosi ',Srednia:12:6);

    end;

  readln

end.

 

Tablice.

 

var

liczby : array[1..1000] of real;

 

lub

 

var

liczby : array[1..1000, 1..200] of real;

 

Pamięć zajęta przez wszystkie zmienne nie może przekraczać 65520 bajtów (można to ominąć z zastosowaniem zmiennych dynamicznych).

 

Wariancję (populacji) oblicza się według wzoru:

 

 

program Srednia_i_Wariancja;

{ obliczanie sredniej arytmetycznej i wariancji }

 

var

  Licznik   : integer;

  Suma      : real;

  Srednia   : real;

  Wariancja : real;

  Dane      : array[1..1000] of real;

  Liczba    : real;

  IleLiczb  : integer;

 

begin

  Licznik:=0;

  Suma:=0.0;

  repeat

    write('Podaj liczbe (1E+38 - koniec): ');

    readln(Liczba);

    if Liczba < 1e37 then

      begin

        Inc(Licznik);

        Dane[Licznik]:=Liczba;

        Suma:=Suma+Liczba

      end

  until Liczba > 1e37;

  IleLiczb:=Licznik; 

  if IleLiczb > 0 then

    begin

      Srednia:=Suma/IleLiczb;

      Suma:=0.0;

      for Licznik:=1 to IleLiczb do

        Suma:=Suma + sqr(Dane[Licznik] - Srednia);

      Wariancja:=Suma/IleLiczb;

      writeln('Wpisales ',IleLiczb,' liczb');

      write('Ich srednia wynosi ',Srednia:12:6);

      writeln(' zas wariancja ',Wariancja:12:6);

      readln

    end

end.

 

 

Procedury i funkcje

 

function nazwa(lista_parametrów_formalnych) : typ_wyniku;

{deklaracje lokalnych stałych, zmiennych i typów}

begin

{treść funkcji i jej przypisanie}

nazwa := obliczona_wartość_wyniku;

end;

 

Pascal nie dopuszcza funkcji typu strukturalnego (np.: tablice)

 

procedure nazwa_procedury(lista_parametrów_formalnych);

{deklaracje lokalnych stałych, zmiennych i typów}

begin

{ treść procedury }

end;

 

lista_parametrów_formalnych ma postać:

 

(lista_nazw : typ;...; lista_nazw : typ)

 

Dwa sposoby przekazywania parametrów: przez wartość i przez nazwę:

przez wartość dane mogą być tylko przekazywane do procedury,

przez nazwę dane mogą dostawać się do procedury i wydostawać się z niej.

 

Dwa przykłady:

 

Przekazywanie przez nazwę.

 

program ZwracanieParametrow;

 

var

  Znak : char;

 

procedure CzytajZnak(var ch:char);

 

begin

  write('Wpisz pojedynczy znak z klawiatury: ');

  readln(ch) { czytaj znak, zwroc przez parametr }

end;

 

begin

  repeat

    CzytajZnak(Znak);

    writeln('Wprowadziles znak ',Znak)

  until Znak = '0'

end.

 

 

Przekazywanie przez wartość

 

program ZwracanieParametrow;

 

var

  Znak : char;

 

procedure PiszZnak(ch:char);

 

begin

writeln('Wprowadziles znak ',ch)

end;

 

begin

repeat

        write('Wpisz pojedynczy znak z klawiatury: ');

        readln(znak)

PiszZnak(Znak);

until Znak = '0'

end.

 

Rekurencja

 

Ciąg Fibonacciego to ciąg określony wzorem:

an = an-2 + an-1

 

a0 = 0

a1 = 1

 

program CiagFibonacciego;

var

  i : integer;

  Licznik : longint;

 

function Fib(i:longint):longint;

{ oblicza i-ty wyraz ciągu Fibonacciego }

begin

  Inc(Licznik);

  if i = 0 then Fib:=0

    else

      if i = 1 then Fib:=1

        else

          Fib:=Fib(i-1)+Fib(i-2)

end;

begin

  for i:=1 to 40 do

  begin

      Licznik:=0;

      write('i=', i:3,'   a(i)= ',Fib(i),', ');

      writeln(Licznik,' wywołań.')

  end;

end.

 

Wynik działania programu

 

i=  1   a(i)= 1, 1 wywolan.

i=  2   a(i)= 1, 3 wywolan.

i=  3   a(i)= 2, 5 wywolan.

i=  4   a(i)= 3, 9 wywolan.

i=  5   a(i)= 5, 15 wywolan.

i=  6   a(i)= 8, 25 wywolan.

i=  7   a(i)= 13, 41 wywolan.

i=  8   a(i)= 21, 67 wywolan.

i=  9   a(i)= 34, 109 wywolan.

i= 10   a(i)= 55, 177 wywolan.

i= 11   a(i)= 89, 287 wywolan.

i= 12   a(i)= 144, 465 wywolan.

i= 13   a(i)= 233, 753 wywolan.

i= 14   a(i)= 377, 1219 wywolan.

i= 15   a(i)= 610, 1973 wywolan.

 

Definiowanie typów.

 

Przy przekazywaniu parametrów do i z procedur wymagana jest identyczność typów, ma to istotne znaczenie w przypadku parametrów strukturalnych.

 

a : array [1..1000] of real;

b : array [1..1000] of real;

 

a i b to dwa różne typy

 

program SuperStatystyka;

type

  Wektor = array[1..1000] of real;

var

  Dane     : Wektor; 

  IleLiczb : integer;

function CzytajDane(var Dane:Wektor):integer;

var

  Liczba : real;

  Licznik : integer;

begin

  Licznik:=0;

  repeat

    write('Podaj kolejna liczbe (1E+38 - koniec): ');

    readln(Liczba);

    if Liczba < 1e37 then

      begin

        Inc(Licznik);

        Dane[Licznik]:=Liczba

      end

  until Liczba > 1e37;

  CzytajDane:=Licznik

end;

 

function Srednia(IleLiczb:integer;Tablica:Wektor):real;

var

  i : integer;

  Suma : real;

begin

  Suma:=0.0;

  for i:=1 to IleLiczb do

    Suma:=Suma+Tablica[i];

  Srednia:=Suma/IleLiczb;

end;

 

function Wariancja(IleLiczb:integer;Liczby:Wektor):real;

var

  i : integer;

  Suma : real;

  WartoscSrednia : real;

begin

  Suma:=0.0;

  WartoscSrednia:=Srednia(IleLiczb,Liczby);

  for i:=1 to IleLiczb do Suma:=Suma + sqr(Dane[i] - WartoscSrednia);

  Wariancja:=Suma/IleLiczb;

end;

 

begin

  IleLiczb:=CzytajDane(Dane);

  writeln('Wartosc srednia wpisanych liczb: ', Srednia(IleLiczb,Dane):12:6);

  writeln('Wariancja wpisanych liczb: ', Wariancja(IleLiczb,Dane):12:6);

  writeln('Nacisnij ENTER');

  readln

end.

 

Stałe

 

const

nazwa_stałej = wartość

lub

nazwa_stałej = wyrażenie

 

Poprawne są następujące wyrażenia:

 

Koniec_wiersza = #13;

 

#65 litera A

#26 znak końca pliku

#09 znak tabulacji

 

w zapisie szesnastkowym można napisać:

#$41 to liczba A

 

wymiar_wektora = 1000;

wymiar_macierzy = wymiar_wektora * 10;

suma_wymiarów = wymiar_wektora + wymiar_macierzy;

następny = succ(suma_wymiarów);

 

Stałe definiowane w procedurach maja charakter lokalny.

 

program ZwracanieParametrow;

 

const

  KONIEC_DANYCH = '0';

var

  Znak : char;

procedure CzytajZnak(var ch:char);

begin

  write('Wpisz pojedynczy znak z klawiatury: ');

  readln(ch)

end;

 

begin

  repeat

    CzytajZnak(Znak);

    writeln('Wprowadziles znak ',Znak)

  until Znak = KONIEC_DANYCH

end.

 

 

W bloku const można również deklarować zmienne predefiniowalne:

 

const

nazwa_zmiennej : typ = wartość_poczatkowa;

 

program STALE_i_Zmienne;

const

  WYMIAR_MACIERZY = 3;

  Cztery                              = 2*2;

  STALY_NAPIS              = 'Czesc!';

  CRLF                              = chr(13)+chr(10);

  Dwa : real                       = CZTERY/2;

  Macierz : array[1..WYMIAR_MACIERZY,1..3] of real = (

      (1.0,2.0,3.0),

      (2.0,3.0,4.0),

      (4.0,5.0,6.0));

  Napis : string                 = 'Jestem tutaj...!';

var

  i,j : integer;

  x : real;

begin

  writeln(STALY_NAPIS,' ',Napis);

  Napis := 'Dwa razy dwa jest ';

  writeln(Napis,CZTERY);

*************************************************************

  STALY_NAPIS:='to jest potworny błąd !'; {istotnie}

  writeln('x = ',x); {tez błąd, ale innej kategorii}

*************************************************************

  x := Dwa;

  writeln('Teraz połowa z czterech: ',x);

  writeln('A teraz macierz...');

  for i:=1 to WYMIAR_MACIERZY do

  begin

    for j:=1 to 3 do

      write('    M[',i,',',j,'] = ',Macierz[i,j]:8:4);

      write(CRLF);

  end

end.

 

Pliki

 

Deklaracja zmiennej plikowej ma postać:

 

nazwa_zmiennej_plikowej : file of typ_składowy

 

typ_składowy może być dowolnym typem prostym lub strukturalnym z wyłączeniem typu plikowego i obiektowego.

 

przykłady:

 

PlikDanych : file of real;

PlikDanych : file of wektor;

 

Skojarzenie zmiennej plikowej z plikiem.

 

assign(nazwa_zmiennej_plikowej, nazwa_pliku)

 

assign(dane,'d:\users\rm\ala.dat');

 

Otwarcie i zamkniecie pliku dokonuje się przy pomocy instrukcji:

 

reset(zmienna_plikowa)

rewrite(zmienna_plikowa)

close(zmienna_plikowa)

 

Instrukcja reset otwiera plik istniejący, ustawia wskaźnik plikowy na pierwszym elemencie.

Instrukcja rewrite otwiera (tworzy) plik. (ustawia jego długość na 0)

 

Zapis i odczyt danych z pliku:

 

write(nazwa_zmiennej_plikowej, lista elementów)

read(nazwa_zmiennej_plikowej, lista elementów)

 

Dostęp do elementów pliku odbywa się przy pomocy instrukcji Seek.

 

Seek(zmienna_plikowa, numer_elementu)

 

Funkcja FileSize(zmienna_plikowa) zwraca rozmiar pliku. Na koniec pliku przemieszczamy się w następujący sposób:

 

Seek(f, FileSize(f));

 

Bieżąca wartość wskaźnika pliku FilePos(zmienna_plikowa);

 

program OdwracaniePliku;

 

var

  f : file of char;

  i : longint;      

  c : char;        

 

begin

  assign(f,'odwrplik.pas');

  reset(f);

  for i:=FileSize(f)-1 downto 0 do

    begin

      Seek(f,i);

      read(f,c);

      write(c);

    end;

  close(f)

end.

 

Pliki tekstowe

 

program CzytaniePlikuElementowego;

 

var

  f : file of char;

  NazwaPliku : string;

  ch : char;

 

begin

  write('Podaj nazwe pliku: ');

  readln(NazwaPliku);

  assign(f,NazwaPliku);

  reset(f);

  while not eof(f) do

    begin

      read(f,ch);

      write(ch)

    end;

  close(f)

end.

 

program CzytaniePlikuTekstowego;

var

  f : text;

  NazwaPliku : string;

  wiersz : string;

begin

  write('Podaj nazwe pliku: ');

  readln(NazwaPliku);

  assign(f,NazwaPliku);

  reset(f);

  while not eof(f) do

    begin

      readln(f,wiersz);

      writeln(wiersz)

    end;

  close(f)

end.

 

Typ plikowy Text umożliwia sekwencyjny dostęp do pliku.

Plik tekstowy można otwierać również z wykorzystaniem instrukcji Append(f) (wskaźnik plikowy ustawia się na końcu pliku).

Otwarcie pliku procedurą reset otwiera plik tylko do odczytu.

Zapis możliwy jest przy otwarciu pliku procedurą rewrite.

 

String

 

zamiast

 

a : array [1..255] of char

 

można napisać:

 

a : string;

 

W stringu mieści się 255 znaków, w zerowym elemencie zapisana jest długość stringu. Długość stringu może być ograniczana:

 

nazwa_zmiennej : string [max_długość];

 

Dla argumentów typu porządkowego działa tzw. operator przynależności (in).

 

if zmienna in [wartość1, wartość2,..., wartośćN] then ...

 

Lista może być napisana tak: [1,2,3,4,5,6,7,8,9] lub [1..9].

 

program Lancuchy;

const

  POWITANIE  = 'Hello';

  Pozegnanie : string[16] = 'Goodbye';

 

var

  Napis1,Napis2 : string;  

  i : integer;

 

begin

  Napis1:=POWITANIE+' and '+Pozegnanie;

  writeln(Napis1);

  for i:=1 to Length(Pozegnanie) do

writeln(Pozegnanie[i]);

  Napis2:='';  

  for i:=1 to 40 do Napis2:=Napis2+'*';

  writeln(Napis2);

  Napis1:=Copy(Napis2,1,30) + 'Nacisnij Enter' + Copy(Napis2,10,30);

  { wycinanie fragmentów łańcucha i sklejanie, Copy(s,n1,n2) zwraca łańcuch n2 znaków wyciętych z łańcucha s poczynając od pozycji n1}

  writeln(Napis1);

  readln;

  for i:=1 to Length(Napis2) do

    begin

      writeln(Napis2);

      Delete(Napis2,1,1)        { usuwanie znaków Delete(s,n1,n2) - usuwa n2 znaków z łańcucha s, zaczynając od pozycji n1)}

    end;

  write('Napisz cos: ');

  readln(Napis1);

  for i:=1 to Length(Napis1) do write(UpCase(Napis1[i]));   { na duże litery }

  writeln;

  for i:=1 to Length(Napis1) do Napis2[i]:=Napis1[succ(Length(Napis1)-i)];

    { od tylu }

  writeln(Napis2);

  Pozegnanie[4]:='@'; { wstawienie jednego znaku }

  writeln(Pozegnanie);

  writeln(Pos('@',Pozegnanie));    { szukanie znaku }

  Pozegnanie:='Do widzenia';       { obcinanie łańcucha }

  writeln(Pozegnanie);

  Pozegnanie[0]:=chr(2);              { skracanie łańcucha }

  writeln(Pozegnanie);

  Pozegnanie[0]:=chr(250);          { wydłużanie łańcucha }

  writeln(Pozegnanie);                  { jakieś śmieci ??! }

  readln

end.

 

Zmienne wskazywane

 

Deklaracja "zwykłej" zmiennej ma postać:

 

zmienna : typ;

 

deklaracja zmiennych wskazywanych ma postać:

 

zmienna : ^typ;

 

typ może być typem prostym, typem string lub typem zdefiniowanym uprzednio.

 

program LancuchDynamiczny;

 

var

  Wiersz : ^string;

 

begin

  writeln(Wiersz^); 

  new(Wiersz);      

  writeln(Wiersz^);  

  Wiersz^:='Ala ma kota i dwa psy';

  writeln(Wiersz^); 

  dispose(Wiersz)   

end.

 

Wiersz     - wskaźnik do łańcucha

Wiersz^   - wskazywany łańcuch

 

Moduły

 

System                      - wszystkie procedury standardowe,

Crt                            - obsługa ekranu, klawiatury, głośnika,

Dos                           - wywołania systemowe MS-DOS,

Printer                       - obsługa drukarki,

Overlay                     - obsługa nakładek,

Graph                        - grafika,

Turbo3                      - moduł "uzgadniający" z Turbo Pascalem 3.0,

graph3                       - tzw. grafika żółwia, używana w Turbo Pascalu 3.0,

Strings                       - moduł obsługujący łańcuchy

WinDos                     - odpowiednik modułu Dos.

 

program CrtDemo;

{ Demonstracja niektórych procedur modułu Crt }

uses

  Crt;

var

  ch : char;

procedure Wait;

begin

  ch:=ReadKey

end;

 

procedure Gwiazdki;

var

  i : integer;

begin

  DirectVideo:=false;                 { dostęp do ekranu przez BIOS }

  for i:=1 to 1800 do write('*'); { zapisz ekran gwiazdkami }

  Wait;                                        { czekaj }

  ClrScr;                                     { wyczyść ekran }

  DirectVideo:=true;                  { szybki dostęp do ekranu }

  Wait;

  for i:=1 to 1800 do  write('*');

  TextAttr:=Blink + Red shl 4 + White;  { TextAttr określa kolor znaków/tła }

  GotoXY(25,12);                                    { pisz od pozycji x=25, y=12 }

  writeln('Efekt piorunujący, nieprawdaż ?');

  Wait;

end;

 

procedure Okno;

{ demonstruje okno tekstowe }

var

  i : integer;

begin

  Window(20,10,50,20);                            { współrzędne aktywnego okna tekst. }

  TextColor(White);

  TextBackground(Green);

  ClrScr;                                                          { tylko okno }

  for i:=1 to 100 do write('Zapis do okna ');  { wypisuj w oknie }

  Window(1,1,80,25);                                       { przywróć okno pełnoekranowe }

  Wait;

  ClrScr

end;

 

procedure Syrena;

{ efekty dźwiękowe }

const

  i : integer = 1000;

begin

  writeln('Nieco efektow dzwiekowych', ' (nacisnij dowolny klawisz):');

  repeat

    Sound(i);                   { dźwięk o częstotliwości i herców }

    Delay(1);                  { opóźnienie 1 milisekundę }

    if i > 2000 then i:=1000 else Inc(i)

  until KeyPressed; { zwraca true gdy naciśnięto klawisz }

  NoSound

end;

 

procedure Kody;

{ demonstracja funkcji ReadKey }

begin

  writeln('Teraz dowiesz sie, jakie kody maja rożne klawisze',

 ' (naciskaj je, <Esc> - koniec):');

  repeat

    Wait;

    if ch = #0 then { kod tzw. rozszerzony... }

      begin

Wait; { ...przekazywany w drugim wywołaniu }

writeln('Nacisnales klawisz o kodzie rozszerzonym', ord(ch),' (',ch,').')

      end

    else writeln('Nacisnales klawisz o kodzie ',ord(ch), '(',ch,').');

  until ch = #27;

  ClrScr;

end;

 

begin { program }

  TextColor(Yellow);         { żółte litery }

  TextBackground(Blue);   { niebieskie tło }

  ClrScr;                              { oczyść ekran }

  Gwiazdki;                         { demonstracja szybkości procedur pisania }

  Okno;                               { okno tekstowe }

  Syrena;                             { procedury obsługi głośnika }

  Kody                                { kody zwracane przez ReadKey }

end.

 

Własne moduły

 

unit Modul1;

 

interface { naglowek sekcji publicznej }

 

const

g = 9.81; { ziemskie przyspieszenie grawitacyjne }

 

function Droga(Czas:real):real; { droga w spadku swob. }

 

implementation { definicja funkcji Droga }

 

function Droga(Czas:real):real; { zgodnosc naglowkow! }

 

begin

Droga:=g*Czas*Czas/2 { s = at^2/2 }

end;

 

begin

writeln('Klania sie modul numer 1')

end.

 

unit Modul2;

 

interface { sekcja publiczna modulu 2 }

 

uses

Crt; { korzysta z modulu Crt }

 

procedure Zlicz; { publiczna }

 

implementation

 

var

Licznik : integer; { zmienna prywatna }

 

procedure Zlicz;

 

begin

Inc(Licznik); { dziala na zmiennej niewidocznej }

writeln(Licznik) { na zewnatrz }

end;

 

begin

Licznik:=0; { jakos trzeba go ustawic }

writeln('Pozdrowienia od modulu numer 2')

end.

 

 

program TestModulow;

 

uses

Crt,

Modul1,Modul2;

   

var

i : integer;

Czas : real;

 

begin

writeln('Przyspieszenie ziemskie: ',g:4:2,' m/s^2');

write('Podaj czas spadku ciala: ');

readln(Czas);

writeln('Droga w spadku = ',Droga(Czas):12:3,' m.');

readln;

for i:=1 to 100 do

Zlicz { jedyna droga dostepu do Licznika }

end.

 

 

Record

 

nazwa_zmiennej : record

            nazwa_pola : typ_pola;

            nazwa_pola : typ_pola;

            ...

end;

 

var

            osoba = record

            imie := string[15];

            nazwisko := string[20];

            wiek : byte;

            ...

            end;

 

 

Baza danych (tablica rekordów).

 

type

            osoba = record

            imie := string[15];

            nazwisko := string[20];

            wiek : byte;

            ...

            end;

var

            baza : array[1..100] of osoba;

            ...

            baza_plik : file of osoba;

 

Dostęp do pól rekordów:

 

baza[20].nazwisko:='Kowalski';

place := baza[20].dochody;

 

Dostęp do wielu pól rekordów umożliwia instrukcja wiążąca with.

 

with lista_nazw_rekordów do

            {operacje na polach tych rekordów}

 

with baza[20] do

            begin

                        imie := 'Ala';

                        nazwisko := 'Kowalska';

                        wiek : 50;

            end;

 

with baza[20] , Podatek do

            begin

            Nazwisko_imie := Nazwisko + Imie;

                        Wielkość := Dochód*StopaPodatku;

            end;

 

Możliwe jest całościowe kopiowanie rekordów, np.

 

baza[i] := baza[j];

 

 

Zapis i odczyt z pliku rekordów odbywa się poprzez rekordy.

 

for i:=1 to ostatni do

            write(baza_plik, baza[i]);

 

Baza danych

 

program Kadrowa;

{ prosta baza danych }

uses

  Crt;

type

  DanePers = record                                { opis pojedynczego pracownika }

               Imie            : string[15];

               Nazwisko   : string[20];

               Plec            : char;

               Wiek          : byte;

               Dochody    : real

             end;

const

  Ostatni : integer = 0;                               { ostatni rekord = 0 na początku }

var

  Dane : array[1..1000] of DanePers; { lista pracownikow }

  BazaDanych : file of DanePers;    { plik z danymi }

procedure WpisDanych(var Rekord:DanePers);

{ czyta dane pracownika z klawiatury }

var

  ch : char;

begin

  ClrScr;

  with Rekord do                                              { do poszczególnych pól rekordu }

    begin

      write('Imie      : ');                           { bez komentarza }

      readln(Imie);

      write('Nazwisko  : ');

      readln(Nazwisko);

      write('Plec (M/K) :');

      repeat { czytaj do oporu }

        ch:=UpCase(ReadKey)             { zamień na dużą literę }

      until ch in ['M','K'];                                { aż właściwy klawisz }

      Plec:=ch;

      writeln;

      write('Wiek      : ');

      readln(Wiek);

      write('Dochody    : ');

      readln(Dochody)

    end;

  Inc(Ostatni)                              { zwiększ liczbę aktywnych rekordów }

end;

 

procedure ZapisNaDysku;

{ zapisuje baze danych na dysku }

var

  Nazwa : string;

  i : integer;

begin

  write('Nazwa bazy danych: ');

  readln(Nazwa);

  assign(BazaDanych,Nazwa);

  rewrite(BazaDanych);                          

   for i:=1 to Ostatni do                          

    write(BazaDanych,Dane[i]);              

  close(BazaDanych)                               

end;

 

function OdczytZDysku:integer;

{ odczytuje bazę danych z dysku }

var

  Nazwa : string;

  i : integer;

begin

  write('Nazwa bazy danych: ');

  readln(Nazwa);

  assign(BazaDanych, Nazwa);

  reset(BazaDanych);

  i:=1;

  while not eof(BazaDanych) do                              

    begin

      read(BazaDanych,Dane[i]);                   

      Inc(i)                                                      

    end;

  close(BazaDanych);                                              

  OdczytZDysku:=pred(i)                           

end;

 

procedure PrzegladDanych;

{ przeglądanie bazy danych }

const

  KursorLewo     = #75;  

  KursorPrawo   = #77;   

  Esc           = #27;            

var

  i : integer;

  ch : char;

  procedure WyswietlRekord(NrRekordu:integer);

  begin

    ClrScr;

    writeln('Rekord nr ',i,':');

    writeln;

    with Dane[i] do

      begin

        writeln('Imie     : ',Imie);

        writeln('Nazwisko: ',Nazwisko);

        writeln('Plec     : ',Plec);

        writeln('Wiek     : ',Wiek);

        writeln('Dochody : ',Dochody:9:2)

      end;

    writeln

  end;

 

begin

  i:=1;

  repeat

    WyswietlRekord(i);

    writeln('<-: poprzedni rekord,  ->: nastepny rekord  Esc:',

            ' koniec');

    repeat

      ch:=ReadKey;

    until ch in [KursorLewo,KursorPrawo,Esc];

    case ch of

         KursorLewo : if i > 1 then Dec(i);

         KursorPrawo : if i < Ostatni then Inc(i)

    end

  until ch = Esc

end;

 

function Menu:integer;

{ proste menu główne }

var

  ch : char;

 

begin

  ClrScr;                     

  writeln('MENU: ');  

  writeln('1: Wpis danych osobowych');

  writeln('2: Zapis danych na dysku');

  writeln('3: Odczyt danych z dysku');

  writeln('4: Przeglądanie danych');

  writeln('0: Koniec pracy');

  repeat                    

    ch := ReadKey

  until ch in ['0'..'4'];

  Menu := ord(ch)-ord('0') 

end;

 

begin

  repeat

    case Menu of

         1 : WpisDanych(Dane[succ(Ostatni)]);

         2 : ZapisNaDysku;

         3 : Ostatni:=OdczytZDysku;

         4 : if Ostatni > 0 then PrzegladDanych;

         0 : Halt(0)

     end

  until false

end.

 

Obiekty

 

 

program Squash;

 

uses

  Crt,

  InterfejsUzytkownika;

const

  KursorGora       = #72; 

  KursorDol         = #80; 

  LiniaAutowa       = 78; 

  Predkosc         = 10; 

  Punkty : integer  = 0;

  Runda : integer  = 1; 

type { definicje klas }

TZnak = object     { T oznacza Typ }

    x,y : byte;     

    Kod : char;   

    constructor Inicjuj(WspX,WspY:byte); 

    destructor Koniec;virtual;                      

    procedure Pokaz;virtual;                        

    procedure Schowaj;virtual;                    

    procedure Przesun(NowyX,NowyY:byte);

end;

 

TPilka = object(TZnak)

    dx : integer;

    dy : integer;

    constructor Inicjuj(WspX,WspY:byte);  

    procedure Steruj;                                  

    procedure OdbijOdRakiety;                 

end;

 

TRakieta = object(TZnak)

    constructor Inicjuj(WspX,WspY:byte); 

    procedure Pokaz;virtual;                        

    procedure Schowaj;virtual;                    

    procedure Steruj;                           

    function Srodek:byte;                   

end;

 

var

  Pilka : TPilka;

  Rakieta : TRakieta;

  i : byte;

  Opoznienie : word;

 

{ procedury globalne }

 

procedure Punktacja;

begin

  GotoXY(1,25);

  write('Runda:  ',Runda:3,' Punkty: ',Punkty:3,'  Srednio:',

  Punkty/Runda:6:2);

  write('    Esc - koniec.');

end;

 

procedure KoniecRundy;

{ i ew. start nastepnej rundy }

begin

  Punktacja;

  Pilka.Koniec;

  Czekaj;

  if ch = Esc then Halt(0);  

  Inc(Runda);                     

  Pilka.Inicjuj(1,Random(20)+2);

end;

 

{ definicje metod }

 

constructor TZnak.Inicjuj(WspX,WspY:byte);

begin

  x:=WspX;

  y:=WspY;

  Pokaz { znak na (x,y) }

end;

 

destructor TZnak.Koniec;

begin

  Schowaj { prosty ! }

end;

 

procedure TZnak.Pokaz;

begin

  PiszXY(x,y,Kod); { bez... }

end;

 

procedure TZnak.Schowaj;

begin

  PiszXY(x,y,' ');

end;

 

procedure TZnak.Przesun(NowyX,NowyY:byte);

begin

  Schowaj;   

  x:=NowyX; 

  y:=NowyY; 

  Pokaz     

end;

 

constructor TPilka.Inicjuj(WspX,WspY:byte);

begin

  Kod:=#02; { buzka }

  dx:=1;

  dy:=2*integer(Random(2))-1;

  TZnak.Inicjuj(WspX,WspY);

end;

 

procedure TPilka.Steruj;

var

  xx,yy : shortint;

begin

  if x = pred(LiniaAutowa) then

    OdbijOdRakiety;             

  yy:=y+dy;

  if (yy < 1) or (yy > 24) then

    begin

      Buczek(2000,0.05);

      dy:=-dy 

    end;

  if x*dx = -1 then  

    begin

      Buczek(1000,0.05);

      dx:=-dx 

    end;

  xx:=x+dx;  

  yy:=y+dy;

  Przesun(xx,yy)  

end;

 

procedure TPilka.OdbijOdRakiety;

var

  Roznica : integer;

begin

  Buczek(500,0.05);

  Roznica:=y - Rakieta.Srodek;

  { miedzy pilka a srodkiem rakiety }

  if abs(Roznica) < 2 then   

    begin

      Inc(Punkty);     

      dx:=-dx;           

      if abs(Roznica) = 0 then  

        dy:=integer(2*Random(2)-1)

      else            

        dy:=Roznica*2*dy 

    end

  else

    KoniecRundy;

  Punktacja

end;

 

constructor TRakieta.Inicjuj(WspX,WspY:byte);

begin

  Kod:=#219;

  TZnak.Inicjuj(WspX,WspY);

end;

 

procedure TRakieta.Pokaz;

var

  i : byte;

begin

  for i:=0 to 2 do

    PiszXY(x,y+i,Kod);

end;

 

procedure TRakieta.Schowaj;

var

  StaryKod : char;

begin  

  StaryKod:=Kod;

  Kod:=' ';    

  Pokaz;      

  Kod:=StaryKod  

end;

 

procedure TRakieta.Steruj;

var

  yy : byte;

begin

  Delay(Opoznienie);

  if KeyPressed then

    begin

      yy:=y;

      Czekaj;

        case ch of

            KursorGora : if y > 1 then Dec(yy);

            KursorDol  : if y < 22 then Inc(yy);

          end;

      Przesun(x,yy)

    end

end;

 

function TRakieta.Srodek:byte;

begin

  Srodek:=succ(y)

end;

 

begin

  ClrScr;             

  Opoznienie:=200 div Predkosc;

  Punktacja;         

  Rakieta.Inicjuj(LiniaAutowa,10);

  Pilka.Inicjuj(1,10);

  repeat

    ch :=#0;          

    repeat

      for i:=1 to 4 do

        Rakieta.Steruj;

      Pilka.Steruj;   

    until ch = Esc;

  until ch = Esc;   

end.