13.Prednaska

Z Pascal
Prejsť na: navigácia, hľadanie
13. Prednáška

úlohy | cvičenie


Vymenovaný typ

Vymenovaný typ (enumerated type) je taký ordinálny typ, ktorý definujeme vymenovaním všetkých prípustných hodnôt daného typu. Vymenované hodnoty sú identifikátory konštánt (ich ordinálne hodnoty sú čísla od 0 do počet-1), napr.

type
  TTyzden = (PON, UTO, STR, STV, PIA, SOB, NED);

definuje nový ordinálny typ - premenné tohto typu budú môcť nadobúdať hodnotu len z tohto zoznamu konštánt. Vymenovaný typ nie je kompatibilný so žiadnym iným typom (napr. interval preberá všetky vlastnosti aj konštanty nadradeného typu a tiež je s ním kompatibilný - dovoľuje navzájom sa priraďovať, miešať sa v operáciách a pod.) Deklarácia vymenovaného typu okrem samotného typu automaticky definuje aj identifikátory konštánt tohto typu, t.j. s deklaráciou typu TTyzden sa zadeklarovalo aj 7 nových identifikátorov konštánt. Nakoľko je vymenovaný typ ordinálny typ, fungujú s ním všetky štandardné funkcie a procedúry, ktoré pracujú s inými ordinálnimi typmi ('Integer, Char, Boolean):

  • štandardné funkcie, procedúry: Ord, Pred, Succ, Low, High, Inc, Dec
  • môžeme ho použiť ako index prvkov poľa, resp. riadiaca premenná for-cyklu
  • fungujú všetky relácie: =, <>, <=, >=, <, >
  • aj na typ Boolean by sme sa mohli pozerať ako na vymenovaný typ, t.j. ako keby
type Boolean = (False, True);
  • vymenovaný typ môžeme vypísať alebo prečítať do, resp. zo súboru
  • ordinálna hodnota je definovaná tak, že prvá konštanta typu má vnútornú hodnotu 0 a všetky ďalšie postupne o 1 viac, t.j.
Ord(PON) = 0; Ord(UTO) = 1; Ord(STR) = 2; ... Ord(NED) = 6;
  • meno typu (v našom prípade TTyzden) je automaticky menom konverznej funkcie, ktorá z celého čísla vyrobí príslušnú konštantu vymenovaného typu, napr.
TTyzden(2) = STR; TTyzden(5) = SOB;

Príklad s vymenovaným typom:

type
  TTyzden = (PON, UTO, STR, STV, PIA, SOB, NED);
var
  D: TTyzden;
begin
  D := PON;
  D := Pred(PIA);     // D=STV
  D := Succ(SOB);     // D=NED
  D := UTO;
  Inc(D);             // d=STR
  Inc(D, 3);          // d=SOB
  I := Ord(PON);      // I=0     prvá konštanta má hodnotu 0
  I := Ord(UTO);      // I=1
  D := TTyzden(4);    // D=PIA
  D := Low(TTyzden);  // D=PON
 
  D := High(D);       // D=NED
end.

Hodnoty vymenovaného typu môžeme vypisovať pomocou Write a čítať pomocou Reed, napr.

  for D := Low(TTyzden) to High(TTyzden) do
    Write(D, ' ');
  WriteLn;
  Write('zadaj: ');
  ReadLn(D);
  WriteLn('zadal si den ', D);

Pri čítaní z konzoly aelbo s textového súboru musí byť zadaný správny reťazec, inak program spadne na chybe. Ak potrebujeme hodnoty vymenovaného typu prečítať bez rizika spadnutia programu alebo vypísať (napr. pomocou TextOut), tak si vytvoríme pomocné pole mien konštánt, napr.

const
  Nazvy: array [TTyzden] of string =
      ('PON', 'UTO', 'STR', 'STV', 'PIA', 'SOB', 'NED');
var
  Ret: string;
begin
  Write('zadaj:');
  ReadLn(Ret);
  Ret := UpperCase(Ret);
  D := Low(TTyzden);
  while (D < High(TTyzden)) and (Nazvy[D] <> Ret) do
    Inc(D);
  if Nazvy[D] <> Ret then
    WriteLn('... chyba ...')
  else
    WriteLn('zajtra bude ', Nazvy[Succ(D)]);    // spadne, ak d=ned

Zistite, v čom je chybné takéto riešenie:

const
  Nazvy: array [TTyzden] of string =
      ('PON', 'UTO', 'STR', 'STV', 'PIA', 'SOB', 'NED');
var
  Ret: string;
begin
  Write('zadaj:');
  ReadLn(Ret);
  D := Low(TTyzden);
  while (D <= High(TTyzden)) and (Nazvy[D] <> Ret) do
    Inc(D);
  if D > High(TTyzden) then
    WriteLn('... chyba ...')
  else
    WriteLn('zajtra bude ', Nazvy[Succ(D)]);

Vymenovaný typ sme už používali predtým, napr. nasledujúce typy sú už preddefinované v knižniciach Lazarus:

type
  TFPPenStyle = (psSolid, psDash, psDot, psDashDot, psDashDotDot,
                 psInsideFrame, psPattern, psClear);
  TFPBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical, bsFDiagonal,
                   bsBDiagonal, bsCross, bsDiagCross, bsImage, bsPattern);
 
// a preto sme mohli písať:
  Image1.Canvas.Pen.Style := psDash;
  Image1.Canvas.Brush.Style := bsClear;

V nasledujúcom príklade funkcia Porovnaj vráti jednu z hodnôt vymenovaného typu (Mensi, Rovny, Vacsi) podľa toho, v akej relácii sú dva reťazce:

type
  TPorovnanie = (Mensi, Rovny, Vacsi);
 
function Porovnaj(Ret1, Ret2: string): TPorovnanie;
begin
  if Ret1 < Ret2 then
    Result := Mensi
  else if Ret1 = Ret2 then
    Result := Rovny
  else
    Result := Vacsi;
end;



Iné možnosti definovania konštánt vymenovaného typu



Zatiaľ sme sa naučili, že prvá konštanta vymenovaného typu má ordinálnu hodnotu 0 a posledná počet-1. Toto pravidlo môžeme podľa potreby zmeniť: pri definovaní vymenovaného typu môžeme zároveň definovať aj ordinálne hodnoty konštánt, napr.

type
  TPorovnanie = (Mensi := -1, Rovny, Vacsi := 3);

Pritom platí:

  • ak je za konštantou (za znakom priradenie) celé číslo, toto definuje jeho ordinálnu hodnotu
  • ak prvá konštanta nemá definovanú žiadnu hodnotu (napr. PON v TTyzden), tak dostáva hodnotu 0
  • ak niektorá konštanta (okrem prvej) nemá definovanú svoju ordinálnu hodnotu, automaticky dostáva o 1 vyššiu ako predchádzajúca konštanta
  • rôzne identifikátory konštánt nemôžu mať rovnaké ordinálne hodnoty
  • každá ďalšia vymenovaná konštanta musí mať vyššiu hodnotu ako predchádzajúca v zozname predchádzajúcich
  • medzi minimálnou a maximálnou hodnotou nemusia byť všetky ordinálne hodnoty pomenované konštantami, napr. v type TPorovnanie má konštanta Rovny hodnotu 0 a hodnotu 2 sme nepomenovali - aj tak môže premenná takéhoto vymenovaného typu nadobúdať aj nepomenované hodnoty, napr.
var
  P: TPorovnanie;
begin
  P := TPorovnanie(2);

Z tohto vyplýva, že pre vymenovaný typ je vlastne skupina pomenovaných konštánt. Ich ordinálne hodnoty sú ľubovoľné celé čísla (Integer) a preto v pamäti premenné tohto typu zaberajú 4 bajty.

POZOR! Vymenovaný typ s priradeniami sa nesmie použiť ako typ indexu poľa.


Typ množina

Množina je taký údajový typ, ktorý v pascale umožňuje pracovať s niektorými typmi množín podobným spôsobom ako je to obvyklé v matematike. V Pascale je povolené vytvárať množiny zložené len z prvkov rovnakého a to niektorého ordinálneho typu - hovoríme mu bázový (základný) typ. Napr. môžeme vytvoriť množinu znakov, množinu malých celých čísel, množinu dní v týždni a pod. Nemôžeme ale vytvoriť množinu, ktorá bude obsahovať napr. čísla aj znaky. Definícia množiny sa vždy skladá aj z definície jej bázového typu, napr. zápis

type
  TMnozina = set of 1..100;
var
  A, B: TMnozina;

definuje nový typ množina, ktorá môže obsahovať len čísla z intervalu (to je ordinálny typ) 1 až 100 - zrejme premenné takéhoto typu môžu byť napr. prázdna množina, alebo jednoprvková množina s prvkom 13 alebo dvojprvková množina s prvkami 2 a 3 a pod. Do premenných A, B môžeme priraďovať (iba množiny), môžeme s nimi manipulovať pomocou množinových operácií a relácií - nemôžeme ich priamo vypísať alebo prečítať do/zo súboru, musíme si to naprogramovať.

Ako pracujeme s typom množina:

  • môžeme používať množinové konštanty:
    • prázdna množina [],
    • vymenovanie prvkov a intervalov [2], [1, 3], [1, 2, 3], [5..15, 20, 23..27]
  • množinové operácie musia mať oba operandy navzájom kompatibilné množiny (t.j. majú kompatibilné bázové typy):
    • zjednotenie A := A + B;
    • pridaj prvok: A := A + [5];
    • prienik A := A * [2, 3];
    • vyhoď prvok: A := A - [5];
    • rozdiel A := B - [1, 3];
  • príslušnosť prvku (prvý operand je bázového typu, druhý je množina):
  • zisťujeme, či číslo 3 je prvkom množiny A:
     if 3 in A then ...
  • či hodnota premennej I nie je prvkom množiny B:
     if not (I in B) then ...
  • relácie:
    • rovnosť, nerovnosť: if A = B then if C <> [] then ...
    • if A * [5] <> [] then ...
    • zisťovanie podmnožiny: if (A <= B) or (A >= B) then ...

Príklady:

var
  Znak: Char;
...
  if Znak in ['A'..'Z', 'a'..'z'] then ...
  if not (Znak in ['0'..'9']) then ...

Testovanie odpovede áno/nie:

const
  Ano = ['a', 'A', 'y', 'Y'];
  Nie = ['n', 'N'];
...
  Write('odpovedz ano/nie:');
  ReadLn(S);
  if (S <> '') and (S[1] in Ano) then ...
  else if (S <> '') and (S[1] in Nie) then ...
  else
    WriteLn('chybná odpoveď - ano/nie');

Generovanie množiny pomocou cyklu:

var
  X: set of 1..100;
...
  X := [];
  for I := 1 to 100 do
    X := X + [I];
...
  X := [];
  for I := 1 to 50 do
    X := X + [I, 101-I];
...
  X := [];
  for I := 1 to 100 do
    if I mod 7 = 0 then
      X := X + [I];

Ak chceme vypísať množinu, použijeme pomocný reťazec a cyklus:

type
  TBaza = 1..100;
  TMnozina = set of TBaza;
 
procedure Vypis(const M: TMnozina);
var
  I: TBaza;   // 1..100
  S: string;
begin
  S := '';
  for I := Low(TBaza) to High(TBaza) do
    if I in M then
      S := S + IntToStr(I) + ', ';
  WriteLn('[', S, ']');
end;

Výpis prvkov množiny do súboru tak, aby sa za posledným číslom nevypisovala čiarka:

procedure Vypis(const T: TextFile; const M: TMnozina);
var
  I: TBaza;
  B: Boolean;
begin
  Write(T, '[');
  B := False;
  for I := Low(TBaza) to High(TBaza) do
    if I in M then
    begin
      if B then
        Write(T, ', ');
      Write(T, I);
      B := True;
    end;
  Write(T, ']');
end;

alebo pomocou funkcie

function MnozinaToStr(M: TMnozina): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to 255 do
    if I in M then
    begin
      if Result <> '' then
        Result := Result + ', ';
      Result := Result + IntToStr(I);
    end;
  Result := '[' + Result + ']';
end;

Ďalšie námety:

  • vypisovanie množiny aj s intervalmi, napr. [1, 3..5, 10..41, 43, 45]
  • čítanie množiny zo vstupu (na vstupe môžu byť aj intervaly)

V štandardných knižniciach Lazarus je štýl fontov definovaný ako množina. Ukážme, ako vyzerajú deklarácie a ako sa s tým pracuje:

type
  TFontStyle = (fsBold, fsItalic, fsStrikeOut, fsUnderline);
  TFontStyles = set of TFontStyle;
  // a pre font je definovaný
  //   Style: TFontStyles;
...
  Image1.Canvas.Font.Style := [];
  Image1.Canvas.Font.Style := [fsBold];
  Image1.Canvas.Font.Style := Image1.Canvas.Font.Style - [fsItalic];
  Memo1.Font.Style := [fsItalic, fsUnderline];

Podobne je to aj s parametrom Shift v udalostiach s myšou (onMouseDown, onMouseMove a onMouseUp). Tento parameter je typu TShiftState, ktorý je obyčajnou pascalovskou množinou. Vďaka tomuto môžeme v týchto udalostiach využívať množinové operácie:

type
  TShiftStateEnum = (ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble);
  TShiftState = set of TShiftStateEnum;
...
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if Shift = [ssLeft, ssRight, ssAlt] then
    Caption := 'stlačené súčasne obe tlačidlá a Alt';
  if ssLeft in Shift then
    Caption := 'stlačené aspoň ľavé tlačidlo, ostatné nás nezaujíma';
  if Shift * [ssLeft, ssRight] = [ssLeft] then
    Caption := 'stlačené ľavé a nestlačené pravé, klávesy nás nezaujímajú';
...
end;



Iná verzia for-cyklu



Keďže pri práci s množinami veľmi často používame for-cyklus, v ktorom postupne prechádzme všetky prvky, Free Pascal je rozšírený o novú programovú konštrukciu for-cyklus zo štruktúry. Pomocou nej sa budú dať prechádzať pohodlnejšie nielen množiny, ale aj polia a reťazce. Napr. známy zápis

type
  TBaza = 1..100;
  TMnozina = set of TBaza;
var
  Mnozina: TMnozina;
  I: TBaza;
  ...
  for I := Low(TBaza) to High(TBaza) do
    if I in Mnozina then
      S := S + IntToStr(I) + ' ';

môžeme skrátene zapísať aj takto:

  for I in Mnozina do
    S := S + IntToStr(I) + ' ';

Rovnaký mechanizmus funguje aj pre polia a reťazce, napr.

var
  Pole: array [1..10] of Integer;
  S: string;
  Znak: Char;
  Mnozina: set of Byte;
  Cislo, Sucet: Integer;
begin
  S := 'abcdefghij';
  Mnozina := [];
  for Znak in S do
    Mnozina := Mnozina + [Ord(Znak)];
  ...
  Sucet := 0;
  for Cislo in Pole do
    Inc(Sucet, Cislo);

Takýto for-cyklus opakuje príkaz alebo postupnosť príkazov, pričom premenná cyklu postupne nadobúda všetky hodnoty nejakej štruktúry (množina, reťazec, pole):

for premenná in hodnota do
  príkaz;

Kde

  • premenná cyklu musí byť lokálna premenná v danej procedúre (v ktorej používame for)
  • hodnota musí byť buď typu množina, znakový reťazec alebo pole
  • premenná cyklu musí byť rovnakého typu ako sú prvky hodnota (t.j. prvky množiny, znaky, alebo prvky poľa)

Premenná cyklu sa môže použiť v tele cyklu, ale

  • nesmie sa meniť jej hodnota, napr. priraďovacím príkazom, príkazom načítania Read, príkazmi Inc a Dec ani nijak inak
  • po skončení cyklu je jej hodnota nedefinovaná
  • vnorené cykly musia mať inú premennú cyklu

Pred samotným spustením cyklu sa najprv vypočíta a zapamätá zadaná hodnota, až potom sa z nej postupne vyberajú prvky. Ak je hodnota zadaná nejakou premennou, tak jej zmena v tele cyklu už nemá vplyv na vyberané hodnoty.

V tele cyklu môžeme použiť vyskakovacie príkazy Break a Continue.



Príklady



Najprv jeden veľmi jednoduchý: nájdeme všetky čísla do 255, ktorých zvyšok po delení 7 je 3, nie sú deliteľné 3 a poslednú cifru majú 4:

var
  Mnozina: set of Byte;
  I: Integer;
begin
  Mnozina := [1..255];
  for I := 1 to 255 do
    if I mod 7 <> 3 then
      Mnozina := Mnozina - [I];
  for I in Mnozina do
    Write(I, ' ');
  WriteLn;
 
  for I := 1 to 255 do
    if I mod 3 = 0 then
      Mnozina := Mnozina - [I];
  for I in Mnozina do
    Write(I, ' ');
  WriteLn;
 
  for I := 1 to 255 do
    if I mod 10 <> 4 then
      Mnozina := Mnozina - [I];
  for I in Mnozina do
    Write(I, ' ');
  WriteLn;
  ReadLn;
end.

Toto riešenie najprv zoberie množinu všetkých celých čísel do 255, potom z nich vyhodí tie, ktoré nevyhovujú prvej podmienke (zvyšok po delení 7 je 3), potom v ďalšom cykle vyhodíme tie, ktoré nevyhovujú druhej podmienke (nie sú deliteľné 3) a na záver tretí cyklus kontroluje tretiu podmienku (poslednú cifru majú 4). Zakaždým sa celá množina zmenšuje až na koniec ostanú len tie čísla, ktoré vyhovujú zadaniu - priebežne túto množinu vypisujeme a vidíme medzivýsledky.

V druhom riešení sme všetky tri podmienky zlúčili do jedného testu:

  Mnozina := [1..255];
  for I := 1 to 255 do
    if (I mod 7 <> 3) or (I mod 3 = 0) or (I mod 10 <> 4) then
      Mnozina := Mnozina - [I];
  for I in Mnozina do
    Write(I, ' ');
  WriteLn;

Tretie riešenie robí to isté, ale z množiny čísel nevyhadzuje tie, ktoré nevyhovujú, ale do prázdnej množiny pridáva tie, ktoré vyhovujú naraz všetkým trom podmienkam:

  Mnozina := [];
  for I := 1 to 255 do
    if (I mod 7 = 3) and (I mod 3 <> 0) and (I mod 10 = 4) then
      Mnozina := Mnozina + [I];
  for I in Mnozina do
    Write(I, ' ');
  WriteLn;

Príklad spočíta čísla z množiny:

  Suma := 0;
  for I in [1, 2, 4, 8, 16, 32] do
    Inc(Suma, I);
  WriteLn(Suma);

Príklad zistí počet rôznych samohlások v nejakom reťazci:

   Retazec := 'programovanie';
   Pocet := 0;
   for Znak in 'aeiouy' do         // ale aj: for Znak in ['a','e','i','o','u','y'] do
     if Pos(Znak, Retazec) <> 0 then
       Inc(Pocet);
   WriteLn('počet rôznych samohlások = ', Pocet);

Príklad použitia vnorených cyklov - spočítame všetky čísla vo všetkých množinách v poli:

type
  TMnozina = set of Byte;
var
  Pole: array [1..3] of TMnozina;
  Mnozina: TMnozina;
  Cislo, Suma: Integer;
begin
  Pole[1] := [1];
  Pole[2] := [2, 4];
  Pole[3] := [3, 6, 9];
  Suma := 0;
  for Mnozina in Pole do
    for Cislo in Mnozina do
      Inc(Suma, Cislo);
  WriteLn(Suma);
end;

Príklad výpočíta hodnoty polynómu (x5 + 5x4 - 7x2 + x + 9) pre zadanú premennú (použili sme Hornerovú schému):

const
  Vyraz: array [1..6] of Real = (1, 5, 0, -7, 1, 9);
var
  Koef, X, Hodnota: Real;
begin
  X := 2;
  Hodnota := 0;
  for Koef in Vyraz do
    Hodnota := Hodnota * X + Koef;
  WriteLn(Hodnota);
end;

Príklad veľmi podobné dve funkcie využívajúce tento for-cyklus:

type
  TCharSet = set of Char;
 
function Prerob(Mnozina: TCharSet): string;
var
  Znak: Char;
begin
  Result := '';
  for Znak in Mnozina do
    Result := Result + Znak;
end;
 
function Prerob(Retazec: string): TCharSet;
var
  Znak: Char;
begin
  Result := [];
  for Znak in Retazec do
    Result := Result + [Znak];
end;
 
begin
  WriteLn(Prerob(Prerob('programovanie')));

Ukážka toho, že zmena štruktúrovanej premennej, z ktorej sa vyberajú prvky, nemá vplyv na priebeh cyklu - v ukážke chceme vytvoriť množinu druhých mocnín 2 tak, že najprv tam dáme len číslo 1 a potom pre všetky prvky chceme postupne pridať aj jeho dvojnásobok:

var
  Mnozina: set of Byte;
  I: Integer;
  S: string;
begin
  Mnozina := [1];
  for I in Mnozina do
    if 2 * I <= 255 then
      Mnozina := Mnozina + [2 * I];
  S := '';
  for I in Mnozina do
    Write(I, ' ');

toto ale nefunguje a vytvorí len dvojprvkovú množinu [1, 2]; toto musíme riešiť "klasickým" for-cyklom, napr.

  Mnozina := [1];
  for I := 1 to 255 do
    if I in Mnozina then
      if 2 * I <= 255 then
        Mnozina := Mnozina + [2 * I];



Príklad s tabuľkou študentov



Program, ktorý z textového súboru zoznam.txt prečíta mená študentov (študentov nie je viac ako 200), ich priemerné známky a informáciu o tom, či študent dostal alebo nedostal internát (v tvare 0 alebo 1). Program potom vypíše

  • všetkých študentov
  • dobrých študentov (priemer do 1.5), ktorí majú internát
  • dobrých študentov, ktorí nemajú internát
type
  TBaza = 1..200;
  TTabulka = array [TBaza] of record
    Meno: String;
    Znamka: Real;
    Internat: Boolean;
  end;
  TMnozina = set of TBaza;
 
procedure Citaj(var T: TTabulka; var N: Integer);
var
  Subor: TextFile;
  I: Integer;
  Znak: Char;
begin
  AssignFile(Subor, 'zoznam.txt');
  Reset(Subor);
  N := 0;
  while not SeekEof(Subor) do
  begin
    Inc(N);
    with T[N] do
    begin
      Meno := '';
      repeat
        Read(Subor, Znak);
        if Znak <> ';' then
          Meno := Meno + Znak;
      until Znak = ';';
      Readln(Subor, Znamka, I);
      Internat := I = 1;
    end;
  end;
  CloseFile(Subor);
end;
 
procedure Vypis(const T: TTabulka; M: TMnozina);
var
  I: TBaza;
  Pocet: Integer;
begin
  Pocet := 0;
  for I in M do
   begin
     Write(T[I].Meno, ', ');
     Inc(Pocet);
   end;
  Writeln;
  Writeln('*** pocet = ', Pocet, ' ***');
end;
 
var
  T: TTabulka;
  A, B: TMnozina;
     // A - indexy do tabuľky T, pre ktorých znamka <= 1.5
     // B - indexy do tabuľky T - študentov, ktorí majú internát
  N, I: Integer;
begin
  Citaj(T, N);      // čítanie tabuľky
  A := [];
  B := [];
  for I := 1 to N do
  begin
    if T[I].Znamka <= 1.5 then
      A := A + [I];
    if T[I].Internat then
      B := B + [I]
  end;
  WriteLn('>>> VSETCI <<<');
  Vypis(T, [1..N]);
  ReadLn;
  WriteLn('>>> DOBRI, MAJU INTERNAT <<<');
  Vypis(T, A * B);
  ReadLn;
  WriteLn('>>> DOBRI, NEMAJU INTERNAT <<<');
  Vypis(T, A - B);
  ReadLn;
  WriteLn('>>> NIE DOBRI <<<');
  Vypis(T, [1..N] - A);
  ReadLn;
end.

S týmto projektom môžeme ďalej experimentovať. Každému študentovi pridáme informáciu o jeho koníčkoch. Keďže jeden študent môže mať aj viac koníčkov, resp. nemať žiaden, použijeme vymenovaný typ a množinu. Napr.

type
  TKonicek = (tenis, gitara, spev, tanec, hokej);
  TBaza = 1..200;
  TTabulka = array [TBaza] of record
    Meno: String;
    Znamka: Real;
    Internat: Boolean;
    Konicek: set of TKonicek;
  end;
  TMnozina = set of TBaza;

Aby sme nemuseli pridávať túto informáciu do súboru, koníčky každému študentovi vygenerujeme náhodne, napr. hneď po prečítaní údajov z riadka súboru:

procedure Citaj(var T: TTabulka; var N: Integer);
var
  Subor: TextFile;
  I: Integer;
  Znak: Char;
  K: TKonicek;
begin
  AssignFile(Subor, 'zoznam.txt');
  Reset(Subor);
  N := 0;
  while not SeekEof(Subor) do
  begin
    Inc(N);
    with T[N] do
    begin
      Meno := '';
      repeat
        Read(Subor, Znak);
        if Znak <> ';' then
          Meno := Meno + Znak;
      until Znak = ';';
      Readln(Subor, Znamka, I);
      Internat := I = 1;
      Konicek := [];
      for K := Low(TKonicek) to High(TKonicek) do
        if Random(5) = 0 then
          Konicek := Konicek + [K];
    end;
  end;
  CloseFile(Subor);
end;

Do množín A a B sme ďalej priradili zoznamy dobrých študentov a študentov s internátmi. Teraz do ďalších množín priradíme zoznamy študentov s rovnakými koníčkami. Napr. MK[gitara] bude označovať zoznam študentov, ktorí majú koníčka gitaru (teda je to množina čísel študentov do tabuľky, ktorí majú medzi koníčkami aj gitaru). Zadefinujeme pole množín MK a priradíme im príslušné hodnoty:

var
  T: TTabulka;
  A, B: TMnozina;
  MK: array [TKonicek] of TMnozina;
  N, I: Integer;
  K: TKonicek;
begin
  Citaj(T, N);      // čítanie tabuľky
  A := [];
  B := [];
  for I := 1 to N do
  begin
    if T[I].Znamka <= 1.5 then
      A := A + [I];
    if T[I].Internat then
      B := B + [I]
  end;
  for K := Low(TKonicek) to High(TKonicek) do
  begin
    MK[K] := [];
    for I := 1 to N do
      if K in T[I].Konicek then
        MK[K] := MK[K] + [I];
  end;
  WriteLn('>>> KONICEK TENIS <<<');
  Vypis(T, MK[tenis]);
  ReadLn;
  WriteLn('>>> DOBRI, MAJU KONICEK GITARA <<<');
  Vypis(T, A * MK[gitara]);
  ReadLn;
  WriteLn('>>> NEMAJU ZIADEN KONICEK <<<');
  Vypis(T, [1..N] - MK[tenis] - MK[gitara] - MK[spev] - MK[tanec] - MK[hokej]);
  ReadLn;
end.



Príklad s konštruovaním množiny



Napíšeme program, ktorý vytvorí podmnožinu M celých čísel z 1..250 takú, že

  • 1 je z množiny M
  • ak i je z množiny, tak 2i+1 aj 3i+1 sú z množiny M

Najprv zapíšme riešenie, ktoré vyzerá správne, ale sú v ňom chyby:

var
  M: set of 1..250;
  I: Integer;
begin
  M: = [1];
  for I := 1 to 250 do
    if I in M then
      M := M + [2 * I + 1, 3 * I + 1];
  for I := 1 to 250 do
    if I in M then
      Write(I, ' ');
  ReadLn;
end.

Do množiny nemôžeme pridávať ľubovoľné celočíselné hodnoty, ale len po istú hranicu. Napr. ak I=202, tak by sme do množiny chceli pridávať aj čísla 2*202+1 a 3*202+1, t.j. 405 a 607 - lenže tieto dve hodnoty výrazne prevyšujú maximálnu hodnotu v množine. Preto program upravíme tak, aby sme do množiny pridávali len korektné hodnoty do 250:

var
  M: set of 1..250;
  I: Integer;
begin
  M := [1];
  for I := 1 to 124 do
    if I in M then
    begin
      M := M + [2 * I + 1];           // 2*I+1 je vždy z 1..250
      if 3 * I + 1 <= 250 then        // ak je aj 3*I+1 z 1..250,
        M := M + [3 * I + 1];         // pridáme ho do množiny
    end;
  for I := 1 to 250 do
    if I in M then
      Write(I, ' ');
  ReadLn;
end.



Rekurzívne hľadanie v množine čísel



Teraz si ukážeme, ako môžeme zistiť, či nejaké číslo patrí do tejto množiny alebo nie aj bez toho, aby sme najprv museli túto množinu skonštruovať. Napíšeme logickú funkciu Test, ktorá pre zadané číslo vráti True alebo False, podľa toho, či je alebo nie je v množine. Táto bude pracovať takto:

  • ak chceme skontrolovať nejaké malé číslo (napr. 0 alebo 1), tak to vieme povedať hneď: 0 nie a 1 áno ==> toto je vlastne triviálny prípad
  • inak, ak je to číslo tvaru 2I+1, t.j. po delení 2 dáva zvyšok 1, potom stačí skontrolovať, či je v množine číslo I
  • inak, ak to neplatí skontrolujeme druhý prípad: ak je to číslo tvaru 3I+1, t.j. po delení 3 dáva zvyšok 1, potom stačí skontrolovať, či je v množine číslo I
  • inak to určite v množine nebude

Zapíšme tento algoritmus:

function Test(I: Integer): Boolean;
begin
  if I = 0 then
    Result := False
  else if I = 1 then
    Result := True
  else if (I mod 2 = 1) and Test(I div 2) then
    Result := True
  else if (I mod 3 = 1) and Test(I div 3) then
    Result := True
  else
    Result := False;
end;

Všimnite si dva triviálne prípady a dve rôzne rekurzívne volania funkcie Test.

Túto funkciu môžeme zapísať aj "úspornejšie" napr. takto:

function Test(I: Integer): Boolean;
begin
  if I <= 1 then
    Result := I = 1
  else
    Result := (I mod 2 = 1) and Test(I div 2) or
              (I mod 3 = 1) and Test(I div 3);
end;


Realizácia množiny

Pascalovské množiny sú v pamäti počítača reprezentované ako postupnosť bitov, t.j. postupnosť 0 a 1. Napr. pre set of 0..99 je vyhradených 100 bitov, t.j. 13 bajtov. V i-tom bite je buď 0, ak i nepatrí do množiny alebo 1, ak i patrí do množiny. Priradenie A := []; vynuluje všetky bity. Priradenie A := [5, 7, 8]; nastaví na 1 iba bity 5, 7, 8, ostatné vynuluje. Množinová operácia A+B postupne ide po bitoch v oboch postupnostiach A aj B a robí operáciu binárne OR, t.j. ak aspoň v jednej z nich je 1, tak aj vo výsledku bude 1. Pre množiny set of TBaza musí platiť: 0 <= Low(TBaza) <= High(TBaza) <= 255. To znamená, že takto nevyrobíme množiny s viac ako 256 prvkami. Najväčšia možná množina set of Byte zaberá 32 bajtov.

Množiny, pre ktoré High(TBaza) <= 31, t.j. ktoré zaberajú len bity od 0. po max 31. sa v pamäti ukladajú do 4 bajtov a teda sú rovnako veľké ako typ Integer. Všetky väčšie množiny zaberajú 32 bitov. 4-bajtové množiny môžeme pretypovať na 4-bajtové celé čísla (napr. Integer) a naopak, Celé čísla môžeme pretypovať na 4-bajtové množiny. Napr.

type
  TMnoz = set of 0..31;
var
  I, J: Integer;
  M: TMnoz;
  S: string;
begin
  WriteLn(Integer([2, 4, 7]));   // celé číslo %10010100, t.j. 148
  I := 1706;                     // 1706 = %1101010101
  for J in TMnoz(I) do           // množina [1, 3, 5, 7, 9, 10]
    Write(J, ',');
  WriteLn;
  S := '';
  for J in [0..10] do
    if J in TMnoz(I) then        // zístí, či je J-ty bit 1
      S := '1' + S
    else
      S := '0' + S;
  WriteLn(I, ' = %', S);
  M := [1, 2, 6];
  M := TMnoz(Integer(M) << 1);
  for J in M do
    Write(J, ',');
  WriteLn;


Väčšie množiny ako 256 prvkov môžeme reprezentovať pomocou poľa množín - budeme tomu hovoriť "veľké množiny". Napr. ak by sme potrebovali množinu s 1000 prvkami, t.j. postupnosť 1000 bitov, položíme tesne za seba 4 množiny po 256 prvkoch a budeme predpokladať, že

  • v prvej množine budú prvky od 0 do 255
  • v druhej množine budú prvky od 256 do 511 - budú ale posunuté tak, že 256 bude mať v druhej množine číslo 0, t.j. o 256 menej
  • v tretej množine budú prvky od 512 do 767 - prvky budú posunuté o 512
  • ...

Aby sa nám s takýmito veľkými množinami čo najpohodlnejšie pracovalo, pole množín budeme indexovať od 0: potom pre prvok X ľahko vypočítame poradové číslo množiny ako X div 256 a jeho posunuté číslo v tejto množine ako X mod 256. Ak chceme pridať prvok do množiny, alebo zistiť, či nejaké číslo patrí do množiny zapíšeme:

var
  M: array [0..Max] of set of 0..255;
  X: Integer;
...
// pridávame x do takejto množiny:
  M[X div 256] := M[X div 256] + [X mod 256]
// zistíme, či je x v množine:
  if (X mod 256) in M[X div 256] then ...

Operátor in má rovnakú prioritu ako všetky relačné operátory a preto by sme X mod 256 nemuseli písať do zátvoriek - tu sme to zapísali, aby to bolo čitateľnejšie.

Teraz môžeme prepísať predchádzajúci príklad s konštruovaním množiny pre veľkú množinu. Vytvoríme ju z 20 obyčajných 256-prvkových množín, t.j. zmestí sa nám 20*256 prvkov, t.j. čísla od 0 do 5119.

type
  TMnozina = array [0..19] of set of Byte;
var
  M: TMnozina;
  I, J :Integer;
begin
  M[0] := [1];
  for I := 1 to 19 do
    M[I] := [];
  for I := 1 to 2559 do
    if (I mod 256) in M[I div 256] then
    begin
      J := 2 * I + 1;
      M[J div 256] := M[J div 256] + [J mod 256];
      J := 3 * I + 1;
      if J div 256 <= 19 then
        M[J div 256] := M[J div 256] + [J mod 256];
    end;
  for I := 1 to 5119 do
    if (I mod 256) in M[I div 256] then
      Write(I, ' ');
  ReadLn;
end.

Takéto riešenie už nie je tak jednoducho čitateľné, ako riešenie s obyčajnými množinami. Vytvorme si preto sadu pomocných podprogramov na prácu s veľkými množinami:

type
  TMnozina = record
    M: array [0..100] of set of Byte;
    Max: Integer;     // maximálne prípustné číslo v množine
  end;
 
procedure InicMn(var Mn: TMnozina);
var
  I: Integer;
begin
  with Mn do
  begin
    Max := Length(M) * 256 - 1;    // Length(M) - počet prvkov poľa M
    for I := 0 to High(M) do
      M[I] := [];
  end;
end;
 
procedure PridajMn(var Mn: TMnozina; I: Integer);
begin
  with Mn do
    if (I >= 0) and (I <= Max) then
      M[I div 256] := M[I div 256] + [I mod 256];
end;
 
function VMn(const Mn: TMnozina; I: Integer): Boolean;
begin
  if (I < 0) or (I > Mn.Max) then
    Result := False
  else
    Result := (I mod 256) in Mn.M[I div 256];
end;
 
function PocetMn(const Mn: TMnozina): Integer;  // počet prvkov
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Mn.Max do
    if VMn(Mn, I) then
      Inc(Result);
end;
 
function TextMn(const Mn: TMnozina): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Mn.Max do
    if VMn(Mn, I) then
      Result := Result + IntToStr(I) + ', ';
  if Result <> '' then                    // ak množina nie je prázdna,
    SetLength(Result, Length(Result) - 2);   // vyhoď posledné 2 znaky
  Result := '[' + Result + ']';
end;
 
procedure VsetkyMn(var Mn: TMnozina);
var
  I: Integer;
begin
  for I := 0 to High(Mn.M) do
    Mn.M[I] := [0..255];
end;
 
procedure UberMn(var Mn: TMnozina; I: Integer);
begin
  with Mn do
    if (I >= 0) and (I <= Max) then
      M[I div 256] := M[I div 256] - [I mod 256];
end;

Teraz prepíšeme program na konštruovanie množiny:

var
  Mn: TMnozina;
  I: Integer;
begin
  InicMn(Mn);
  PridajMn(Mn, 1);
  for I := 1 to (Mn.Max - 1) div 2 do
    if VMn(Mn, I) then
    begin
      PridajMn(Mn, 2 * I + 1);
      // if 3 * I + 1 <= Mn.Max then  // otestuje to PridajMn
        PridajMn(Mn, 3 * I + 1);
    end;
  WriteLn(TextMn(Mn));
  WriteLn('pocet prvkov = ', PocetMn(Mn));
  ReadLn;
end.



Príklad - Eratostenovo sito



Grécky matematik Eratostenes už pred viac ako 2200 rokmi popísal algoritmus na hľadanie prvočísel:

  • zapíšme si do radu postupnosť celých čísel od 2 po nejaké maximum
  • zoberme prvé číslo (teda 2) - označme ho a všetky jeho násobky vyškrtnime
  • zoberme ďalšie ešte nevyškrtnuté číslo (teda 3) - a urobme to isté, t.j. označme ho a vyškrtnime všetky jeho násobky
  • toto opakujme, kým nie sú všetky čísla buď označené alebo vyškrtnuté

To čo ostane označené, sú prvočísla. Naprogramujme tento algoritmus najprv pomocou obyčajnej množiny:

var
  M: set of Byte;
  I, J: Integer;
begin
  M := [2..255];
  for I := 2 to 255 do
    if I in M then
    begin
      J := 2 * I;
      while J <= 255 do
      begin
        M := M - [J];
        Inc(J, I);
      end;
    end;
 
  for I := 0 to 255 do
    if I in M then
      Write(I, ' ');
  ReadLn;
end.

A teraz pomocou pomocných podprogramov s veľkou množinou:

var
  Mn: TMnozina;
  I, J: Integer;
begin
  InicMn(Mn);
  VsetkyMn(Mn);
  UberMn(Mn, 0);
  UberMn(Mn, 1);
  for I := 2 to Mn.Max div 2 do
    if VMn(Mn, I) then
    begin
      J := I + I;
      while J <= Mn.Max do
      begin
        UberMn(Mn, J);
        Inc(J, I);
      end;
    end;
  WriteLn(TextMn(Mn));
  WriteLn('pocet prvkov = ', PocetMn(Mn));
end.


Udalosti od klávesnice

S klávesnicou pracujeme pomocou týchto troch udalostí:

  • onKeyDown - práve bol zatlačený nejaký kláves
  • onKeyUp - práve bol pustený nejaký kláves
  • onKeyPress - stlačili sme "obyčajný" kláves (ktorý má svoj ASCII kód)

Prvé dve udalosti oznámia nie ASCII kód klávesu ale "virtuálny kód" (v unite LCLType si pozrite mená kódov) a tiež v parametri Shift zistíme, či bol pri tom zatlačený napr. kláves <Shift> alebo <Ctrl> (podobne ako pri udalostiach pri práci s myšou).


Nasledujúci program ukáže jednoduché použitie klávesnice. Najprv do formulára umiestnime len jeden komponent Label1: v inšpektore objektov mu priradíme nejaký zväčšený text (napr. Caption = 'Pascal' a Font.Height = 24). Ďalej v inšpektore objektov v záložke Udalosti pre celý formulár zvolíme udalosť onKeyDown. Vytvorí sa metóda TForm1.FormKeyDown, do ktorej dopíšeme:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    vk_left:  Label1.Left := Label1.Left - 1;
    vk_right: Label1.Left := Label1.Left + 1;
    vk_up:    Label1.Top := Label1.Top - 1;
    vk_down:  Label1.Top := Label1.Top + 1;
  end;
end;

Keďže používame mená virtuálnych kódov (vk_left, vk_right, vk_up, vk_down), musíme do zoznamu používaných unitov (uses) pridať aj jednotku LCLType.

Po spustení programu vidíme, že textový komponent sa pomaly pohybuje po formulári podľa toho, ako tlačíme klávesy šípok. Dokonca, keď podržíme niektorú šípku, vďaka autorepeatu v operačnom systéme, dostávame opakované udalosti onKeyDown a tým sa text posúva zadaným smerom.

Mohli by sme namiesto identifikátorov virtuálnych kódov používať len číselné konštanty a vtedy by sme nemuseli pridávať používanie unitu LCLType. Program by bol teraz ale menej čitateľný:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    37: Label1.Left := Label1.Left - 1;
    39: Label1.Left := Label1.Left + 1;
    38: Label1.Top := Label1.Top - 1;
    40: Label1.Top := Label1.Top + 1;
  end;
end;



Použitie časovača



Oveľa elegantnejšie riešenie, ktoré nebude závislé od autorepeatu, využije časovač: pripravíme dve globálne premenné DX a DY, ktoré budú mať hodnoty <-1, 0, 1> podľa toho, aké šípky tlačíme. A časovač bude v nejakých intervaloch posúvať tento komponent v závislosti týchto hodnôt. Všimnite si, že teraz okrem udalosti onKeyDown využívame aj udalosť onKeyUp:

var
  DX, DY: Integer;  // môžeme predpokladať, že sú inicializované na 0
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  with Label1 do
  begin
    Left := Left + DX;
          // nedá sa urobiť Inc(Left, DX); lebo Left nie je premenná
    Top := Top + DY;
  end;
end;
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    vk_left:   DX := -1;
    vk_right:  DX := 1;
    vk_up:     DY := -1;
    vk_down:   DY := 1;
  end;
end;
 
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    vk_left,
    vk_right:  DX := 0;
    vk_up,
    vk_down:   DY := 0;
  end;
end;

Niektoré komponenty vo formulári môžu robiť problémy pri spracovávaní udalostí od klávesnice. Napr. TEdit, TMemo, ale aj TButton odchytávajú udalosti od klávesnice a snažia sa ich sami spracovať. Preto, ak sú vo formulári niektoré z týchto komponentov, nebudú fungovať žiadne udalosti s klávesnicou pre samotný formulár. Najjednoduchším riešením pre aplikácie, ktoré chcú odchytávať klávesnicu, je tieto komponenty nepoužívať. Napr. TButton sa dá nahradiť komponentom TSpeedButton.

Iným riešením by mohlo byť preposlanie udalosti od problémového komponentu do formulára, napr. ak máme vo formulári tlačidlo Button1, pridáme dve metódy:

procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  FormKeyDown(Sender, Key, Shift);
end;
 
procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  FormKeyUp(Sender, Key, Shift);
end;



Písanie do grafickej plochy



Napíšme aplikáciu, v ktorej budeme text zadávaný z klávesnice vypisovať do grafickej plochy Image1. Kláves <Enter> posunie kurzor o riadok nižšie. Tento príklad ilustruje použitie onKeyPress. Najpr zapíšme zjednodušenú verziu programu:

var
  X, Y: Integer;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  X := 20;
  Y := 20;
  with Image1, Canvas, Font do
  begin
    FillRect(ClientRect);
    Name := 'Arial';
    Height := 40;
    Style := [fsBold];
    Brush.Style := bsClear;
  end;
end;
 
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key >= ' ' then
  begin
    Image1.Canvas.TextOut(X, Y, Key);
    Inc(X, 20);
  end;
  if Key = #13 then
  begin
    X := 20;
    Inc(Y, 40);
  end;
end;

Napriek tomu, že rôzne písmená sú rôzne široké, program posúva ich výpis o konštantnú šírku (posun Inc(X, 20)).

Druhá verzia ukazuje, ako môžeme zobrazovať textový kurzor, zároveň používa metódu TextExtend, pomocou ktorej zistí šírku a výšku vypisovaného znaku. Druhá verzia má proporčné písmo a tiež vykresľuje textový kurzor. Keďže pre prácu s výsledkom TextExtend využívame typ TSize, musíme do uses pridať unit Types.

var
  X, Y: Integer;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  X := 20;
  Y := 20;
  with Image1, Canvas, Font do
  begin
    FillRect(ClientRect);
    Name := 'Arial';
    Height := 40;
    Style := [fsBold];
    Brush.Style := bsClear;
    MoveTo(X, Y);
    LineTo(X, Y + Height);
  end;
end;
 
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
var
  Size: TSize;
begin
  with Image1.Canvas do          // zmaže kurzor
  begin
    Pen.Color := clWhite;
    MoveTo(X, Y);
    LineTo(X, Y + Font.Height);
  end;
  if Key >= ' ' then
  begin
    Image1.Canvas.TextOut(X, Y, Key);
    Size := Image1.Canvas.TextExtent(Key);
    Inc(X, Size.cx);
    if X > Image1.Width-20 then
      Key := #13;
  end;
  if Key = #13 then
  begin
    X := 20;
    Size := Image1.Canvas.TextExtent('M');
    Inc(Y, Size.cy);
  end;
  with Image1.Canvas do         // nakreslí kurzor
  begin
    Pen.Color := clBlack;
    MoveTo(X, Y);
    LineTo(X, Y + Font.Height);
  end;
end;

Uvedomte si, že zápis

Size := Image1.Canvas.TextExtent(Key);
Inc(X, Size.Cx);

by sme mohli zapísať aj skrátene

Inc(X, Image1.Canvas.TextExtent(Key).Cx);

Ďalšie námety

  • zrealizujte kláves <Backspace> - treba si pamätať každý zapísaný znak (napr. v niečom podobnom ako zásobník) - aby sme ho mohli zmazať, treba vedieť jeho pozíciu a buď jeho hodnotu alebo veľkosť


Aplikácia skicár

Postupne predvedieme vytváranie jednoduchej kresliacej aplikácie. Najprv do formulára vložíme grafickú plochu (Image1) a nad plochu tlačidlo s textom zmaž (Button1). Prvá verzia programu môže vyzerať takto:

var
  Kreslim: Boolean = False;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Click;                  // zmaže sa grafická plocha
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  with Image1, Canvas do   // medzi Image1 a Canvas je čiarka
  begin
    Brush.Color := clWhite;
    Brush.Style := bsSolid;
    FillRect(ClientRect);  // ClientRect patrí Image1 a nie pre Canvas
  end;
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Kreslim := ssLeft in Shift;
  if Kreslim then
    Image1.Canvas.MoveTo(X, Y);
end;
 
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:Integer);
begin
  if Kreslim then
    Image1.Canvas.LineTo(X, Y);
end;
 
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Kreslim := False;
end;



Paleta farieb



Druhým krokom bude pridanie farebnej palety do aplikácie. Zrejme v každom grafickom programe by mala byť možnosť zvoliť si farbu kreslenia kliknutím do nejakej farby v ponuke farieb. Do formulára najprv položíme novú menšiu grafickú plochu Image2 (napr. veľkosti 223x31) - položíme ju tesne nad Image1 a vložíme do nej nejaký obrázok palety. Môžete použiť napr. túto bitmapu

bitmapa palety

Pred Image2 položíme ďalšiu malú plôšku Image3 (veľkosti 25x25) - sem sa bude vykresľovať aktuálna zvolená farba - pri štarte programu bude čierna. Ďalej zabezpečíme, že kliknutím do Image2 sa zvolí farba kresliaceho pera, t.j. nastaví sa farba pera pre Image1 a zafarbí sa Image3:

procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Image1.Canvas.Pen.Color := Image2.Canvas.Pixels[X, Y];
  with Image3, Canvas do
  begin
    Brush.Color := Image1.Canvas.Pen.Color;
    FillRect(ClientRect);
  end;
end;

Ešte treba zafarbiť Image3 už pri štarte programu, t.j. do FormCreate pridáme jeho zafarbenie:

procedure TForm1.FormCreate(Sender: TObject);
begin
  ...
  with Image3, Canvas do
  begin
    Brush.Color := Image1.Canvas.Pen.Color;
    FillRect(ClientRect);
  end;
end;



Nastavenie hrúbky pera



Na nastavenie hrúbky pera použijeme posúvač, napr. komponent TrackBar. Položíme ho naľavo od Image3 a trochu prispôsobíme jeho veľkosť voľnej ploche vo formulári. Zmeníme aj dve jeho stavové premenné (property) Min a Max, ktoré vyjadrujú minimálnu a maximálnu dosiahnuteľnú hodnotu pre posúvač - v inšpektore objektov nastavíme Min na 1 a Max napr. na 20. Pre tento komponent využijeme udalosť onChange, ktorá je zavolaná vždy, keď používateľ posúva bežca na lište: podľa momentálnej pozície bežca budeme nastavovať hrúbku pera grafickej plochy. onChange procedúra sa automaticky pripraví dvojklikom na komponent vo formulári. Spracovanie nastavovania hrúbky pera:

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Image1.Canvas.Pen.Width := TrackBar1.Position;
end;



Tlačidlá nástrojov kreslenia



Každý aj najjednoduchší kresliaci program umožňuje kresliť rôznymi nástrojmi, napr. nielen voľné kreslenie perom, ale aj úsečky, obdĺžniky, elipsy ale aj vypĺňanie oblasti nejakou farbou. Zadefinujeme 5 malých tlačidiel - komponentov SpeedButton. Tieto majú na rozdiel od klasického Button viac vylepšení: napr. keď na ne klikneme, môžu ostať zatlačené (potom to vyjadruje zvolený nástroj) a tiež okrem textu môžu obsahovať obrázok (poexperimentujte s vlastnosťou Glyph). Tieto tlačidlá môžeme zoskupiť do skupiny, v ktorej iba jedno z nich bude zatlačené - zatlačenie iného spôsobí automatické vyskočenie predchádzajúceho. Preto do stavovej premennej (property) GroupIndex všetkým nastavíme rovnaké číslo 1. Na tlačidlá napíšeme texty (je vhodné zvoliť nejaký malý font): pero, úsečka, obdĺžnik, elipsa, vyplň. Prvému tlačidlu (s textom pero) nastavíme stavovú premennú Down na True, t.j. toto tlačidlo bude zatlačené už pri štarte programu. Zadefinujeme aj globálnu premennú Rezim, ktorá bude obsahovať momentálne zvolený nástroj - táto premenná sa bude nastavovať v udalosti onClick pre všetky SpeedButton1, SpeedButton2, ...

var
  Rezim: (rePero, reUsecka, reObdlznik, reElipsa, reVypln) = rePero;
 
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Rezim := rePero;
end;
 
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  Rezim := reUsecka;
end;
 
...

Asi by bolo krajšie, keby sme nemuseli vytvárať pre každé tlačidlo zvlášť procedúru (v inej aplikácii by ich mohlo byť oveľa viac) - ale napísali by sme jednu univerzálnu, napr. procedúra SpeedButton1Click by mohla byť spoločná pre všetky. Potom, ako je zadefinovaná pre SpeedButton1, ju nastavíme aj všetkým ostatným tlačidlám nástrojov: v záložke udalosti (Events) inšpektora objektov pre SpeedButton2 sa nastavíme na riadok s udalosťou onClick, nedvojklikneme ale z ponuky vyberieme SpeedButton1Click - toto urobíme pre všetky tlačidlá nástrojov (ak sme už stihli vytvoriť SpeedButton2Click, ... - zrušíme ho tak, že vyprázdnime telo procedúry a po uložení - Save unit - sa korektne zruší celá procedúra). SpeedButton1Click teraz na základe parametra Sender zistí, ktorý komponent ju zavolal a na základe toho nastaví premennú Rezim. Teraz už univerzálna procedúra SpeedButton1Click môže vyzerať takto:

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if Sender = SpeedButton1 then
    Rezim := rePero
  else if Sender = SpeedButton2 then
    Rezim := reUsecka
  else if Sender = SpeedButton3 then
    Rezim := reObdlznik
  else if Sender = SpeedButton4 then
    Rezim := reElipsa
  else if Sender = SpeedButton5 then
    Rezim := reVypln;
end;

Skôr ako sa pustíme do upravovania procedúr Image1MouseDown a Image1MouseMove, aby zvládali nové nástroje, musíme vysvetliť ako budú pracovať. Úsečka, obdĺžnik a elipsa budú pracovať na veľmi podobnom princípe - pri štarte nástroja (teda zatlačení ľavého tlačidla myši) sa zapamätá momentálny obsah grafickej plochy v pomocnej bitmape Bmp (globálna premenná typu TBitmap) a pri každom ťahaní nástroja, napr. úsečky, sa najprv grafická plocha vráti do tohto pôvodného stavu a potom sa nakreslí nová úsečka. Pritom si budeme pamätať počiatočný bod kreslenia v globálnych premenných X0 a Y0. Pomocná premenná Bmp sa musí inicializovať vo FormCreate.

Režim vypĺňania oblasti je ešte jednoduchší: celý sa zrealizuje pri zatlačení tlačidla myši, t.j. v Image1MouseDown (hoci by mohol byť napr. len v Image1MouseUp - premyslite si, čo by sa tým zmenilo). Na vypĺňanie oblasti použijeme metódu FloodFill.

var
  Kreslim: Boolean = False;
  Rezim: (rePero, reUsecka, reObdlznik, reElipsa, reVypln) = rePero;
  Bmp: TBitmap;
  X0, Y0: Integer;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Click;                  // zmaže sa grafická plocha
  with Image3, Canvas do
  begin
    Brush.Color := Image1.Canvas.Pen.Color;
    FillRect(ClientRect);
  end;
  Bmp := TBitmap.Create;
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Kreslim := ssLeft in Shift;
  if Kreslim then
    with Image1.Canvas do
      case Rezim of
        rePero:
          MoveTo(X, Y);
        reUsecka, reObdlznik, reElipsa:
          begin
            Bmp.Assign(Image1.Picture);
            X0 := X;
            Y0 := Y;
          end;
        reVypln:
          begin
            Brush.Color := Pen.Color;
            Brush.Style := bsSolid;
            FloodFill(X, Y, Pixels[X,Y], fsSurface);
          end;
      end;
end;
 
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if Kreslim then
    with Image1.Canvas do
      case Rezim of
        rePero:
          LineTo(X, Y);
        reUsecka:
          begin
            Draw(0, 0, Bmp);
            MoveTo(X0, Y0);
            LineTo(X, Y);
          end;
        reObdlznik:
          begin
            Draw(0, 0, Bmp);
            Brush.Style := bsClear;
            Rectangle(X0, Y0, X, Y);
          end;
        reElipsa:
          begin
            Draw(0, 0, Bmp);
            Brush.Style := bsClear;
            Ellipse(X0, Y0, X, Y);
          end;
      end;
end;



Zaškrtávacie políčko



Ešte urobíme posledné vylepšenie: umožníme používateľovi programu aby si mohol zvoliť, či obdĺžnik, resp. elipsa budú pri vykreslení vyplnené farbou (zatiaľ sme ich vyrobili "deravé" - nastavili sme Brush.Style := bsClear;). Do formulára vložíme ešte jeden komponent: zaškrtávacie políčko CheckBox. Nastavíme mu popis (Caption) na slovo "plný" a opravíme v metóde Image1MouseMove kreslenie obdĺžnika a elipsy:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  ...
        reObdlznik:
          begin
            Draw(0, 0, Bmp);
            Brush.Color := Pen.Color;
            if CheckBox1.Checked then
              Brush.Style := bsSolid
            else
              Brush.Style := bsClear;
            Rectangle(X0, Y0, X, Y);
          end;
        reElipsa:
          begin
            Draw(0, 0, Bmp);
            Brush.Color := Pen.Color;
            if CheckBox1.Checked then
              Brush.Style := bsSolid
            else
              Brush.Style := bsClear;
            Ellipse(X0, Y0, X, Y);
          end;
      end;
end;

Rozloženie komponentov môže byť napr. takéto:

rozloženie komponentov aplikácie skicár



Zhrnutie



Stavové premenné komponentov (vidíme ich v Inšpektore objektov) sú podobné položkám záznamu (record). Pri ich zmene v inšpektore objektov sa automaticky prejaví aj ich vizuálna zmena vo formulári (napr. šírka, text, bublinkový help a pod.). Vo Free Pascale sa takýto typ stavových premenných nazýva Vlastnosť, t.j. Property. Niektoré sú pre nás užitočné už počas tvorby formulára (Caption, Name, Hint, Width, Min, Max, ...), iné využijeme hlavne za behu programu (niektoré fungujú len za behu, a preto v inšpektore objektov nie sú). Meno komponentu (Name) treba zmeniť (ak ho z nejakých dôvodov zmeniť chceme) hneď ako sa položí do formulára, inak sa niektoré situácie nemusia správne uhádnuť a opraviť túto zmenu korektne. Vymenujme niektoré užitočné vlastnosti (property) nám známych komponentov:

  • formulár TForm
    • Caption - string - titulok okna
    • ClientWidth, ClientHeight - veľkosť vnútra okna (nie obvodu okna, pre ten je veľkosť Width a Height)
    • Left, Top - x-ová a y-ová súradnica okna na obrazovke - môžeme celé okno posúvať
    • Visible - či je okno viditeľné
    • WindowState - okno môžeme zminimalizovať, zmaximalizovať
    • Canvas (funguje len počas behu programu) - šedá plocha - môžeme do nej kresliť (v udalosti OnPaint)
  • tlačidlo TButton
    • Caption - text na tlačidle
    • Font - rovnako ako v grafickej ploche
    • Height, Width - veľkosť tlačidla
    • Left, Top - poloha vo formulári
    • Visible - môžeme ho skryť - False znamená, že ho nebude vidieť
    • Hint, ShowHint - string a Boolean - bublinková nápoveď (help) a informácia o tom, či sa má zobrazovať
    • Enabled - tlačidlo môžeme zablokovať - False znamená, že tlačidlo bude zašedené

Všimnite si, že vlastnosti Width, Height, Left, Top, Visible, Hint, ShowHint, Enabled - fungujú skoro rovnako pre skoro všetky typy komponentov.

  • grafická plocha TImage
    • Canvas (funguje len počas behu programu) - sprístupnenie kreslenia do grafickej plochy
    • ClientRect (funguje len počas behu programu) - hodnota typu TRect, t.j. obdĺžnik, ktorý popisuje veľkosť plochy
  • malé tlačidlo TSpeedButton - veľmi podobné obyčajnému tlačidlu, ale tieto tlačidlá môžu tvoriť skupinu (vzájomne sa vylučujú - maximálne jedno z nich je zatlačené), môže mať aj obrázok
    • Caption - text na tlačidle (môže byť spolu s obrázkom)
    • GroupIndex - poradové číslo skupiny tlačidiel, ktoré sa navzájom vylučujú
    • Down - či je zatlačené
    • Glyph - obrázok na tlačidle
  • posuvná lišta TTrackBar
    • Min, Max - minimálna a maximálna hodnota
    • Position - momentálna hodnota
    • Orientation - (trHorizontal, trVertical)
  • zaškrtávacie políčko TCheckBox
    • Caption - text za políčkom
    • Font - písmo pre text
    • Checked - či je zaškrtnuté
  • text TLabel
    • Caption - ak reťazec obsahuje #13#10, bude viacriadkový
    • Font - písmo pre text
  • textová plocha TMemo
    • Color - farba podkladu
    • Font - písmo
    • Lines - obsah textovej plochy - pole reťazcov
    • ReadOnly - či má používateľ zakázané meniť obsah
  • editovací riadok TEdit - je veľmi podobný TMemo
    • Color - farba podkladu
    • Font - písmo
    • Text - momentálny obsah riadka
    • ReadOnly - či má používateľ zakázané meniť obsah
    • PasswordChar - ak má hodnotu napr. znak '*', tak sa namiesto zadávaných znakov budú vypisovať hviezdičky - používa sa pri zadávaní hesla

Udalosti (Events) môžeme definovať v záložke v inšpektora objektov. Slúžia na definovanie správania pri špecifických situáciách. Tieto situácie (napr. klikne sa, zmení sa, hýbe sa a pod.) väčšinou obsluhuje operačný systém a pomocou mechanizmu Udalostí umožňuje našej aplikácii obslúžiť tie, ktoré nás zaujímajú. Tie udalosti, pre ktoré nenapíšeme obslužnú procedúru, sa spracujú štandardným spôsobom - väčšinou nerobia nič (akokeby prázdne telo procedúry).

Na ich vytváranie odporúčame využiť mechanizmus inšpektora objektov, ktorý ich správne zadeklaruje: buď dvojklikneme v pravom stĺpci pri danej udalosti, alebo si zvolíme niektorú procedúru z už existujúcej ponuky procedúr. Ak potrebujete nejakú procedúru obsluhujúcu udalosť zrušiť, najlepšie to urobíte tak, že vyčistíte obsah procedúry - necháte v nej len počiatočný begin a koncový end a pri nasledujúcom uložení na disk (napr. Ctrl+S) sa automaticky vyhodia (musí byť zapnuté "Auto remove empty methods" v "Automatické vlastnosti" vo voľbách prostredia Lazarusu).


späť | ďalej