PDF created with pdffactory trial version kurak:boolean; end;

1. Datový typ záznam Zatím jsme pracovali se strukturovanýmtypem pole – ať už statickým, kde byl počet položek stanoven deklarací nebo dynamickým, položky musely být téhož typu. Připomeňme si práci s tabulkami v databázích – potřebujeme-li například údaje o osobách, budou některé položky textové (jméno, adresa…) jiné číselné (věk, plat IQ…) a ještě jiné logické /kuřák – nekuřák, pijan – abstinent…) Je pravdou, že bychom mohli úpodobný systém vytvořit pomocí několika polí, kde by jedna osoba měla vždy stejný index, ale práce s takovou strukturou by byla poněkud nepřehledná. Proto mají moderní jazyky strukturovaný datový typ, který umožňuje sloučit údaje různých typů – záznam. (Opět databázová reminiscence: sloupcům tabulky říkáme pole, řádkům – záznam, což je prakticky totéž.) Type T=record p1:T1; P2:T2; …………………….. Pn:Tn End; Ti – jakýkoliv typ včetně anonymního, pn – identifikátor položek Struktura je statická, to znamená, že počet položek je dán definicí typu. Existuje ještě záznam s variantní částí, který si opět necháme na později. Příklad: Type kniha=record Jmeno:string; Autor:string; Cena:integer; End;

Zpracování záznamů Po přístup k jednotlivým položkám se užívá tečkovaná notace. Var k:kniha Má položky k.jméno, k.autor, k.cena. Změna hodnoty proměnné se děje změnou hodnot jednotlivých položek. k.jmeno:=Hlava 22; if k.autor=‘Joseph Heller‘ then… k.cena:=k.cena*1.1; Příkaz with Zjednodušuje zápis akcí se záznamem. With k do Begin jmeno:=’Hlava 22’; Autor:= ‘Joseph Heller‘; Cena:=300; End; Poznámka: Určitě jste si uvědomili, že tečkovanou notaci od začátku používáme pro práci s komponentami. Button1.caption, edit1.text – ve skutečnosti jsou komponenty Delphi třídy, které kromě položek zahrnují jetě procedury a metody. I pro ně můžeme použít příkaz with: With button1 do Begin caption:=’Povyrostl jsem’; Width:=width+10; Height:=height+10; End;

Příklady Definujte typ Osoba s položkami: Jméno – řetězec, plat – celé číslo, kuřák – pravda nebo nepravda, rok – celé číslo (Dejme tomu rok nástupu do zaměstnání) Načtěte dynamické pole několika záznamů, zobrazte je do listboxu, zvyšte osobám zaměstnaným déle než 10 let plat o 10%, vyhledejte nejlépe placeného nekuřáka. Type osoba=record jmeno:string; plat:integer; rok:1950..2005; 1.

PDF created with pdfFactory trial version www.pdffactory.com

kurak:boolean; end; var p:integer; {počet osob v dynamickem poli} Form1: TForm1; zam: array of osoba; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin p:=0; end; procedure TForm1.Button1Click(Sender: TObject); begin setlength(zam,p+1); {pridavame jednu osobu} with zam[p] do begin jmeno:=edit1.text; plat:=StrToInt(edit2.text); rok:=StrToInt(edit3.text); kurak:=checkbox1.checked; edit1.clear; edit2.clear; edit3.clear; edit1.setfocus; end; inc(p); end; function pis(o:osoba):string; var kur:string; begin if o.kurak then kur:='kuřák' else kur:='nekuřák'; pis:=o.jmeno+' '+inttostr(o.rok)+' '+ inttostr(o.plat)+' '+kur; end; procedure TForm1.Button2Click(Sender: TObject); var i:integer; begin listbox1.clear; for i:=0 to high(zam) do listbox1.items.add(pis(zam[i])); end; procedure TForm1.Button3Click(Sender: TObject); var i:integer; begin for i:=0 to high(zam) do if zam[i].rok<1995 then zam[i].plat:=round(zam[i].plat*1.1); end; procedure TForm1.Button4Click(Sender: TObject); var ideal:osoba;i:integer; { v ideal si pamatujeme celou vyhledavanou osobu najednou} begin ideal.kurak:=false; ideal.plat:=0; for i:=0 to high(zam) do if not zam[i].kurak then if zam[i].plat>ideal.plat then ideal:=zam[i]; showmessage('Ideal je '+pis(ideal)); end;


Načítané údaje opticky spojíme umístěním na komponentu Panel, do pole přidáme další záznam stisknutím tlačítka. Pro zobrazení využijeme proceduru pis, která převede údaje záznamu na řetězec. Globální proměnná p bude obsahovat počet položek pole, inicializujeme ji v proceduře FormCreate, která je vůbec k dosazení výchozích hodnot ideální. 2. Definujte typ datum jako záznam ze tří celých čísel – den, měsíc a rok. Dále definujte typ osoba s položkami jméno – string a narozen – datum. Načtěte osobu a zobrazte zprávu zda má nebo nemá dnes narozeniny, má-li je, kolik je jí přesně let. K použití datových funkcí je třeba do klauzule uses unitu přidat jednotku DateUtils. Konstanta date vrací dnešní datum, funkce DayOfTheMonth(date) vrací pořadové číslo dne v měsíci, MonthOfTheYear(date) pořadové číslo měsíce v roce. (Jinak údaje o času a datu jsou reprezentovány, (viz Excel) jako reálné číslo, které udává kolik dní uplynulo od 30.12. 1899, takže si můžeme potřebné procedury naprogramovat sami.) datum=record den:1..31; mesic:1..12; rok:1900..2000; end; clovek=record jmeno:string; narozen:datum; end; var Form1: TForm1; x:clovek; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var d,m,r:integer; begin x.jmeno:=edit1.Text; x.narozen.den:=spinedit1.Value; x.narozen.mesic:=spinedit2.Value; x.narozen.rok:=spinedit3.Value; d:=DayOfTheMonth(date); m:=MonthOfTheYear(date); r:=YearOf(date); if (d=x.narozen.den) and (m=x.narozen.mesic) then showmessage(x.jmeno+' narodil se přesně před '+Inttostr(r-x.narozen.rok)+ 'lety') else showmessage(x.jmeno +' dnes nemá narozeniny'); end;

Cvičení: 1. Doplňte do příkladu o osobách tlačítka, která vypočítají průměrnou mzdu a naleznou služebně nejstaršího zaměstnance. 2. Definujte zlomek jako záznam, kde čitatel a jmenovatel jsou celočíselné hodnoty. Deklarujte pro něj procedury generuj (náhodně), piš (do listboxu ve tvaru x/z) zaktvar – převede zlomek na základní tvar. Řešení 1. procedure TForm1.Button5Click(Sender: TObject); var old:osoba; prum,i:integer; begin old.rok:=2008;prum:=0; for i:=0 to high(zam) do begin if zam[i].rok

prum:=zam[i].plat+prum; end; prum:=round(prum/(high(zam)+1)); showmessage('Nejdele je tu '+pis(old)); showmessage('Prum.plat je '+IntTostr(prum)); end; 2. procedure TForm1.Button2.Click(Sender: TObject); type zlomek=record cit,jmen:integer; end; procedure gen(var z:zlomek); begin z.cit:=random(100); z.jmen:=random(99)+1; end; procedure ukaz(z:zlomek); begin listbox1.Items.add(IntToStr(z.cit)+'/'+IntToStr(z.jmen)); end; function nsd(a,b:integer):integer; begin while a<>b do if a>b then a:=a-b else b:=b-a; nsd:=a; end; procedure zaktvar(var z:zlomek); var d:integer; begin d:=nsd(z.cit,z.jmen); z.cit:=z.cit div d; z.jmen:=z.jmen div d; end; var a:zlomek; begin randomize; gen(a); ukaz(a); zaktvar(a); ukaz(a); end;

2. Malování na canvas Tahle kapitola souvisí spíš s počítačovou grafikou, ke které se také důkladněji dostaneme, až se seznámíte s analytickou geometrií, teď ji spíš využijme pro opakování a zpestření příkladů na záznamy a přípravu na objekty. Každá komponenta umožňující práci s grafikou má vlastnost Canvas typu TCanvas. Ta vytváří pracovní plochu, na kterou se dá kreslit, případně pracovat s obrázky. Zatím budeme pracovat s canvasem formuláře, i když si nepamatuje obrázek. (Přetáhnete-li např. přes hotový obrázek jiné okno, obrázek se vygumuje. Pro práci s obrázky se pak používá komponenta Image, jejíž vlastnost picture pak jde uložit a načíst ze souboru.)

Některé metody a vlastnosti canvasu: Brush, color – barva výplně Pen.color – barva kreslicího pera Pen.width – tloušťka Moveto(x,y) – přesun na pozici x,y Lineto(x,y) – čára z aktuální pozice na pozici x,y Rectangle(a,b,c,d); – obdélník, a,b souřadnice levého horního, c,d pravého dolního rohu Elipse(a,b,c,d) – elipsa vepsaná tomuto obdélníku Pixels[x,y]:=clred; – bod o souřadnicích x,y se vybarví červeně. TextOut(x,y,’text’) – vypíše text na dané souřadnice. Vlatnosti textu – viz nápověda, font.


Font – font s dalšími vlastnostmi – style, (fsbold…), color, size… Souřadnice na formuláři: Levý horní roh: 0,0 Pravý horní roh: clientwidth,0 Levý dolní roh: 0,clientehight Pravý dolní roh: clientwidth, clienheight;

Myší události Mají některé komponenty jako formulář nebo panel. Patří sem stisknutí a uvolnění tlačítka myši, případně pohyb myši nad objektem. Stisknutí tlačítka myši procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Buton: které tlačítko bylo stisknuto (mbLeft, mbRight, mbMiddle) X,Y – souřadnice, na kterých bylo kliknuto Shift – udává, jestli byla stisknuta některá řídící klávesa (alt apod ) Pohyb myši nad objektem procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Uvolnění tlačítka myši procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

Příklady 1. Namalujte následující obrázek (např. při stisknutí tlačítka): Protože je zde používání tečkované notace poněkud pracné (canvas.pen.width:=20; canvas.Brush.Color:=clyellow;…) použijeme s výhodou příkaz with. Všimněme si, že s canvasem (podobně komponenty Delphi) pracujeme jako s jakýmsi předdefinovaným záznamem) procedure TForm1.Button1Click(Sender: TObject); begin with canvas do begin Pen.Color:=clblue; Pen.width:=20; Brush.Color:=clyellow; Rectangle(0,0,clientwidth,clientheight); Pen.Color:=clgreen; Pen.width:=10; moveto(0,clientheight div 2); lineto(clientwidth,clientheight div 2); moveto(clientwidth div 2,0); lineto(clientwidth div 2,clientheight ); Pen.Color:=clred; Pen.width:=20; ellipse(100,100,clientwidth -100,clientheight-100); end; end; 2. Umístěte na formulář nastavovací panel – z radiogroupu si vybereme barvu kreslicího pera, spineditem nastavíme rozměry útvaru a při stisknutí levého tlačítka myši zobrazíme na formulář elipsu, při stisknutí pravého tlačítka obdélník. (Do místa kliknutí) var a,b:integer; {globální proměnné} … procedure TForm1.Button2Click(Sender: TObject);


begin with canvas do begin case radiogroup1.itemindex of 0: pen.color:=clred; 1:pen.color:=clgreen; 2:pen.color:=clblue; end; end; a:=spinedit1.Value; b:=spinedit2.value; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button=mbleft {bylo stisknuto leve tlacitko} then canvas.Ellipse(x,y,x+a,y+b) else canvas.Rectangle(x,y,x+a,y+b); end; 3. Zobrazte na formulář řadu náhodně vybarvených čtverečků, nabírejte z nich barvu a kreslete myší po formuláři jako tužkou. var Form1: TForm1; kreslim:boolean; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var i,d: integer; begin d:=clientwidth div 20-1; for i:=0 to 20 do begin canvas.Brush.color:=random(clwhite); canvas.Rectangle(i*d,1,i*d+d,d); end; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin with canvas do if button=mbright {pravou mzsi nabirame barvu} then Pen.Color:=Pixels[x,y] else begin kreslim:=true; {budu kreslit a zacinam v tomto bode} moveto(x,y); end; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if kreslim then canvas.lineto(x,y); {byla-li stisknuto leve tlacitko mysi, kreslim} end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;


Shift: TShiftState; X, Y: Integer); begin kreslim:=false; {konec kresleni} end; procedure TForm1.FormCreate(Sender: TObject); begin kreslim:=false; {nejdriv nekreslim} end; end.

Cvičení 1. Nakreslete na formulář řadu soustředných kružnic, počet zadá uživatel. 2. Předkreslete si pravidelný obrázek z čar, obdélníků a elips a namalujte ho na canvas formuláře. Řešení 1. var i,n,d,r,sx,sy:integer; begin sx:=clientwidth div 2; sy:=clientheight div 2; n:=spinedit1.value; d:=round(200/n); r:=200; for i:=1 to n do begin canvas.ellipse(sx-r,sy-r,sx+r,sy+r); r:=r-d; end; end;

3. Malování se záznamy Když zobrazujeme geometrické útvary – čáry, elipsy, pravoúhelníky – mají všechny určité podobné vlastnosti jako barvu a sílu obrysu, polohu, rozměry… Příklady můžeme řešit užitím několika nezávislých proměnných – ale bylo by praktické vlastnosti jednotlivých objektů seskupit – a k tomu se hodí datový typ záznam. (Použili jsme termín objekt – ještě vhodnější bude objektový typ Delphi class, se kterým začneme pracovat příští hodinu.) Tak může být elipsa definována následujícím způsobem: {souřadnice levého horního rohu, výška a šířka, tloušťka a barva kreslicího pera) Type elipsa=record x,y,a,b,tl:integer; barva:Tcolor; end; … var ela:elipsa; procedure MalujElipsu(e:elipsa); {nakresli elipsu danych vlastnosti na canvas formulare} begin with form1.Canvas do begin pen.Color:=e.barva; pen.width:=e.tl; ellipse(e.x,e.y,e.x+e.a,e.y+e.b)


end; end; procedure TForm1.Button2Click(Sender: TObject); {nacteni vlastnosti podobne jako minule} begin with ela do begin case radiogroup1.itemindex of 0: barva:=clred; 1:barva:=clgreen; 2:barva:=clblue; end; tl:=spinedit1.Value; a:=spinedit2.Value; b:=spinedit3.value; end; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button=mbleft {bylo stisknuto leve tlacitko} then begin ela.x:=x; ela.y:=y; malujelipsu(ela); end end; Tento přístup nám také zjednoduší jednoduchou animaci elipsy, která bude spočívat v tom, že elipsu ukážeme, smažeme (nakreslíme barvou pozadí) a nakreslíme o kousek vedle. procedure zdrz(k:integer); var i,n:integer; {zpozdovaci smycka – for-cyklus, který nic nedela, ale dela to mnohokrat} begin n:=k*1000000; for i:=1 to n do; end; procedure TForm1.Button1Click(Sender: TObject); var i:integer; begin ela.y:=200;ela.a:=100;ela.b:=100; {elipsa, rp. kruznice se pohybuje vodorovne, takze se y nemeni a jeji rozmery rovnez ne} for i:=1 to clientwidth-100 do with ela do begin barva:=clblack; x:=i; malujelipsu(ela); {maluju cernou elipsu na nove pozici} zdrz(5) ; {ukazu ji} barva:=form1.Color; malujelipsu(ela); {namaluji ji barvou pozadi – zmizi} end; end;

Cvičení Vymyslete si složitější útvar, definujte ho jako záznam a nějakým způsobem animujte. Vyzkoušejte pohyb ve svislém směru, odražení od hrany formuláře, ruční nastavení rychlosti pohybu… Pro inspiraci: (Vaše budou lepší)


Type domek=record x,y,a,tl:integer; barva:Tcolor; end; var dom:domek; procedure MalujDomek(d:domek); begin with form1.canvas do begin with d do begin pen.Color:=barva; pen.width:=tl; rectangle (x,y,x+a,y+a); moveto(x,y); lineto(x+a div 2,y-a div 2); moveto(x+a,y); lineto(x+a div 2,y-a div 2); end; end; end; procedure TForm1.Button3Click(Sender: TObject); var i,j:integer; begin dom.x:=300;dom.a:=100;dom.tl:=3; for j:=1 to 5 do begin for i:=50 to clientheight-100 do with dom do begin barva:=clblack; y:=i; malujdomek(dom); zdrz(5); barva:=form1.Color; malujdomek(dom); end; for i:=clientheight-100 downto 50 do with dom do begin barva:=clblack; y:=i; malujdomek(dom); zdrz(5); barva:=form1.Color; malujdomek(dom); end; end; end;

4. Základní principy OOP – úvod Strukturované programování, kterým jsme se zabývali až dosud, se hodí spíš pro menší programové celky vytvářené jediným programátorem. Na tvorbě různých programových jednotek se sice může podílet více osob, ale při nezbytných úpravách hotových procedur se neobejdeme bez znalosti zdrojového kódu. Návrh datových struktur, procedur a funkcí je oddělen. Základní myšlenka OOP se dá zhruba vyjádřit následujícím způsobem: Program provádí určité akce s daty. Chceme-li, aby byl rozšiřitelný a opakovaně použitelný, je lepší jeho návrh založit spíš na datech než akcích. Data jsou obvykle dána a nepodléhají tolik změnám. Vývoj programu pak představuje úpravy starých a tvorbu nových akcí. Když budeme chtít charakterizovat určitý objekt reálného světa – třeba kočku, uvědomíme si, že má nějaké vlastnosti – velikost, barvu, drápy… ale také něco umí. (chytat myši, pít mléko…) Samozřejmě také myš je


objektem, (domácí, bílá, počítačová…) se svými metodami (prchnout před kočkou, prokousat se z bedýnky…) a myš a kočka při setkání komunikují – pomocí toho co umějí a mění své vlastnosti. (živá a mrtvá myš, sytá a hladová kočka …) Nejprve tedy navrhujeme objekty s jejich vlastnostmi (vlastní data), dovednostmi (procedury a funkce) a teprve potom tyto metody implementujeme. (Zde se ovšem bez strukturovaného programování neobejdeme) Program pak vzniká jako zápis komunikace mezi těmito objekty. Poznámka: (Připomeňme si Properties a Events v inspektoru objektů – komponenty Delphi jsou rovněž objekty Při řešení složitějších problémů umožňuje dosáhnout vyšší abstrakce a problém logicky rozčlenit. Program pracující s objekty (třídami) je přehlednější, třídy lze sdílet bez zacházení do detailů (znalost jejich zdrojového kódu)

Základní rysy: Zapouzdření Objekt obsahuje datové položky (vlastnosti) a procedury a funkce (metody), které s těmito položkami pracují. Navenek vystupuje jako celek, k vlastnostem přistupujeme výhradně prostřednictvím metod. Přístup k datům se dá omezit tak, aby k nim mohl přistupovat pouze oprávněný vlastník. Dědičnost Vlastnosti i metody se dědí z předka na potomka, nově vytvářený objekt může toto dědictví rozšiřovat a modifikovat, takže se vytváří hierarchický systém objektů. Jednou vytvořené rozhraní lze tedy opakovaně používat a tudíž se podstatně zvětšuje efektivita psaní programů. Polymorfismus Umožňuje zaměnitelnost objektů v rámci hierarchie. Určitá akce pak může být společná různým objektům hierarchie a její implementace pro různé objekty se může lišit. Tyto základní rysy si zatím ukážeme na jednoduchých příkladech, seznámíme se s objektovou hierarchií Delphi.

Datový typ class Type TJmeno=class(predek, existuje-li) P1: Typ P1; … constructor Create(seznam formalnich parametru); procedure Proc1(seznam formalnich parametru); … end; Základní datovou konstrukcí v OOP je třída. (class) – je to strukturovaný typ definovaný uživatelem. Uvnitř třídy definujeme : • Proměnné (vlastnosti, atributy) • Procedury a funkce (metody) Konvence: Jména tříd začínají písmenem T (TForm…) Instance třídy (objekt) – proměnná typu class Delphi užívají pro práci s objekty referenční model: deklarujeme-li instanci třídy, nevzniká objekt, ale pouze odkaz (reference) do paměti, kde je objekt uložen. Proto je nutné před prvním použitím instance objekty vytvořit, k tomu slouží metody, kterým se říká konstruktory. (místo klíčového slova procedure se používá constructor) Konstruktor vytvoří automaticky v paměti objekty příslušné třídy a podle naprogramovaných příkazů provede jejich inicializaci. Pokud inicializace není nutná, dá se použít konstruktor Create, který má každá třída vytvořen automaticky. K likvidaci objektů slouží destruktory, každá třída má automaticky destruktor destroy a free (viz nápověda). Příklad: Var x:TJmeno; {x je objekt (instance) třídy Tjmeno … x:=TJmeno.create(…) {vytvoření objektu, rezervování příslušné paměti} … x.free {zrušení objektu, uvolnění paměti}


Zapouzdření Uveďme si nejprve příklad – náš příklad pro práci se zlomky. Používali jsme zlomek jako záznam a definovali pro něj procedury a funkce. Teď tento datový typ nadefinujeme jako třídu, která ve své definici zahrne (zapouzdří) i své metody, nadeklarujeme proměnnou – objekt(instanci) této třídy a vyzkoušíme si práci s ním. Budeme teď dodržovat běžnou konvenci – identifikátor typu začíná písmenem T. type Tzlomek=class {Za klíčovým slovem class může být v závorce uveden předek naší třídy (dále), jinak je třída v Delphi potomkem třídy TObject, od které může dědit například konstruktor create cit, jmen:integer; Tento typ bude mít dvě datové položky – celočíselného čitatele a jmenovatele} constructor create(c,j:integer); {jednak vyhradí paměť a vytvoří ukazatele na ni, jednak provede dosazení výchozích hodnot, což musíme naprogramovat} procedure pis; {zapíše zlomek do listboxu} function realc:real; {převede zlomek na reálné číslo) procedure nasob(k:integer); {vynásobí zlomek rálným číselm} procedure zaktvar; { převede zlomek na základní tvar] end; {definice je podobná typu záznam, navíc zde jsou procedury a funkce} var Form1: TForm1; implementation {$R *.dfm} constructor Tzlomek.create(c,j:integer); {u názvu implementace metody je třeba uvést také její identifikátor s tečkovanou notací, aby bylo jasné, které třídě metoda patří} begin cit:=c;jmen:=j; {protože se nacházíme v metodě třídy TZlomek, můžeme se na položky odkazovat pouze jejich jménem, podobně jako uvnitř příkazu with.} end; procedure Tzlomek.pis; begin Form1.listbox1.items.add(IntTostr(cit)+'/'+IntTostr(jmen)); {protože nejsme v metodě formuláře, je třeba se na listbox1., který je položkou formuláře odkazovat přes Form1, jinak překladač hlásí chybu neznámý identifikátor} end; function Tzlomek.realc; begin realc:=cit/jmen; end; procedure Tzlomek.nasob(k:integer); begin cit:=cit*k; end; function nsd(a,b:integer):integer; begin while a<>b do if a>b then a:=a-b else b:=b-a; nsd:=a; end; procedure Tzlomek.zaktvar; var d:integer; begin d:=nsd(cit,jmen); cit:=cit div d; jmen:=jmen div d; end;


procedure TForm1.Button1Click(Sender: TObject); var x:Tzlomek; a,b:integer; { x je instance třídy TZlomek} begin randomize; a:=random(100); b:=random(99)+1; x:=Tzlomek.create(a,b); {vytvoření instance za použití konstruktoru} x.pis; x.nasob(3); x.pis; x.zaktvar; x.pis; listbox1.items.add(floattostr(x.realc) x.free; {uvolneni pameti} end; Místo tečkované notace můžeme použít příkaz with: With x do Begin pis; nasob;….free; end;

Cvičení: Připravte si podobný systém pro práci s komplexními čísly: procedury create, piš (v algebraickém tvaru), vytvoření komplexně sdruženého čísla, výpočet absolutní hodnoty, násobení reálným číslem, případně převod na goniometrický tvar a zápis v něm.

Řešení: uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,Math; {kvuli arcsin} Type… Tkomplex=class re,im:real; constructor create(r,i:real); procedure pis; procedure sdruz; function abshod:real; procedure gon(var ab,fi:real); end; … constructor Tkomplex.create(r,i:real); begin re:=r; im:=i; end; procedure Tkomplex.pis; begin if im>= 0 then form1.listbox1.items.add(Floattostrf(re,fffixed,2,2) + '+ '+floattostrf(im,fffixed,2,2)+'i') else form1.listbox1.items.add(Floattostrf(re,fffixed,2,2) + '- '+floattostrf(-im,fffixed,2,2)+'i') end; procedure Tkomplex.sdruz; begin im:=-im; end; function Tkomplex.abshod:real; begin abshod:=sqrt(sqr(re)+sqr(im)); end; procedure Tkomplex.gon(var ab,fi:real); begin ab:=abshod; if abshod=0


then fi:=0 else if re=0 then if im>0 then fi:=pi/2 else fi:=3*pi/2 else if im=0 then if re>0 then fi:=0 else fi:=pi else begin fi:=abs(arctan(im/re)); if (re>0 )and (im<0 ){4.kvadrant} then fi:=2*pi-fi else if (re<0) and (im>0) {2.kvadrant} then fi:=pi-fi else if (re<0) and (im<0) {3.kvadrant} then fi:=pi+fi; end; showmessage(floattostrf(ab,fffixed,2,2)+ ' (cos'+floattostrf(fi,fffixed,2,2)+' + i sin'+floattostrf(fi,fffixed,2,2)+')'); end; procedure TForm1.Button1Click(Sender: TObject); var i:integer;a,b:real; c:Tkomplex; x,y:real; begin for i:=1 to 5 do begin a:=random(10)-5; b:=random(10)-5; c:=Tkomplex.create(a,b); c.pis; listbox1.Items.add('Abs. hod: '+floattostr(c.abshod)); c.gon(x,y); c.sdruz; c.pis; c.Free; end; end;

5. Základní principy OOP – zapouzdření, dědičnost Seznámili jsme se s datovým typem třída, naučili se ho definovat a vysvětlili jsme si pojem zapouzdření. Připomeňme si náš příklad s kreslením útvarů na formulář. Bylo praktické zacházet s geometrickým útvarem jako s celkem – ale co kdybychom do tohoto celku zahrnuli i metody? Pak už bychom například kruh mohli definovat jako třídu: Tkruh=class x,y:integer; {souradnice leveho horniho rohu opsaneho ctverce} a:integer; {průměr} constructor create(x,y,a:integer); procedure kresli; procedure ukaz; procedure skryj; procedure presun(xn,yn:integer); end; Čtverec by ovšem vypadal velmi podobně: Tctverec=class x,y:integer; {souradnice leveho horniho rohu } a:integer; {strana} constructor create(x,y,a:integer);


procedure kresli; procedure ukaz; procedure skryj; procedure presun(xn,yn:integer); end; Nešlo by této podobnosti nějak využít? Naštěstí máme v OOP mechanismus dědičnosti.

Dědičností Rozumíme odvozování nových tříd ze starých, přičemž potomci mohou dědit metody a vlastnosti předků beze změny, předefinovávat je, případně k nim přidávat další. V Object Pascalu má každý potomek jediného přímého předka, může dědit jeho vlastnosti a schopnosti a ty pak dál poskytovat vlastním potomkům. Dědění vlastností (položek) je jednoduché, s děděním metod je to trochu komplikovanější, jak si ukážeme. Vraťme se k malování. Cokoliv co budeme malovat, má určitě nějaké souřadnice vůči formuláři, eventuelně barvu. Musí to mít konstruktor pro vytvoření instance a inicializaci hodnot, metodu pro kreslení – ta se bude u jednotlivých objektů lišit a metody ukaž(nakresli barvou popředí), skryj(nakresli barvou pozadí), přesuň (skryj, dosaď nové souřadnice a ukaž), které vypadají stejně. Vytvoříme si postupně hierarchický systém pro práci s obrázky. Počátkem všeho bude útvar (typu TTvar), který nebudeme kreslit (ono by to šlo dost těžko) – ve skutečnosti pouze svým potomkům umožňuje zdědit své vlastnosti a metody, případně je doplnit a předefinovat. Proměnná self Obsahuje odkaz na vlastní instanci třídy, může nám pomoci rozlišit globální a lokální proměnné, pokud by mohlo dojít ke konfliktu. Ttvar=class x,y:integer; constructor create(x,y:integer); procedure kresli; procedure ukaz; procedure skryj; procedure presun(xn,yn:integer); end; Tkruh=class(TTvar) {Tkruh je potomkem Ttvaru} a:integer; constructor create(x,y,a:integer); procedure kresli; procedure ukaz; procedure skryj; procedure presun(xn,yn:integer); end;

Tkruhexp=class(TTvar) {tohle je pokus – když jsou metody úplně stejné, proč je raději nezdědit?} a:integer; constructor create(x,y,a:integer); procedure kresli; end; var Form1: TForm1; k:Tkruh;k1:Tkruhexp; … {implemetave metdo TTvar} constructor TTvar.create(x,y:integer); begin self.x:=x; self.y:=y; end; procedure TTvar.kresli; {neexistující útvar se nakreslit nedá}


begin end; procedure TTvar.ukaz; begin form1.Canvas.Pen.color:=clblack; kresli; end; procedure TTvar.skryj; begin form1.Canvas.pen.color:=clbtnface; kresli; end; procedure TTvar.presun(xn,yn:integer); begin skryj; x:=xn;y:=yn; ukaz; end;

{implementace metod Tkruh} constructor Tkruh.create(x,y,a:integer); begin inherited create(x,y); {dedeni konstruktoru od bezprostredniho predka} self.a:=a; end; procedure Tkruh.kresli; begin form1.Canvas.Ellipse(x,y,x+a,y+a); end; procedure Tkruh.ukaz; begin form1.Canvas.Pen.color:=clblack; kresli; end; procedure Tkruh.skryj; begin form1.Canvas.Pen.color:=clbtnface; kresli; end; procedure Tkruh.presun(xn,yn:integer); begin skryj; x:=xn;y:=yn; ukaz; end; {implementace metod pokusného kruhu} procedure Tkruhexp.kresli; begin form1.Canvas.Ellipse(x,y,x+a,y+a); end; constructor Tkruhexp.create(x,y,a:integer); begin inherited create(x,y); self.a:=a; end; procedure TForm1.FormCreate(Sender: TObject); begin k:=TKruh.create(300,100,100); k1:=TKruhexp.create(300,100,100); end;


procedure TForm1.Button1Click(Sender: TObject); begin k.ukaz; end; procedure TForm1.Button11Click(Sender: TObject); begin k.skryj; end; procedure TForm1.FormDestroy(Sender: TObject); begin k.Free; k1.free; {uvolnění alokované paměti} end; procedure TForm1.Button5Click(Sender: TObject); begin k1.ukaz; end; Když program spustíme, zjistíme, že experimentální kruh nefunguje. Je to proto, že metoda kresli je definovaná jako statická, to znamená, že všechny její vazby se vyřeší už v době překladu. Když voláme metodu k1.ukaz, která u experimentálního kruhu není definována, je vyhledána u předka – TTvaru. Ten ovšem používá vlastní metodu kresli, která dle očekávání nekreslí nic. Potřebovali bychom tedy mechanismus, který za běhu programu umožňuje rozhodnout, kdo přesně metodu volal a použít pak tu správnou. K tomu účelu slouží virtuální metody, se kterými se seznámíme příště.

Cvičení 1. Doplňte do příkladu Tctverec jako potomek Tkruh, vyzkoušejte jeho metody, naprogramujte jednoduchou animaci čtverce a kruhu. 2. Připravte si systém pro práci s geometrickými útvary – tentokrát po stránce matematické. Útvar bude charakterizován jménem, rozměrem a bude mít konstruktor, metodu pro sdělení jak se jmenuje a výpočet obvodu a obsahu.

Řešení 1. Type Tctverec=class(Tkruh) procedure kresli; procedure ukaz; procedure skryj; procedure presun(xn,yn:integer); end; … var c:Tctverec … {implementace ctverce} procedure Tctverec.kresli; begin form1.Canvas.Rectangle(x,y,x+a,y+a); end; procedure Tctverec.ukaz; begin form1.Canvas.Pen.color:=clblack; kresli; end; procedure Tctverec.skryj; begin form1.Canvas.Pen.color:=clbtnface; kresli; end;


procedure Tctverec.presun(xn,yn:integer); begin skryj; x:=xn;y:=yn; ukaz; end; procedure stop; {zpožďovací smyčka kvůli animacím} var i:integer; begin for i:=1 to 10000000 do ; end; procedure TForm1.Button1Click(Sender: TObject); begin k.ukaz; end; procedure TForm1.FormCreate(Sender: TObject); begin c:=Tctverec.create(300,300,100); end; procedure TForm1.FormDestroy(Sender: TObject); begin c.free; end; procedure TForm1.Button2Click(Sender: TObject); begin c.ukaz; end;

procedure TForm1.Button3Click(Sender: TObject); var i:integer; begin for i:=300 to 600 do begin k.presun(i,100); stop; end; end; procedure TForm1.Button4Click(Sender: TObject); var i:integer; begin for i:=300 to 600 do begin c.presun(i,300); stop; end; end; 2. (Pro inspiraci) Type Tutvar=class jmeno:shortstring; constructor create(j:shortstring); procedure kdojsem; function obvod:real; function obsah:real; end; Tctverec=class(Tutvar) strana:real; constructor create(j:shortstring;a:real); function obvod:real;


function obsah:real; end; Tkruh=class(Tctverec) function obvod:real; function obsah:real; end; var Form1: TForm1; c:Tctverec;k:Tkruh; implementation {$R *.dfm} constructor Tutvar.create(j:shortstring); begin jmeno:=j; end; procedure Tutvar.kdojsem; begin showmessage('Jmenuji se '+jmeno); end; function Tutvar.obsah:real; begin end; function Tutvar.obvod:real; begin end; constructor Tctverec.create(j:shortstring;a:real); begin jmeno:=j; strana:=a; end; function Tctverec.obvod:real; begin obvod:=4*strana; end; function Tctverec.obsah:real; begin obsah:=strana*strana; end; function Tkruh.obvod:real; begin obvod:=2*pi*strana; end; function Tkruh.obsah:real; begin obsah:=pi*strana*strana; end; procedure TForm1.Button1Click(Sender: TObject); begin c:=Tctverec.create('ètverec',10); c.kdojsem; showmessage(floattostr(c.obvod)); showmessage(floattostr(c.obsah)); k:=Tkruh.create('kruh',5); k.kdojsem; showmessage(floattostr(k.obvod)); showmessage(floattostr(k.obsah)); end;


6. Základní principy OOP – potřetí Metody v definici tříd Statické metody se dědí beze změn nebo překrývají metodu předka. Protože překladač během překladu neví, která instance bude metodu volat, může nevhodně volat metodu předka i tam, kde to nechceme.. (Přesněji: v okamžiku překladu se určí třída, jejíž metoda bude použita a v programu už to nelze změnit.) Této vazbě se říká early binding. Existují pozdní vazby, které se používají pro virtuální metody, Náš problém s děděním metod Ukaz, Skryj a Presun, aniž bychom je museli přepisovat, vyřeší právě použití metod virtuálních. Virtuální metody Předem není jasné, zda se bude volat metoda předka nebo potomka, o tom se rozhodne až za běhu programu podle skutečného objektu, na který instance ukazuje. Tento přístup se nazývá polymorfismus. V deklaraci metody se užívá klíčové slovo virtual a při redefinici ve třídě potomka je třeba použít klíčové slovo override. (Čeští programátoři používají termín „přetížit“, nicméně ve slovníku jsem našla jako první význam „strhat koně“) Overriding umožňuje polymorfismus – měnit chování stejnojmenné metody mezi různými následníky. Pře použitím virtuální metody je nezbytné použít konstruktor dané třídy. Nevýhodou těchto metod je snížení rychlosti programu. Abstraktní metody Jsou metody, které třída nepoužívá (ani neimplementuje), ale předpokládá, že ji budu používat její potomci. (Ttvar.kresli) Pokud ji nadeklarujeme jako abstraktní (klíčové slovo abstract), není třeba ji imlplemetovat. Pokud bychom ji omylem zavolali, program skončí bez varování s běhovou chybou. Inherited Pokud vytváříme potomka, který má nějaké další vlastnosti, můžeme při předefinování zdědit metodu bezprostředního předka: constructor Tkruh.create(x,y,a:integer;barva:Tcolor); begin inherited create(x,y,barva); self.a:=a; end;

Ochrana před neoprávněným přístupem se realizuje během deklarace pomocí následující klíčových slov: Public – volně přístupné objekty, které zajišťují komunikaci třídy s jejím okolím. Private – se dají použít pouze v rámci jednotky, kde jsou deklarovány. Většinou jako private označujeme datové položky objektu. Published – jako public, navíc obsahují informace o běhu programu, takže mohou zobrazovat některé vlastnosti třídy v inspektoru objektů apod. (pozor, psaní vlastních komponent je složitější záležitost, i když se k tomu také časem dostaneme.) Protected – takové objekty smějí používat metody vlastní nebo zděděné třídy bez ohledu na jednotku, ve které jsou uloženy. Pokud není ochrana explicitně vyjádřená, překladač ji zařadí do Public.

Příklad Rozšíříme naši úlohu s malováním různých tvarů tak, že potřebné třídy připravíme do unitu, ukážeme si použití abstraktních a virtuálních metod. Praotci Ttvar přidáme barvu, metody nastavx, nastavy a nastavBarvu slouží k bezpečnému přístupu k privátním položkám. (Pokud zkusíte použít v Unitu1 pracovat se souřadnicí pomocí tečkované notace, bude překladač hlásit: Neznámý identifikátor.) unit Unit2; interface uses Graphics; {kvuli použití typu Tcolor a metodám canvasu} type Ttvar=class


private x,y:integer; barva:Tcolor; public constructor create(x,y:integer;barva:Tcolor); procedure kresli(C:Tcanvas);virtual;abstract; {nebude se implementovat} procedure ukaz(C:Tcanvas); procedure skryj(C:Tcanvas); procedure presun(xn,yn:integer;C:Tcanvas); procedure nastavx(x:integer); procedure nastavy(y:integer); procedure nastavbarvu(barva:Tcolor); end; Tkruh=class(TTvar) private a:integer; public constructor create(x,y,a:integer;barva:Tcolor); procedure kresli(C:Tcanvas);override; {napise se nova metoda} procedure nastava(a:integer); end; procedure stop(k:integer); implementation {TTvar} constructor TTvar.create(x,y:integer;barva:Tcolor); begin self.x:=x; self.y:=y; self.barva:=barva; end; procedure TTvar.ukaz(C:Tcanvas); begin c.Pen.color:=barva; kresli(c); end; procedure TTvar.skryj(C:Tcanvas); begin c.pen.color:=clbtnface; kresli(c); end; procedure TTvar.presun(xn,yn:integer; c:Tcanvas); begin skryj(c); x:=xn;y:=yn; ukaz(c); end; procedure TTvar.nastavx(x:integer); begin self.x:=x; end; procedure TTvar.nastavy(y:integer); begin self.y:=y; end; procedure TTvar.nastavbarvu(barva:Tcolor); begin self.barva:=barva end;


{Tkruh } procedure Tkruh.kresli(C:Tcanvas); begin c.Ellipse(x,y,x+a,y+a); end; constructor Tkruh.create(x,y,a:integer;barva:Tcolor); begin inherited create(x,y,barva); self.a:=a; end; procedure Tkruh.nastava(a:integer); begin self.a:=a end; procedure stop(k:integer); var i:integer; begin for i:=1 to 10000000*k do ; end; end. A jednoduché použití v Unitu1: var Form1: TForm1; k:Tkruh; c:Tctverec; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var i:integer; begin k:=Tkruh.create(200,200,100,clred); for i:= 200 to 400 do begin k.presun(i,200,canvas); stop(1); end; k.Free; end;

Cvičení 1. Přidejte do Unitu2 další útvary – čtverec, případně obdélník, elipsu… a vyzkoušejte jejich použití v dalším unitu. 2. Upravte Příklad 2 z minulého cvičení tak, aby metody obsah a obvod byly virtuální.

Řešení 1. Tctverec=class(Tkruh) public procedure kresli(C:Tcanvas);override; {vse ostatni se zdedi od kruhu} end; {implementace jedine metody kresli} procedure Tctverec.kresli(C:Tcanvas); begin c.rectangle(x,y,x+a,y+a); end; … procedure TForm1.Button2Click(Sender: TObject); begin c:=TCtverec.create(100,100,200,clblue); c.ukaz (canvas); stop(10); c.skryj(canvas);


c.free; end; 2. Type Tutvar=class private jmeno:shortstring; public constructor create(j:shortstring); procedure kdojsem; function obvod:real;virtual;abstract; function obsah:real;virtual;abstract; end; Tctverec=class(Tutvar) private strana:real; public constructor create(j:shortstring;a:real); function obvod:real; override; function obsah:real; override; end; Tkruh=class(Tctverec) function obvod:real; override; function obsah:real; override; end; var Form1: TForm1; c:Tctverec;k:Tkruh; implementation {$R *.dfm} constructor Tutvar.create(j:shortstring); begin jmeno:=j; end; procedure Tutvar.kdojsem; begin showmessage('Jmenuji se '+jmeno); end; constructor Tctverec.create(j:shortstring;a:real); begin jmeno:=j; strana:=a; end; function Tctverec.obvod:real; begin obvod:=4*strana; end; function Tctverec.obsah:real; begin obsah:=strana*strana; end; function Tkruh.obvod:real; begin obvod:=2*pi*strana; end; function Tkruh.obsah:real; begin obsah:=pi*strana*strana;


end; procedure TForm1.Button1Click(Sender: TObject); begin c:=Tctverec.create('ètverec',strtofloat(edit1.Text)); c.kdojsem; showmessage('Obvod='+floattostr(c.obvod)); showmessage('Obsah='+floattostr(c.obsah)); k:=Tkruh.create('kruh',strtofloat(edit1.Text)); k.kdojsem; showmessage('Obvod='+floattostr(k.obvod)); showmessage('Obsah='+floattostr(k.obsah)); c.Free; k.Free; end;

7. Základní principy OOP – polymorfismus Zopakujme si: Statické metody (definované obvyklým způsobem) jsou takové, že prostor v paměti i všechny vazby vyřeší překladač v době překladu, jejich výhodou je tedy rychlost provádění. Dědění statických metod ovšem může být problematické – jestliže překladač nenajde definici metody u určitého objektu, začne ji vyhledávat u bezprostředního předka atd. a pak ji použije ve tvaru, ve kterém je nadefinována. Při předefinování statických metod můžeme měnit jejich parametry, pokud ovšem je třeba metody psát znovu – není program rozšiřitelný bez znalosti zdrojového kódu, což by měla být zásadní výhoda objektového programování. Virtuální metody dovolují řešit vazby mezi objekty až za běhu programu (late binding, kompilátor k tomu používá tabulku virtuálních metod, což způsobuje, že jsou tyto metody pomalejší než statické). Virtuální metody umožňují realizovat tutéž akci pro předka i potomka, který je bohatší o další vlastnosti. Instance předka může nabývat hodnoty svých potomků – měnit podobu, proto zde hovoříme o polymorfismu. Také polymorfismus si ukážeme na dalším rozšíření kreslicího příkladu. Příklad 1. Předek typu TTvar – podle přání uživatele kruh, čtverec, obdélník nebo elipsa – posune se o 200 pixelů doprava. Příklad 2. Jestliže vytvoříme dynamické pole objektů TTvar, můžeme jako jeho položky dosadit čtverce, kruhy, případně další objekty a pak s ním pohodlně pracovat jako s celkem. Kód obou příkladů: unit Unit2; interface type Ttvar=class private x,y:integer; barva:Tcolor; public constructor create(x,y:integer;barva:Tcolor); procedure kresli(C:Tcanvas);virtual;abstract; procedure ukaz(C:Tcanvas); procedure skryj(C:Tcanvas); procedure presun(xn,yn:integer;C:Tcanvas); procedure nastavx(x:integer); procedure nastavy(y:integer); function dejx:integer; function dejy:integer; procedure nastavbarvu(barva:Tcolor); end; Tkruh=class(TTvar) private


a:integer; public constructor create(x,y,a:integer;barva:Tcolor); procedure kresli(C:Tcanvas);override; procedure nastava(a:integer); end; Tctverec=class(Tkruh) public procedure kresli(C:Tcanvas);override; end; Tobdelnik=class(Tctverec) private b:integer; public constructor create(x,y,a,b:integer;barva:Tcolor); procedure nastavb(b:integer); procedure kresli(C:Tcanvas);override; end; Telipsa=class(Tobdelnik) procedure kresli(C:Tcanvas);override; end; procedure stop(k:integer); implementation {TTvar} constructor TTvar.create(x,y:integer;barva:Tcolor); begin self.x:=x; self.y:=y; self.barva:=barva; end; procedure TTvar.ukaz(C:Tcanvas); begin c.Pen.color:=barva; kresli(c); end; procedure TTvar.skryj(C:Tcanvas); begin c.pen.color:=clbtnface; kresli(c); end; procedure TTvar.presun(xn,yn:integer; c:Tcanvas); begin skryj(c); x:=xn;y:=yn; ukaz(c); end; procedure TTvar.nastavx(x:integer); begin self.x:=x; end; procedure TTvar.nastavy(y:integer); begin self.y:=y; end; procedure TTvar.nastavbarvu(barva:Tcolor); begin self.barva:=barva end; function Ttvar.dejx:integer; begin dejx:=x; end; function Ttvar.dejy:integer; begin dejy:=y;


end; {Tkruh } procedure Tkruh.kresli(C:Tcanvas); begin c.Ellipse(x,y,x+a,y+a); end; constructor Tkruh.create(x,y,a:integer;barva:Tcolor); begin inherited create(x,y,barva); {inherited je dedeni konstruktoru od beypostredniho predka} self.a:=a; end; procedure Tkruh.nastava(a:integer); begin self.a:=a end; {Tctverec} procedure Tctverec.kresli(C:Tcanvas); begin c.rectangle(x,y,x+a,y+a); end; procedure stop(k:integer); var i:integer; begin for i:=1 to 10000000*k do ; end; {Tobdelnik} constructor Tobdelnik.create(x,y,a,b:integer;barva:Tcolor); begin inherited create(x,y,a,barva); self.b:=b; end; procedure Tobdelnik.nastavb(b:integer); begin self.b:=b; end; procedure Tobdelnik.kresli(C:Tcanvas); begin C.rectangle(x,y,x+a,y+b); end; {Telipsa} procedure Telipsa.kresli(C:Tcanvas); begin C.Ellipse(x,y,x+a,y+b) end; end.

Unit Unit1; Uses Unit2,… … var Form1: TForm1; k:Tkruh; c:Tctverec;o:Tobdelnik;e:Telipsa; a:pole; u:tTvar; … procedure TForm1.FormCreate(Sender: TObject); {potřebné objekty sestrojíme hned při vytvoření formuláře} var i:integer; begin k:=TKruh.create(100,300,50,clred); c:=Tctverec.create(100,350,50,clblue); e:=Telipsa.create(100,400,100,20,clgreen); o:=TObdelnik.create(100,450,100,20,clyellow);


setlength(a,3); a[1]:=Tkruh.create(80,100,100,clred); a[0]:=TCtverec.create(130,150,100,clblue); a[2]:=Tkruh.create(180,200,100,clgreen); canvas.Brush.style:=bsclear; {pruhledny} end; procedure TForm1.Button2Click(Sender: TObject); {zobrazení objektů, které budeme přesouvat} begin c.ukaz(Canvas); k.ukaz(canvas); o.ukaz(canvas); e.ukaz(canvas); end; procedure TForm1.Button3Click(Sender: TObject); var u:Ttvar;i,p,q:integer; {do praotce u dosadíme podle prani uzivatele některého z jeho potomku} begin case radiogroup1.itemindex of 0: u:=k; 1: u:=c; 2: u:=e; 3: u:=o; end; {zapamatujeme si souřadnice vybraného útvaru a posuneme ho doprava} q:=u.dejy; p:=u.dejx; for i:=p to p+200 do begin u.presun(i,q,canvas); stop(1); end; end; procedure TForm1.Button1Click(Sender: TObject); {animace pole tvarů bude probíhat pdobně} var i,d,p,q:integer; begin for i:=0 to high(a) do a[i].ukaz(canvas); for d:=0 to 20 do begin for i:=0 to high(a) do begin p:=a[i].dejx; {zjištěni aktuálních souradnic} q:=a[i].dejy; p:=p+2*d; q:=q+d; stop(1); a[i].presun(p,q,canvas); end; end; end; procedure TForm1.FormDestroy(Sender: TObject); {uvolnění paměti} var i:integer; begin for i:=0 to high(a) do a[i].Free; a:=nil; c.Free; k.Free; e.Free; o.Free; end;


Příklad 3. (kapitola 7,5?) Výhodnější než pracovat s polem polymorfních objektů je definovat dalšího potomka, který bude obsahovat nejen polymorfní objekty, ale také jejich relativní souřadnice ke svému těžišti: Definice v unitu2: Tobr=class(TTvar) pocet:integer; {maji-li fungovat zdedene procedury, musi se souradnice dedit} pole:array of polozka; {polozky} constructor create(x,y:integer); destructor done; procedure pridej (t:Ttvar;xr,yr:integer); {relativni souradnice polozky vuci tezisti} procedure kresli(c:Tcanvas);override; end; implementation {Tobr} constructor Tobr.create(x,y:integer) ; begin pocet:=0; self.x:=x; self.y:=y; viz:=true; end; procedure Tobr.pridej (t:Ttvar;xr,yr:integer); begin inc(pocet); setlength(pole,pocet); pole[high(pole)].rex:=xr; pole[high(pole)].rey:=yr; pole[high(pole)].co:=t; end; {souradnice se musi prepocitat pri kresleni, ne pri pridani} procedure Tobr.kresli(c:Tcanvas); var i:integer; begin for i:=0 to high(pole) do begin pole[i].co.x:=pole[i].rex+x; pole[i].co.y:=pole[i].rey+y; if viz then pole[i].co.ukaz(c) else pole[i].co.skryj(c) ; end; end; destructor Tobr.done; var i:integer; begin for i:=0 to high(pole) do pole[i].co.free; end; Použití v Unitu1: procedure TForm1.Button1Click(Sender: TObject); var i:integer; begin a:=TObr.create(100,100); k:=Tkruh.create(0,0,50,clblue); l:=Tkruh.create(0,0,50,clgreen); c:=Tctverec.create(0,0,50,clred); a.pridej(k,50,0); a.pridej(c,0,0);


a.pridej(l,-50,0); {a.pridej(k,0,50);pozor na destruktor, bude rusit uz uvolnene objekty} stop(10); a.ukaz(canvas); stop(10); for i:=100 to 200 do begin a.presun(i,100,canvas); stop(2); end; a.done; end;

procedure TForm1.FormCreate(Sender: TObject); begin canvas.Brush.style:=bsclear; canvas.pen.Width:=5; end; procedure TForm1.Button2Click(Sender: TObject); begin if button2.caption='kresli' then begin kresli:=true; prvni:=true; button2.Caption:='konec'; b:=Tobr.create(0,0); end else begin kresli:=false; button2.Caption:='kresli' ; end end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if kresli then begin if prvni then begin b.nastavx(0); b.nastavy(0); prvni:=false; end; k:=Tkruh.create(0,0,20,random(clwhite)); b.pridej(k,x,y); b.ukaz(canvas); end;{tady destruktor nejde zavolat, protože by rušil rušené kruhy} end; procedure TForm1.Button3Click(Sender: TObject); var i:integer; begin for i:=0 to 200 do begin b.presun(i,100,canvas); stop(1); end; for i:=200 downto 0 do


begin b.presun(i,100,canvas); stop(1); end; b.Free; end; end.

Cvičení Rozšiřte Unit2 o další potomky a použijte ho ve vlastním příkladu, kde budete pohybovat obrázkem z několika objektů.

8. Objektový model Delphi Shrneme si naposledy základní rysy OOP a podíváme se na komponenty jakožto třídy a na zjišťování typových informací. Zapouzdření Objekt obsahuje datové položky (vlastnosti) a procedury a funkce (metody), které s těmito položkami pracují. Přístup k datům se dá omezit tak, aby k nim mohl přistupovat pouze oprávněný vlastník. Dědičnost Vlastnosti i metody se dědí z předka na potomka, nově vytvářený objekt může toto dědictví rozšiřovat a modifikovat, takže se vytváří hierarchický systém objektů. Jednou vytvořené rozhraní lze tedy opakovaně používat a tudíž se podstatně zvětšuje efektivita psaní programů. Polymorfismus Umožňuje zaměnitelnost objektů v rámci hierarchie. Určitá akce pak může být společná různým objektům hierarchie a její implementace pro různé objekty se může lišit. Statické metody se dědí beze změn nebo překrývají metodu předka. Jejich výhodou je rychlost, nevýhodou nemožnost používat polymorfismus. Virtuální metody Předem není jasné, zda se bude volat metoda předka nebo potomka, o tom se rozhodne až za běhu programu podle skutečného objektu, na který instance ukazuje. V deklaraci metody se užívá klíčové slovo virtual a při redefinici ve třídě potomka je třeba použít klíčové slovo override. K vyhledávání procedur používají VMT. (tabulku virtuálních metod) Overriding umožňuje polymorfismus – měnit chování stejnojmenné metody mezi různými následníky. Pře použitím virtuální metody je nezbytné použít konstruktor dané třídy. Nevýhodou těchto metod je snížení rychlosti programu. Dynamické metody se deklarují pomocí klíčového slova dynamic, jinak se chovají stejně jako metody virtuální. Liší se pouze ve vnitřní reprezentaci, užívají jiný řídící mechanismus k vyhledání procedur. Jsou ještě pomalejší než virtuální, ale při složitých strukturách hierarchií mohou šetřit paměť Abstraktní metody Jsou metody, které třída nepoužívá ale předpokládá, že ji budu používat její potomci. Metody zpráv používá obsluha zpráv Windows Deklarace: procedure x;dynamic; y;virtual; z;(var M:Tmessage); u; virtual; abstract; ;


Zjišťování typových informací Třídy předka a potomka se mohou značně lišit (mohl by nastat problém při odkazu na vlastnost, kterou předek nemá), je tedy nezbytné umět zjistit, na který objekt proměnná v daném okamžiku odkazuje. K tomu se používá operátor is. K bezpečnému přetypování se pak používá operátor as. Například: čtverec má jediný rozměr a, obdélník navíc b. budeme-li pracovat s praotcem u z minulého cvičení, Můžeme si tyto informace nechat vypsat následujícím způsobem: (abychom se ovšem dostali k privátní položce a, buď pro tuto chvíli její označení jako private zrušíme nebo – lépe, doplníme Metody deja,dejx,dejy,dejb…, které nám umožní manipulaci s těmito daty) procedure TForm1.Button4Click(Sender: TObject); var u:Ttvar; s:string; begin case radiogroup1.itemindex of 0:u:=k; 1:u:=c; 2:u:=e; 3:u:=o; end; if u is Tkruh then begin s:='Kruh, polomer:'+IntTostr((u as Tkruh).a); end; if u is Tctverec then begin s:='Ctverec, strana:'+IntTostr((u as Tctverec).a); end; if u is Tobdelnik then begin s:='Obdelnik, strany:'+IntTostr((u as Tobdelnik).a)+ ','+IntTostr((u as Tobdelnik).b); end; if u is Telipsa then begin s:='Elipsa, osy:'+IntTostr((u as Telipsa).a)+ ','+IntTostr((u as Telipsa).b); end; end;

Objektový model Delphi Všechny třídy mají společného předka Tobject. Objekty jsou často reprezentovány vizuálně – komponenty. Type XXX=class Je totéž jako Type XXX =class(Tobject) Pak proměnná: Var x:XXX Musí byýt vytvořena: x:=XXX.create A zrušena x.free Vhodnost vytvoření – procedura Tform1.FormCreate a rušení Tform1.FormDestroy Metody třídy a reference na třídu Jsou metody, které existují pro třídu jako celek, dají se použít, i když žádná instance neexistuje.Díky referencím na třídu lze provádět operace přímo na třídách. Předchází jim vždy slovo class. ClassName – vrací řetězec, který je jménem třídy ClassParent.ClassName – jméno rodičovské třídy Příklad: listbox1.items.add(u.ClassName) listbox1.items.add(u.ClassParent.ClassName); listbox1.items.add(u.ClassParent.ClassParent.ClassName); Vyzkoušíme-li si tyto funkce například pro u: TTvar a vybereme kruh, vypíše se postupně:


Tkruh Ttvar Tobject A tak se dostáváme k původci všeho:

Praotec Object Jádrem Delphi je hierarchie tříd. Každá třída v systému je potomkem datového typu Tobject. Tobject tedy může nahrazovat všechny datové typy v systému – např. metody reagujících na události mají obvykle parametr Sender:Tobject. Pokud při práci s objektem potřebujeme znát jeho datový typ, použijeme operátory is a as. Dá se toho mj. použít třeba ke společné obsluze více událostí: Příklad Na formulář umístíme tři komponenty typu TPanel a každému dáme jinou barvu. Pokud budeme chtít, aby při kliknutí na panel, formulář nabyl téže barvy jako panel, stačí, když napíšeme pro první panel následující kód: procedure TForm1.Panel1Click(Sender: TObject); begin color:=(sender as tpanel).Color; end; Další dva panely vybereme se Shiftem a v Events jim naráz zvolíme z roletky OnClick Panel1Clickl. (Je vhodnější používat bezpečnější přetypování: if sender is TPanel then color:=(sender as tpanel).Color;) Povšimněme si také, že pokud chceme nastavit barvu formuláře, stačí napsat color – bez Form1. Jistě, jsme přece v události TForm1.Panel1Click, takže je jasné, že položka color patří formuláři.

Knihovna vizuálních komponent (VCL) Programování v Delphi má dvě části: jednak píšeme kód v Object pascalu (na to jsme se maximálně soustředili dosud a zdaleka tomu není konec), jednak vytváříme vizuální uživatelské rozhraní pomocí předdefinovaných komponent. (Toho si ještě užijeme) Psaní celého programu pak vypadá tak, že umístíme na formulář nějaké komponenty a definujeme jejich interakce. Všechny komponenty jsou uloženy ve VCL. Většina komponent je obsažena v paletě komponent Komponenty jsou potomky třídy Tcomponent, jejich kompletní hieararchii si můžeme prohlédnout v Object Browseru (MenuView), po přeložení a uložení projektu. (Pokud obsahuje vaše vlastní třídy, objeví se zde také) Jak víme, předkem všeho je TObject, poskytuje mj. konstruktor create, který obvykle předefinováváme, kvůli inicializaci, destruktory free a destroy. Prakticky s ním pracujeme, když používáme polymorfismus. Některé další funkce doplňuje třída TPersistant, dalším potomkem už je právě třída TComponent Z technického hlediska můžeme komponenty dělit do několika skupin: Okenní ovládací prvky – TWinControl – jsou založeny na formuláři, mohou být vybrány a obsahovat další komponenty. (TForm, TButton) Grafické ovládací prvky – TGraphicControl (Tlabel), protože na rozdíl od předchozích nejsou spravovány Windows, nelze je vybrat. Neviditelné komponenty – standardní dialogová okna, databázová spojení… VCL obsahuje také třídy, které komponentami nejsou, říká se jim objekty – grafické objekty (Tbitmap, TBrush…), souborové objekty, kolekce(Tstrings) aj. Zjednodušená hierarchie komponent:

TComponent TWinControl

TButtonControl TControl (vizuální komponenty)

TGraphicControl

nevizuální komponenty

TWinControl


TButton

Vlastnosti komponent: • Přístupné v době návrhu – Jsou na kartě Properties OI a dají se upravovat již v době návrhu (za běhu rovněž) • Přístupné pouze za běhu – pouze pomocí kódu s tečkovanou notací Dalším komponentám (Možná, že vám chyběla tvorba menu, možnost přidání stavového řádku, otevření dalších formulářů, nástrojové lišty, internetový prohlížeč – vše co potřebujte pro vývoj profesionálně vyhlížející aplikace) se budeme záhy věnovat.

Příklady: 1. Umístěte na formulář pět tlačítek a pro každé nastavte jinak vlastnost font. Doplňte šesté tlačítko. Pokud klepnete na některé z prvních pěti, šesté tlačítko získá příslušný font. 2. Vymyslete si vlastní příklad, kde použijete hierarchii objektů. 3. Prostudujte si Properties komponent, se kterými jsme až dosud pracovali, přečtěte si nápovědu k nim (F1 na komponentě) a vyzkoušejte si jejich nastavování za běhu programu.

Řešení: 1. Společná obsluha: procedure TForm1.Button1Click(Sender: TObject); begin if sender is tButton then button6.Font:=(sender as tbutton).Font end; 2. Hierarchický system těles: (viz. obr) type Tteleso=class private jmeno:shortstring; hustota:real; public constructor create(j:shortstring;h:real); procedure jsem; function hmotnost:real;virtual;abstract; function povrch:real; virtual;abstract; end; Tkoule=class(Tteleso) private rozmer:real; public constructor create(j:shortstring;h,r:real); function hmotnost:real;override; function povrch:real; override; end; Tkrychle=class(Tkoule) function hmotnost:real;override; function povrch:real; override; end; Tvalec=class(Tkrychle) private vyska:real; duty:boolean;


public constructor create(j:shortstring;h,r,v:real;d:boolean); function hmotnost:real;override; function povrch:real; override; end; var Form1: TForm1; implementation {implementace telesa} constructor Tteleso.create(j:shortstring;h:real); begin jmeno:=j;hustota:=h; end; procedure Tteleso.jsem; begin showmessage('jsem teleso '+jmeno); end; {implementace koule} constructor Tkoule.create(j:shortstring;h,r:real); begin inherited create(j,h); rozmer:=r; end; function Tkoule.hmotnost:real; begin hmotnost:=4*pi/3*rozmer*rozmer*rozmer*hustota; end; function Tkoule.povrch:real; begin povrch:=4*pi*sqr(rozmer); end; {implementace krychle} function Tkrychle.hmotnost:real; begin hmotnost:=rozmer*rozmer*rozmer*hustota; end; function Tkrychle.povrch:real; begin povrch:=6*sqr(rozmer); end; {implementace valce} constructor Tvalec.create(j:shortstring;h,r,v:real;d:boolean); begin inherited create(j,h,r); vyska:=v; duty:=d; end; function Tvalec.hmotnost:real; begin if duty then hmotnost:=0 else hmotnost:=pi*sqr(rozmer)*vyska*hustota; end; function Tvalec.povrch:real; begin povrch:=pi*sqr(rozmer)+2*pi*rozmer*vyska; end;

var a:array[1..6] of Tteleso; i:integer; begin a[1]:=Tkoule.create('koule malá',1,10); a[2]:=Tkoule.create('koule velká',1,20);


a[3]:=Tkrychle.create('krychle malá ',1,5); a[4]:=Tkrychle.create('krychle velká',1,15); a[5]:=Tvalec.create('valec plny',1,10,5,false); a[6]:=Tvalec.create('valec duty',1,10,5,true); for i:=1 to 6 do begin a[i].jsem; showmessage('hmotnost :'+floattostrf(a[i].hmotnost,fffixed,2,2)); showmessage('povrch :'+floattostrf(a[i].povrch,fffixed,2,2)); end;

{$R *.dfm} end. Zvířata (Kdyby už vám to opravdu nemyslelo) TTvor=class public constructor create; function jsem:string; function delam:string;virtual;abstract; private druh:string; end; Tkocka=class(TTvor) public constructor create; function delam:string;override; private zvuk:string; end; Tpes=class(Tkocka) constructor create; end;

var t1,t2:Ttvor;k:Tkocka;p:Tpes; Form1: TForm1; implementation {$R *.DFM} constructor TTvor.create; begin druh:='neznámý tvor' end; function Ttvor.jsem:string; begin jsem:=druh;end; constructor Tkocka.create; begin druh:='kočička'; zvuk:='Mňááááuuu' end; function Tkocka.delam:string; begin delam:=zvuk; end; constructor Tpes.create; begin druh:='pejsek'; zvuk:='Vrrrrrrrr, haf,haf'; end; procedure TForm1.Button1Click(Sender: TObject);


var hlas:string; begin label1.caption:='jsem '; label2.caption:='dělám '; label1.caption:=label1.caption+ t2.druh; if (t2 is Tkocka)or (t2 is TPes) then hlas:=(t2 as tkocka).zvuk else hlas:=''; label2.caption:=label2.caption+hlas; end; procedure TForm1.FormCreate(Sender: TObject); begin p:=Tpes.create; k:=Tkocka.create; t1:=tTvor.create; t2:=t1; end; procedure TForm1.FormDestroy(Sender: TObject); begin k.free; p.free; t1.free; end; procedure TForm1.RadioGroup1Click(Sender: TObject); begin case radiogroup1.itemindex of 1: t2:=k; 2: t2:=p; 0: t2:=t1; end; end; end.

9. Programování řízené událostmi (Kapitola, která také mohla být docela na začátku…) Klasické programování: program řídí činnost uživatele: zadej údaje,…. Programování řízené událostmi: (Běžná obsluha programů pod Windows ) Když uživatel např. klikne na tlačítko nebo stiskne klávesu, generuje příslušnou událost, kterou pak zpracovává program. (Přímo ji vyřizuje nebo předává dál systému). Programátor tedy vytváří reakce na vybrané události. Poznámka: Tento typ programování je nezbytný v prostředí, kde vedle sebe běží víc paralelních procesů.

Proč právě Delphi • • • • • • •

Další verzí Borland Pascalu je plně objektový Object Pascal Prostředek pro vytváření aplikací pod Windows Programování řízené událostmi Vizuální programování (uživatelský interaface se neprogramuje) Prostředek pro vytváření databázových aplikací Možnost vytváření internetových aplikací Podpora technologií COM a AciveX

Prostředí Hlavní panel – položky hlavní nabídky a panely nástrojů Paleta komponent – komponenty pro vizuální návrh formuláře


Inspektor objektů – záložka Properties (vlastnosti) a Events (události) aktivní komponenty Object TreeView – okno s hierarchickou strukturou objektů aktuálního formuláře Form -hlavní formulář aplikace Editor kódu (pod ním, přepínání např. F12)

Hlavní panel File – práce se soubory a ukončení Delphi Edit – editace zdrojového kódu, běžná práce se schránkou Search – vyhledávání View – zobrazení a vypínání zobrazení Project –manipulace s otevřeným projektem Run – spuštění programu, trasování apod. Program Reset –záchrana při zamrznutí programu AddWatch – vkládání kukátek, F5 nebo klik na okraj kódu – vložení breakpointu Komponents – práce s komponentami Tools – nástroje pro vlastní nastavení IDE Help

Inspektor objektů Obsahuje seznam komponent, které užívá náš program. Během návrhu vybíráme komponentu a nastavíme její vlastnosti (Properties), na kartě Events (události) pak napíšeme kód obslužných procedur - tj, jak bude komponenta reagovat na určitou událost. Komponenty jsou objekty, tedy z hlediska implementace mají vlastnosti – položky záznamu, metody – procedury a funkce, které jsou součástí jejich definice a umějí reagovat na události. Zobrazení – F11

Vytvoření projektu a struktura aplikace Nový projekt se vytvoří hned po spuštění IDE, jinak File – New Application Otevření existujícího projektu – File – Open project Nový projekt má vždy aspoň jeden formulář a programovou jednotku –Unit1.pas. Zdrojový kód projektu – Project – View Source program Project1; uses Forms, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. Dá se spustit Run – Run, získáme okno s typickými tlačítky Windows, se kterým jako s oknem můžeme zacházet. Ukládání: File – Save Project As File – Save –uložení právě editovaného souboru File – Save All – uložení všech souborů projektu, doporučujeme vždy do téhož adresáře. (Pro každý projekt zvláštní složka v Dokumentach) Ukončení aplikace = uzavření hlavního okna, jinak má každé okno metodu Close. Soubory projektu: .cfg textový soubor s nastavenou konfigurací projektu .dcu binární soubor, výsledek překladu programových jednotek .dfm textový nebo binární soubor s formulářem (Form – pravá myš – View as text, Alt F12) .dof textový soubor s nastavením kompilátoru, aj. .dpr textový soubor – zdrojový text projektu .exe spustitelný soubor, hotová aplikace spustitelná i na počítači, kde nejsou instalovány


.pas .res

Delphi textový soubor, zdrojový text unitu binární soubor, obsahuje zdroje Windows.

Některé vlastnosti komponent Name Caption Text Top, Left Width, Height ReadOnly Enabled Visible Hint Align Alignment Color

identifikátor, dle pascalských zvyklostí popisek komponenty, běžný text text zobrazený v komponentě poloha levého horního rohu vzhledem k rodičovské komponentě (formulář) šířka a výška je-li True, nedá se komponenta editovat je-li False, komponenta nereaguje na ovládání myší nebo klávesnicí je-li False, komponenta se nezobrazí obsahuje text bublinkové nápovědy (ShowHint musí být True) zarovnání komponenty vůči rodičovské komponentě zarovnání textu v komponentě barva, dvojklik – barevná paleta (Povšimněte si, že pokud si namícháte vlastní barvu, objeví se v Properties její hexadecimální kód. Autosize je-li true, komponenta se přizpůsobuje velikost velikosti zobrazeného textu, fixuje levý okraj Zarovnání komponent na formuláři – buď View – Alignment palette nebo kontextové menu – Position – Align Psaní událostí – dvojklik na události – editor kódu připraví prázdnou proceduru. Dvojklik přímo na komponentě vyvolá implicitní událost (např. u tlačítka kliknutí)

Barvy Barevné konstanty – clWhite apod, fce rgb(x,x,x) –x je y intervalu 0..255, určují podíl červené, zelené a modré složky. Rgb(0,0,0) je černá, rgb(255,255,255) bílá.Jde užívat hexadecimální zápis jako např. v HTML $xxyyzz Random(clwhite) – generování náhodných barev

Vložení komponenty za běhu programu si ukážeme na příkladu. Dejme tomu, že bychom chtěli při stisknutí levého tlačítka myši na formuláři do daného místa umístit očíslované tlačítko (každé další bude mít vyšší číslo), při stisknutí pravého tlačítka podobně označený popisek (TLabel) Tlačítka budou mít definovánu událost OnClick – náhodně změní barvu formuláře. type TForm1 = class(TForm) procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); procedure barva (sender:Tobject); { procedura, která se má volat na OnClick tlačítka musí být procedurou formuláře) private { Private declarations } public { Public declarations } end; var Form1: TForm1; cislo:integer; implementation {$R *.DFM} procedure TForm1.barva (sender:Tobject); begin color:= random(clwhite); end;


procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button=mbleft then begin with TButton.Create( Self ) do begin {Tbutton.create je metoda tridy – muzeme ji volat, aniz bychom meli vytvorenou instanci objektu Parametr metody Create udává vlastníka objektu, ten se postará o jeho zničení. Když to zařídíme sami, můžeme použít nil.} left:=x; top:=y; width:=30; height:=20; inc(cislo); caption :=IntToStr(Cislo); {postupné vybavení tlačítka jeho vlastnostmi} parent:=self; { Parent určuje rodiče objektu, žádá své děti, aby se nakreslily a kam. (Jinak se nezobrazí.) Self zde odkazuje na Form1 a předává se automaticky jako neviditelný parametr metod} OnClick:=barva; end; end else begin with Tlabel.create(self) do begin left:=x; top:=y; width:=30; height:=20; color:=clwhite; inc(cislo); caption :=IntToStr(Cislo); parent:=self; end; end; end;

Cvičení: 1. Vložte na formulář tlačítko, při jehož stisknutí bude původně šedivý formulář tmavnout až do černé a pak zase světlat až do bílé barvy. 2. Vložte na formulář tlačítko, při jehož stisknutí se plocha formuláře pokryje stovkou čtvercových tlačítek. Při stisknutí tlačítka se zobrazí jeho pořadové číslo, které je uloženo ve vlastnosti Tag. (Tag má každá komponenta, je celočíselného typu) 3. Vložte na formulář 10 editačních políček, zarovnejte je a zajistěte při vytvoření formuláře, aby se všechna vyprázdnila. 4. Na stisknutí tlačítka se do těchto políček vloží náhodná celá čísla a políčko s největší a nejmenší hodnotou se vybarví jinak.

Řešení: 1


var i:integer; procedure TForm1.Formcreate(Sender: TObject); begin color:=clwhite; end; procedure TForm1.Button3Click(Sender: TObject); begin if (button3.caption='tmavnu') and (i>=0) then i:=i-20; if i<0 then button3.caption:='blednu'; if (button3.caption='blednu') and (i<=255) then i:=i+20; if i>255 then begin button3.caption:='tmavnu'; i:=255; end; form1.color:=rgb(i,i,i); end; 2. type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); procedure UkazTag(Sender: TObject); …. procedure TForm1.Button1Click(Sender: TObject); var i,j: integer; begin for i:=0 to 9 do for j:=0 to 9 do with TButton.Create( Self ) do begin Left := 5+40*i; Top := 5+30*j; Width := 38; Height := 28; Caption := '?'; Parent := Self; Tag := 10*i+j; OnClick := UkazTag end end; procedure TForm1.UkazTag(Sender: TObject); begin ShowMessage( IntToStr( TComponent(Sender).Tag ) ) end; end 3, 4 type TForm1 = class(TForm) Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; Edit4: TEdit; Edit5: TEdit; Edit6: TEdit;


Edit7: TEdit; Edit8: TEdit; Edit9: TEdit; Edit10: TEdit; Button1: TButton; Button2: TButton; procedure FormCreate(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; ************ var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var i:integer; begin for i:=0 to form1.controlcount-1 do if controls[i] is TEdit then (controls[i] as tedit).clear; end; procedure TForm1.Button2Click(Sender: TObject); var i:integer; x,max,imax:integer; begin randomize;max:=0; for i:=0 to form1.controlcount-1 do if controls[i] is TEdit then begin x:=random(100); (controls[i] as tedit).text:=IntTostr(x); if x>max then begin imax:=i; max:=x; end; end; (controls[imax] as Tedit).Color:=clyellow; end; end..

10. Výjimky Jsou chyby, které vznikají za běhu programu. Některé vznikají kvůli nedomyšleným konstrukcím programátora (dělení nulou, zápis do nealokované paměti…), jiné může vyvolat uživatel (nezaloží disketu, snaží se ovládat program jinými klávesami…), k dalším vede chybná vstupně výstupní operace (snaha otevřít neexistující soubor apod.) Pokud se v programu vyskytne podobný problém, Delphi volají výjimku – přestanou provádět příkazy, které chybu způsobily a přejdou na kód programu, který na chybu reaguje. Po spuštění následujícího kódu z debuggeru, program skončí takto:


Debugger se zastavuje u výjímek, je-li v Tools/debugger Options na kartě Languagě Exceptions nastaveno Stop on Delphi Exceptions. Pokud ho spustíme jako exe soubor z Windows, objeví se zpráva:

Třídy výjimek Každá výjimka je potomkem třídy Exception, která je součástí VCL. Pokud se objeví běhová chyba, Delphi vytvoří její instanci (samy) a obslouží ji. Každá výjimka má své jméno a vyvolá se při chybě, pro kterou byla nadefinována: Příklady: Třída výjímky Chyba EAbstractError Pokus o volání abstraktní metody EaccessViolation Přístup do neplatné paměti EconvertError Chyba konverzních funkcí EInOutError Vstupně výstupní chyba EintOverFlow Celočíselné přetečení (výsledek se nevejde do alokovaného prostou) ERangeError překročení rozsahu celočíselného typu EzeroDivide dělení nulou v pohyblivé řadové čárce Exception Praotec výjimka Podrobnějí: EIntOverflow is a occurs when data is lost because an integer result is too large to retain. In Delphi Code, EIntOverflow is raised only if overflow checking is turned on. To turn on overflow checking, include the $Q+ directive in project source code, or select Project|Options, choose the Compiler tab, and check the Overflow-checking option in the dialog box. EDivByZero is raised when an application tries to divide an integer by zero. ERangeError occurs in Delphi code when range checking is enabled and an ordinal values goes outside its declared range. EInvalidOp is raised when the CPU encounters an undefined instruction, invalid operation, or floating-point stack overflow.

Vlastní obsluha výiímek Try…except Try Kód, který může vyvolat výjimku Except Kód, který se provede při vyvolání výjimky End; Pokud se může objevit víc výjimek a potřebujeme je obsloužit různě: Except on Trida vyjimky do osetrujici prikazy; on Trida vyjimky do osetrujici prikazy; on Trida vyjimky do osetrujici prikazy; …. Else příkazy k obsluze ostatních výjimek End;


Else raději nepoužívejme, jinak bychom museli zajistit obsluhu skutečně všech možných eventualit. (jinak to ošetřuje nadřízený blok – Delphi, Windows apod. a postará se o varovné okno sám). Try – finally Někdy je třeba vykonat nějaké příkazy bez ohledu na to, zda došlo k výjimce, či nikoliv. (Změníme vzhled komponenty, je třeba uvolnit vyhrazenou paměť…) Try Kód, který může vyvolat výjimku finally Kód, který se musí provést vždy, při výjimce, i při bezchybným průchodem blokem try. End; Protože se bloky excpet a try nedá použít najednou, řeší se tato situace dvěma vnořenými bloky. Try Try Finnally End; Except End; Opětovné vyvolání výjimky Pokud chceme, aby námi zpracovanou výjimku ještě obsloužil nadřízený blok, můžeme použít příkaz raise. Tichá výjímka Raise Eabort.Create(‘tohle nikdy neuvidíš’) Text si můžeme prohlédnout jedině v hlášení debuggeru o výjimce, pokud ovšem máme nastaveno Stop on Delphi exceptions Vlastní výjímky Příklad: Čteme-li ze souboru, z hlediska systému je podstatné že existuje a je otevřený. Pokud ovšem obsahuje nesmyslná data, systému to nevadí. Proto je třeba moci vyvolat vlastní výjimku: Moje Vyjimka=class(exception) End; Potom stačí napsat proceduru, která výjimku vyvolá. Destuktor výjimky se volá automaticky na konci její obsluhy, ručním voláním bychom způsobili chybu.

Příklady …. EBig=class(exception) {vlastni vyjimka} end; var Form1: TForm1; implementation {$R *.DFM} {$R+} {direktiva prekladace, zajisti kontrolu rozsahu} procedure TForm1.Button1Click(Sender: TObject); {neosetrene deleni nulou – správa: Division by zero} var a,b,x:integer; begin a:=5; b:=0; x:= a div b; showmessage(inttostr(x)); end; procedure TForm1.Button2Click(Sender: TObject); {osetrene deleni nulou}


var x,y:integer; begin try y:=spinedit1.value; x:=1 div y; button2.caption:=inttostr(x); except button2.caption:='nedel nulou' end; end; procedure TForm1.Button3Click(Sender: TObject); {neosetreny rozsah – pokud do spineditu zadate cislo vetsi nez rozsah integer, objevi se stejna reakce jako na vyjimku s nulou} var x,y:integer; begin try y:=spinedit1.value; x:=1 div y; button2.caption:=inttostr(x); except button2.caption:='nedel nulou' end; end; procedure TForm1.Button4Click(Sender: TObject); {osetrene deleni nulou a rozsah – zde se rozlisi, jak vynikla vyjimka} var x,y:word; begin try y:=spinedit1.value; x:=1 div y; button2.caption:=inttostr(x); except on EdivByZero do button2.caption:='nedel nulou'; on ERangeError do button2.caption:='přetečení'; end; {musi byt direktiva range chceking $R+} end; procedure TForm1.Button5Click(Sender: TObject); {neosetrene tlacitko – vyvola se vyjimka, ale neopravi se popisky tlacitek} var a,i:integer; begin a:=1; button5.caption:='pobiha vypocet'; try for i:=9000000 downto 0 do a:=a div i; button5.caption:='stiskni' except showmessage('vypocet se nepodarilko dokoncit'); end; end; procedure TForm1.Button6Click(Sender: TObject); {reseni tehoz s finally – popisky tlacitek se zmeni} var a,i:integer; begin a:=1; button6.caption:='pobiha vypocet'; try try for i:=9000000 downto 0 do a:=a div i; finally button6.caption:='stiskni' end except


showmessage('vypocet se nepodarilo dokoncit'); end; end; procedure over(x,max:integer); {procedura k vlastni vyjimce} begin if x>max then raise EBig.Create('moc velka hodnta'); end; procedure TForm1.Button8Click(Sender: TObject); begin over(spinedit1.value,10); end;

Cvičení Naprogramujte jednoduchou celočíselnou kalkulačku podle řešeného příkladu, ošetřete možné výjimky a rozlište chybu vzniklou odmocňováním záporného čísla a dělení nulou.

public { Public declarations } Smazat: boolean; minOP: char; minX: integer; end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.CisliceClick(Sender: TObject); {Stisk tlačítka s číslicí přidává cifru k číslu na displeji} {společná obsluha všech tlačítek s číslicemi} begin if Smazat then Label1.Caption := ''; Smazat := FALSE; Label1.Caption := Label1.Caption + (sender as TButton).Caption end; procedure TForm1.OperaceCLick(Sender: TObject); {vyhodnotí minulou operaci (pro současnou operaci ještě nemáme druhý operand) a zapamtuje si ji.} {pro všechna operační tlačítka včetně =}


var x: integer; begin x := StrToInt( Label1.Caption ); try case minOP of '+': x := minX + x; '-': x := minX - x; '*': x := minX * x; '/': x := minX div x; 'O': x:=round(sqrt(minX)); end; except on EDivByZero do begin x := minx; Label1.Caption := IntTostr( x ); ShowMessage( 'Dìlení nulou' ); end; on EInvalidOp do begin x := minx; Label1.Caption := IntTostr( x ); ShowMessage( 'Nedefinovaná domocnina' ); end; end; Label1.Caption := IntTostr( x ); minX := x; minOP := (Sender as TButton).Caption[1]; Smazat := TRUE end; procedure TForm1.FormCreate(Sender: TObject); begin Smazat := TRUE; minOP := '?' end; end.

11. Opakovací cvičení TStrings TStrings je základní třída pro objekty, které reprezentují seznam řetězců. (Pracovali jsme s Items v ListBoxu a také v komponentě Radiogroup.) Některé vlastnosti: Count – počet řetězců Př.: for I := 0 to ListBox1.Items.Count - 1 do… Strings[i] – i-tá položka seznamu, číslováno od nuly. (Listbox1.items[i] je totéž jako listbox1.items.Strings[i]) Text – všechny řetězce (Listbox2.items.text:=Listbox1.items.text) Některé metody: function Add(const S: string): Integer; přidá řetězec S na konec seznamu. (LIstbox1.Items.Add(‘XXX’)) procedure Clear; odstraní všechny řetězce ze seznamu procedure Delete(Index: Integer); odstraní řetězec s daným indexem (Listbox1.Items.Delete(1))


procedure Exchange(Index1, Index2: Integer); vymění řetězce v seznamu (ListBox1.Items.Exchange(1,2)) function IndexOf(const S: string): Integer; vrací index prvního výskytu řetězce v seznamu procedure Insert(Index: Integer; const S: string); vloží řetězec S na pozici Index v seznamu. Více – viz. Delphi Help Příklady: 1. Umístěte na formulář tři komponenty Listbox a do nich zapište slovníček. Přidejte editační políčko – když do něj uživatel zapíše slovíčko, zobrazí se jeho ekvivalent v dalším jazyce. Volbu dvojice jazyků umožňete pomocí komponenty radiogroup. 2. Nalezněte všechny různé rozklady daného celého čísla na součet tří kladných celých čísel. Rozklady lišící se pouze pořadím sčítanců nepovažujeme za různé. 3. Je dána posloupnost n přirozených čísel. (Vygenerujte do listboxu). Nalezněte maximum a vypište pozice všech jeho výskytů.

Řešení 1. Je výhodné si přiravit proceduru překlad, která překládá mezi dvěma listboxy. Pak ji voláme podle volby uživatele. procedure preklad(j1,j2:Tlistbox); var i:integer; nasel:boolean; begin i:=0; nasel:=false; {vyhledání slovíčka v listboxu j1} while (i<=j1.items.count-1)and not nasel do if j1.items[i]=form1.edit1.text then nasel:=true else inc(i); if not nasel then showmessage('nemame') else showmessage(j2.items[i]); {zobrazení překladu z druhého listboxu j2} form1.edit1.clear; form1.edit1.setfocus; end; procedure TForm1.Button1Click(Sender: TObject); begin case radiogroup1.itemindex of 0: preklad(listbox1,listbox2); 1: preklad(listbox2,listbox1); 2: preklad(listbox1,listbox3); 3: preklad(listbox2,listbox3); 4: preklad(listbox3,listbox2); 5: preklad(listbox3,listbox1); end; end; 2. Rozklady by se daly vytvářet pomocí tří vnořených for cyklů, každý cyklus slouží pro určení hodnoty jednoho sčítance. Je to ale zbytečně pomalý postup, vyžaduje řádově n3 operací. Stačí vpracovat ve dvou cyklech a třetí sčítanec dopočítávat. Nemá smysl připravovat nejdřív všechny možné rozklady a pak z nich vybrat různé, lepší je vytvářet různé rozklady tak, že je-li n = x + y + z, musí platit x <=y<=z procedure TForm1.Button1Click(Sender: TObject); var n,x,z,y:integer; s:string; begin n:=spinedit1.value; listbox1.clear;


for x:= 1 to n div 3 do for y:=x to (n-x) div 2 do begin s:=Inttostr(x)+'+'+Inttostr(y)+ '+'+ Inttostr(n-x-y); listbox1.items.add(s); end; end; 3. Jednodušší řešení: Zapamatujeme si čísla v poli, během generování najdeme maximum a pak při druhém průchodu pole vypíšeme indexy jeho výskytů. Lepší řešení: Původní čísla neukládáme a během generování si v pomocném poli pamatujeme indexy výskytů. procedure TForm1.Button2Click(Sender: TObject); var i, max,x,j:integer; s:string; kde:array[1..20] of integer; begin max:=-1; listbox1.clear; s:=''; for i:=1 to 20 do begin x:=random(10); listbox1.items.add(inttostr(x)); if x>max then begin max:=x; kde[1]:=i; j:=1; {nove maximum a jeho pozice, zatim je jedno - j} end else if x=max then begin inc(j); kde[j]:=i {dalsi vyskyt maxima} end; end; for i:=1 to j do s:=s+inttostr(kde[i])+' '; showmessage(s); end;

12. Soubor typový Program ukládá své výsledky i dočasná data do operační paměti počítače, ta ovšem ztrácí obsah s jeho vypnutím. K trvalé úchově dat se používají soubory ukládané na HDD. Soubory v Delphi: • Binární s udaným typem (typové) • Netypové binární soubory • textové soubory

Typový soubor Je struktura, která se skládá ze složek téhož typu. Délka souboru – počet složek Prázdný soubor – nemá žádnou složku Soubor nemá pevnou předem danou délku. V daném okamžiku je vždy přístupná jediná složka, na kterou ukazuje ukazatel, při každém dalším přístupu se posuneme na další hodnotu, (Takovému prohlížení říkáme sekvenční prohlížení) ale jsou definovány procedury pro přímý přístup k libovolné položce souboru.


Deklarace: Type T=file of T0 – typ složek libovolný kromě file. Var f: T Příklady: type cisla=file of integer; clovek=record jmeno:shortstring; vek:integer; end; lide=file of clovek; var x:cisla; data:lide; Současně s deklarací je definována přístupová proměnná. Proměnnou typu soubor je nutné spojit s existujícím souborem na disk – procedura AssifgnFile. AssignFile(f,'C:\data.dat') – cokoliv budeme dělat s proměnnou f, se bude dít se souborem data.dat v kořenovém adresáři C:. Vytváření: Neexistující soubor je nutno otevřít procedurou ReWrite.. Rewrite(f) – standardní procedura, která předchází zápisu do souboru. Nahradí soubor prázdným souborem a ten otevře. (Vytvoří na disku soubor se jménem z procedury AssignFile) Z předchozího vyplývá, že použijete-li ji na existující soubor, přijdete o data. . Prohlížení: Existující soubor otvíráme procedurou Reset. (Pokud se použije na otevřený soubor, nejprve se zavře a pak znovu otevře) Ukazatel se nastaví na první položku souboru. Reset(f) Write(f,x) – zapíše obsah proměnné x do souboru f, tam, kam ukazuje ukazatel. Pokud tam něco je, přepíše se to, ukazatel se po provedení operace opět posune. Read(f,x) – přečte ze souboru prvek pod ukazatelem do proměnné x a posune ukazatele o jedno místo Samozřejmě proměnná x musí být téhož typu jako polžky souboru. Parametrů obou procedur může být víc: read(f,x,y,z) načte do proměnných x,y,z následující data ze souboru. Uzavření souboru Closefile(f) Procedury pro práci se soubory: FilePos(f) – funkce, která vrací pozici aktuální položky. (ukazatele). Čísluje se, jak je v Delphi zvykem, od 0. Seek(f,n) – nastaví ukazatel na pozici n. (Tímto způsobem je tedy okamžitě přístupná libovolná položka) FileSize(f) – počet položek souboru Eof (f) – logická funkce, vrací TRUE na konci souboru. (jinak false) př.:if eof(f) then ShowMessage(‘konec dat’) Poznámka: Pokud soubor vystupuje jako formalin parametr podprogramů, musí být výhradně jako parametr proměnná)

Příklad 1.Vyzkoušíme si vytvoření typového souboru v kořenovém adresáři, přidání na konec, zobrazení. souboru, zobrazení položky podle pořadí, výměnu první a poslední položky.


var Form1: TForm1; f:file of integer; {protože nebudeme zatím používat soubor jako formální parametr, vystačíme s anonymním typem} Fyzický soubor přiřadíme při vytvoření formuláře procedure TForm1.FormCreate(Sender: TObject); begin assignfile(f,'c:\slova.bin'); rewrite(f); edit1.clear; edit2.clear; end; Přidání čísla z prvního editačního políčka na konec souboru procedure TForm1.Button1Click(Sender: TObject); var x:integer; begin seek(f,filesize(f)); x:=strtoint(edit1.Text); edit1.clear; edit1.setfocus; write(f,x); edit2.Text:='konec' end; Uzavření souboru při rušení formuláře procedure TForm1.FormDestroy(Sender: TObject); begin Closefile(f); end; Zobrazení poslední položky (její pořadové číslo je filesize(F)-1), pokud soubor není prázdný procedure TForm1.Button2Click(Sender: TObject); var s:integer; begin if filesize(f)>0 then begin seek(f,filesize(f)-1); read(f,s); edit2.Text:=inttostr(s); end


else showmessage('prazdny soubor') end; Zobrazení i-té položky, počínaje nultou, pokud je k dispozici procedure TForm1.Button4Click(Sender: TObject); var i,x:integer; begin i:=StrToInt(edit3.Text); if (i>filesize(f)-1) or (filesize(f)=0) then begin showmessage('nemame'); edit2.Text:='konec'; exit; end else begin seek(f,i); read(f,x); edit2.Text:=inttostr(x); end; end; Zobrazení první položky, pokud soubor není prázdný procedure TForm1.Button5Click(Sender: TObject); var s:integer; begin if filesize(f)>0 then begin seek(f,0); read(f,s); edit2.Text:=inttostr(s); end else showmessage('prazdny soubor') end; Zobrazení souboru do listboxu, při prohlížení souborů obvykle používáme cyklus while not eof(f) do… procedure TForm1.Button6Click(Sender: TObject); var s:integer; begin listbox1.Items.Add('zobrazeni souboru'); seek(f,0); while not eof(f) do begin read(f,s); listbox1.Items.add(inttostr(s)); end; end; Výměna prvního a posledního čísla: nejprve je načteme do proměnných x a z,pak se znovu vrátíme na jejich výchozí pozice a zapíšeme je v opačném pořadí. procedure TForm1.Button3Click(Sender: TObject); var x,y:integer; begin if filesize(f)>=2 then begin seek(f,0); read(f,x); seek(f,filesize(f)-1); read(f,y); seek(f,0); write(f,y); seek(f,filesize(f)-1); write(f,x); end else showmessage('nejde to')


end;

Cvičení Vytvořte soubor celých čísel z generátoru (počet zadá uživatel) v aktuálním adresáři. Zobrazte ho do listboxu, připravte si proceduru, jejímž vstupním parametrem bude soubor celých čísel. Všechna sudá čísla v souboru zvětšete dvakrát, soubor opět zobrazte. Rozeberte soubor na dva nové: soubor lichých a soubor sudých. Oba zobrazte. Vytvořte k původnímu souboru nový, který bude obsahovat vždy každé třetí číslo původního souboru. Opět jej zobrazte. Řešení: type soubor=file of integer; var f,s,l,tr:soubor; procedure ukaz(var g:soubor;l:TListbox); var x:integer; begin l.Clear; reset(g); while not eof(g) do begin read(g,x); l.Items.Add(IntToStr(x)); end end; procedure TForm1.FormDestroy(Sender: TObject); begin closefile(f); closefile(l); closefile(S); closefile(tr); end; procedure TForm1.Button3Click(Sender: TObject); var x:integer; begin seek(f,0); while not eof(f) do begin read(f,x); if odd(x) then write(l,x) else write(s,x); if filepos(f)mod 3=0 then write(tr,x); end; ukaz(l,listbox2); ukaz(s,listbox3); ukaz(tr,listbox4); end; procedure TForm1.FormCreate(Sender: TObject); begin AssignFile(f,'zdroj.dat'); Assignfile(s,'suda.dat'); Assignfile(l,'licha.dat'); Assignfile(tr,'treti.dat'); rewrite(f); rewrite(s); rewrite(l); rewrite(tr); edit1.Text:='10'; end;


procedure TForm1.Button1Click(Sender: TObject); var i,x,n:integer; begin n:=StrToInt(edit1.text); randomize; for i:=1 to n do begin x:=random(100); write(f,x); end; ukaz(f,listbox1); end; procedure TForm1.Button2Click(Sender: TObject); var x:integer; begin seek(f,0); while not eof(f) do begin read(f,x); if not odd(x)then begin seek(f,filepos(f)-1); x:=2*x; write(f,x); end {else write(l,x)}; end; ukaz(f,listbox2); end; end.

13. Soubor typový záznamů, bezpečnost Manipulace s externím souborem může selhat, je nutné s tím počítat. Tradiční řešení spočívá v tom, že zakážeme kompilátoru kontrolovat vstupně výstupní chyby a ošetříme je ručně. Modernější možnost je využití výjímek, které vyvolá pokus o nedoolenou operaci se souborem. ... Try reset(g); except showmessage('soubor nejde otevrit') exit; end; ... Try rewrite(h); except showmessage('soubor nejde vytvorit') closefile(h); exit; end; ... try closefile(g); closefile(h); except showmessage('chyba pri zavirani'); end; Do souborů většinou potřebujeme uložit složitější struktury. Vyzkoušíme si práci se souborem záznamů.

Příklad: Chceme vytvořit soubor záznamů o morčatech. U každého budeme evidovat jméno, váhu a je-li samec nebo samice.Uživatel bude mít možnost pracovat buď s existujícím souborem nebo vytvořit nový. Umožníme mu editaci otevřeného souboru (nejprve vyhledání podle jména) a zjištění nějaké agregační funkce – například počet samic a největší morče. type morce=record jmeno:shortstring; samec:boolean; hmotnost:integer; end;


soubor=file of morce; var f:soubor; pos:integer; {v proměnné pos si budeme pamatovat pozici, na které jsme našli morče, které chceme editovat}

Vytvoření nového souboru procedure TForm1.Button1Click(Sender: TObject); begin try assignfile(f,edit1.Text); rewrite(f); except showmessage('IO chyba'); exit; end; end; Kotevření existujícího souboru můžeme použít OpenDialog procedure TForm1.Button2Click(Sender: TObject); begin if opendialog1.execute then try assignfile(f,opendialog1.filename); reset(f); except showmessage('IO chyba'); exit; end; end; Vyčištění editačních oken procedure TForm1.FormCreate(Sender: TObject); begin edit1.clear; edit2.clear; edit3.clear; edit4.clear; end; Přidání morčete, které je zadáno na panelu na konec souboru. procedure TForm1.Button5Click(Sender: TObject); var x:morce; begin seek(f,filesize(f)); x.jmeno:=edit2.Text; x.samec:= checkbox1.checked; x.hmotnost:=StrToInt(Edit3.Text); write(f,x); end; Uzavření souboru při rušení formuláře procedure TForm1.FormDestroy(Sender: TObject);


begin try closefile(f); except showmessage('IO chyba'); exit; end; end; Výpis souboru do listboxu procedure TForm1.Button6Click(Sender: TObject); var x:morce; begin try reset(f); except showmessage('IO chyba'); exit; end; listbox1.Clear; while not eof(f) do begin read(f,x); listbox1.Items.add(x.jmeno); listbox1.Items.add(IntToStr((x.hmotnost))); if x.samec then listbox1.Items.add('samec') else listbox1.Items.add('samice'); end; end; Počet samic procedure TForm1.Button3Click(Sender: TObject); var x:morce;p:integer; begin try seek(f,0); except showmessage('IO chyba'); exit; end; p:=0; while not eof(f) do begin read(f,x); if not x.samec then inc(p); end; showmessage('samic je '+inttostr(p)); end; Nejtěžší morče (Protože morče budeme zobrazovat na zadávací apanel při editaci a tady by se to také hodilo, vyplatila ny se procedura…) procedure TForm1.Button4Click(Sender: TObject); var x,max:morce; begin try seek(f,0); except showmessage('IO chyba'); exit; end; max.hmotnost:=0; while not eof(f) do begin read(f,x); if x.hmotnost>max.hmotnost then max:=x; end; showmessage('nejvetsi je '+max.jmeno+' '+inttostr(max.hmotnost)); end; Vyhledání morčete daného jména a jeho zobrazení na panel procedure TForm1.Button8Click(Sender: TObject); var x:morce; nasel:boolean;


begin try seek(f,0); except showmessage('IO chyba'); exit; end; nasel:=false; while not eof(f) and not nasel do begin read(f,x); if x.jmeno=edit4.text then begin nasel:=true; edit2.Text:=x.jmeno; edit3.Text:=inttostr(x.hmotnost); checkbox1.Checked:=x.samec; pos:=filepos(f)-1; end; end; if not nasel then showmessage('nemame '); end ; Uložení dat morčete zobrazeného na panelu na jeho původní pozici procedure TForm1.Button7Click(Sender: TObject); var x:morce; begin seek(f,pos); x.jmeno:=edit2.Text; x.samec:= checkbox1.checked; x.hmotnost:=StrToInt(Edit3.Text); write(f,x); end;

Cvičení: Vytvořte vlastní soubor osob, u každé budete evidovat jméno, IQ, zda je abstinent nebo konzument. Poskytněte možnost vytvořut nový soubor nebo otevřít starý, prohlédnutí souboru, třídění podle IQ, průměrné IQ abstinentů i konzumentů. Řešení: type osoba=record jmeno:shortstring; IQ: integer; abstinent:boolean; end; data=file of osoba; var f:data;o:osoba; procedure TForm1.Button1Click(Sender: TObject); var s:string; begin s:=edit1.text; assignfile(f,s); try rewrite(f); except exit; end; end; procedure TForm1.Button3Click(Sender: TObject); begin seek(f,filesize(f)); o.jmeno:=edit2.text; o.iq:=spinedit1.value; o.abstinent:=checkbox1.checked; write(f,o); end;


procedure TForm1.Button2Click(Sender: TObject); var a:string; begin seek(f,0); listbox1.clear; while not eof(f) do begin read(f,o); if o.abstinent then a:='abstinent' else a:='konzument'; listbox1.items.add(o.jmeno+' ' + inttostr(o.iq)+' '+a); end; end; procedure TForm1.Button7Click(Sender: TObject); begin if opendialog1.execute then assignfile(f,opendialog1.filename); try reset(f); except exit; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin try closefile(f); except exit; end; end; procedure TForm1.button4Click(Sender: TObject); var n,i:integer; x,y:osoba; bublal:boolean; begin n:=filesize(f); repeat bublal:=false; for i:=0 to n-2 do begin seek(f,i); read(f,x,y); if x.iq>y.iq then begin seek(f,i); write(f,y,x); bublal:=true; end; end; until not bublal; end; function prumer(ci:boolean):real; var p:real; n:integer; begin seek(f,0); p:=0; n:=0; while not eof(f) do begin read(f,o); if o.abstinent=ci then begin p:=p+o.iq; inc(n);


end; end; p:=p/n; showmessage(floattostrf(p,fffixed,2,2)); end; procedure TForm1.Button5Click(Sender: TObject); begin prumer(true); end; procedure TForm1.Button6Click(Sender: TObject); begin prumer(false); end;

14. Textový soubor Nevýhody binárních souborů: • složité ukládání textových řetězců • data jsou pro uživatele nečitelná, nemůže v nich provádět dodatečné úpravy Textový soubor = posloupnost znaků členěných do řádků proměnné délky. (file of char+#10#13 – oddělovač řádků) Umějí s nimi pracovat všechny jazyky, protože většina komunikace s počítačem se děje právě prostřednictvím textového souboru. Dá se přímo naeditovat v jednoduchém textovém editoru – Poznámkový blok, editor Delphi, Pascalu a přirozeně je v něm také čitelný a upravovatelný. S jednotlivými řádky lze pracovat jako s řetězci, ale TS není file of string.

Práce s TS Deklarace: f:TextFile; Pro přiřazení diskového souboru slouží prcedura AssignFile(f,’jmeno.txt’), při otvírání rozlišujeme otvírání pro čtení a zápis. Rewrite(f) – vytvoření nového souboru nebo otevření starého pro zápis (ale také jeho smazání) Append(f) – otevře soubor pro zápis a nastaví ukazatel za poslední položku, což umožní přidávání dat. Reset(f) – otvírá soubor pro čtení. Do souboru, který je otevřen pro čtení nelze zapisovat a ze souboru otevřeného pro psaní nejde číst. Čtení, psaní, pohyb v TS: Procedury read, write, navíc readln(f), writeln(f), které umějí v TS odřádkovat. Seek, FilePos a FileSize jsou nepoužitelné. Funguje Eof a navíc Eoln, SeekEoln, které zjišťují, zda je aktuální pozice na konci řádků. Zavírání – CloseFile(f) Zavírání je důležité, protože se kvůli úspoře času nejprve všechny znaky zapisují do bufferu a ten se později do souboru zapíše najednou. (Buffer se dá se vyprázdnit do souboru procedurou Flush, která ponechá soubor otevřený) Zpracování Podle potřeby můžeme pracovat s textovým souborem po jednotlivých znacích nebo po řádcích, které můžeme zpracovávat jako řetězce. var x:char; s:string; f:textfile; po znacích: while not eof(f) do begin read(f,x);… end; po znacích, potřebujeme-li brát v úvahu konce řádků: while not eof(f) do begin while not eoln(f) do begin read(f,x)… end; readln(f); end;


po řádcích: while not eof(f) do begin readln(s);… end;

Příklad

Zdrojový soubor zobrazíme do Mema (Standard) pomocí OpenDialogu nebo přímo naeditujeme a umožníme ho uložit pomocí SaveDialogu. Zjistíme jeho velikost, můžeme ho zakódovat a opět dekódovat. Rychlost procesu kódování budeme sledovat pomocí komponenty Gauge (samples) a její vlastnosti progress. Algoritmus kódování bude prostinký (v praxi raději nepoužívat) – každému znaku přiřadíme znak posunutý v ASCII kódu o 3 místa doprava. Jednotlivé řádky Mema jsou typu Tstrings, objekt se nazývá Memo1.lines a má vlastnosti Tstrings LoadfromFile apod. Na rozdíl od Listboxu Memo nemá automaticky rolovátka, vlastnost Scrollbars je třeba v Inspektoru objektů nastavit (ssNone – implicitně, ssBoth, ssVertical, ssHorizontal) type TForm1 = class(TForm) procedure kod(k:boolean); … var vstup, vystup:textfile; procedure TForm1.Button1Click(Sender: TObject); begin if opendialog1.execute then edit1.Text:=opendialog1.FileName; end; procedure TForm1.Button2Click(Sender: TObject); begin if savedialog1.execute then edit2.Text:=savedialog1.filename end; procedure TForm1.Button5Click(Sender: TObject); begin Memo1.lines.LoadFromFile(Edit1.Text); end; procedure TForm1.Button6Click(Sender: TObject); begin Memo1.lines.LoadFromFile(Edit2.Text); end; procedure TForm1.kod(k:boolean); {procedura je definovana jako metoda formulare, abychom meli primo pristupne komponenty} var i:integer; s,sifra:string; ff:file of byte;


delka:longint; poz:LongInt;{delka i poz je tu kvuli zobrazeni v Gauge} begin {vstupni soubor otevreme jako file of byte, abychom mohli urcit jeho velikost} Assignfile(ff,Edit1.Text); reset(ff); delka:=filesize(ff); closefile(ff); AssignFile(vstup,Edit1.Text); AssignFile(vystup,Edit2.Text); Reset(vstup); Rewrite(Vystup); poz:=0; while not eof(vstup) do begin sifra:=''; readln(vstup,s);{nacteme radek ze vstupu} Application.ProcessMessages ;{obslouzeni jinych zprav Windows} for i:=1 to length(s) do {kodovani znaku} begin if k{koduji} then sifra:=sifra+chr(ord(s[i])+3) else {dekoduji} sifra:=sifra+chr(ord(s[i])-3); inc(poz); end; poz:=poz+2;{pripocitani znaku konce radky} gauge1.progress:=poz*100 div delka; {MaxValue v Gauge je 100} writeln(vystup,sifra); end; closefile(vystup); closefile(vstup); end; Nejsou zde ošetřeny vstupně-výstupní operace, zobrazování funguje dobře, otevřete-li vstupní soubor, zakódujete (nebo dekódujete) výstupní a ten si pak prohlédnete, samozřejmě musí být správně nastavena jména, případně cesty. procedure TForm1.Button3Click(Sender: TObject); begin kod(true); end; procedure TForm1.Button4Click(Sender: TObject); begin kod(false); end; Poznámky: Aby se dala použít funkce FileSize pro velikost souboru, je třeba ho otevřít jako file of byte, pak zavřít a znova otevřít jako text. Příkaz Application.ProcessMessages předává podle potřeby řízení jiným aplikacím v průběhu kódovacího cyklu, zpracování dlouhého dokumentu by mohlo na dost dlouhou dobu ochromit Windows. Více v Multiprogramování.

Cvičení: Pracujte s textovým souborem, který si nejprve naeditujete, pak uložíte a podle potřeby znova otevřete. (Zobrazte ho do mema). Zjistěte počet vět, počet řádků, nejdelší řádek.


Zjistěte četnosti jednotlivých písmen v textu.(bez nabodeníček) Rozeberte soubor na jednotlivé věty a každou umístěte do listboxu na zvláštní řádek. Řešení Četnost písmen: procedure TForm1.Chars2Click(Sender: TObject); var cet: array['A'..'z']of integer; x:char; s:string; begin reset(f); for x:='A' to 'z' do cet[x]:=0; while not eof(f) do begin read(f,x); if ('A'<=x) and (x<='z') then inc(cet[x]); end; listbox1.clear; for x:='A' to 'z' do begin s:=''; s:=s+x+': '+inttostr(cet[x]) ; listbox1.items.add(s); end; end; Počet vět a jejich zobrazení procedure TForm1.Chars1Click(Sender: TObject); var ch:char;s:string; p:integer; begin reset(f); p:=0; listbox1.clear; while not eof(f) do begin s:=''; read(f,ch); while (ch<>'.')and (not eoln(f)) do begin s:=s+ch; read(f,ch); end ; if eoln(f) then readln(f); listbox1.items.add(s+'.'); inc(p); end; showmessage(inttostr(p)); end; Nejdelší řádek procedure TForm1.Lines1Click(Sender: TObject); var max,p:integer; s:string; begin reset(f);max:=0; p:=0; while not eof(f) do begin readln(f,s); inc(p); if length(s)>max then max:=length(s); end; showmessage(inttostr(max)); showmessage(inttostr(p)); end;


15. Opakování Přehled příkazů pro práci se soubory (standardní procedury a funkce) (víc se dozvíte v nápovědě Delphi) • Append • Assignfile • BlockRead • BlockWrite • ChDir • CloseFile • Eof • Eoln • Erase • FilePos • FileSize • Flush • GetDir • IOResult • MkDir • Read • Readln • Rename • Reset • Rewrite • RmDir • Seek • SeekEof • SeekEoln • SetTextBuf • Truncate • Write • Writeln

Prostředky VCL pro práci se soubory Některé kmponenty podpoují přímo vstup a výstup dat do souboru (obrázky, text) – Memo, Picture, PaintBox, Listbox…

Práce s disky, adresáři a seznamy souborů: Jsou na paletě komponent Win 3.1 DriveComboBox – rozvírací seznam všech disků nainstalovaných na počítači DirectoryListBox – všechny adresáře zvoleného disku FileListBox – seznam souborů odpovídající zadané masce daného adresáře FilterComboBox – rozvírací seznam pro výběr masek Propojování komponent: Vlastnost DirList komponernty DriveListBox – obsah zadaného disku FileList komponenty DirectoryFilelistbox – zobrazení souborů daného adresáře FileList u FilterComboBoxu – totéž

Příklad Vyzkoušíme si vytvořit jednoduchý správce programů. Uživatel si vybere program a pro vybrané přípony mu umožníme něco s ním udělat: txt – zobrazení do Mema bmp, jpg – zobrazení do Image


exe – spuštění

DirList u DriveListBox1 nastavíme na DirectoryListBox1 (stačí dvojklik). FileList u DirectoryFilelistbox1 nastavíme na FileListBox1 FileList u FilterComboBox1 nastavíme na FileListBox1. Aby se nezobrazovaly soubory, které nebudeme obsluhovat. nastavíme dále filter u FilterCombobox1:

Zapíšeme kód událostí kliknutí a dvojkliku na soubor u FileListBoxu.> procedure TForm1.FileListBox1Click(Sender: TObject); begin Memo1.lines.clear; If ExtractFileExt(FileListBox1.FileName)='.exe' then Memo1.lines.Add('dvojklik spusti program') else if ExtractFileExt(FileListBox1.FileName)='.txt' then Memo1.lines.LoadFromFile(FileListBox1.FileName) else Image1.picture.LoadFromFile(FileListBox1.FileName); end; procedure TForm1.FileListBox1DblClick(Sender: TObject); begin If ExtractFileExt(FileListBox1.FileName)='.exe' then WinExec(Pchar(FileListBox1.FileName),sw_ShowNormal); end; Funkce ExtractFileExt(FileListBox1.FileName) vrací příponu souboru, WinExec spouští program, prvním parametrem je název programu, fce pchar přetypovává na potřebný druh řetězce,sw_ShowNormal udává jak program poběží.

Cvičení 1. Umožněte do předchozího příkladu do Mema naeditovat soubor celých čísel, uložit ho SaveDialogem a zobrazit Vašim správcem souborů 2. Naeditujte soubor setříděný vzestupně, kde se některé hodnoty opakují. 3. Vytvořte z něj nový setříděný soubor bez opakování hodnot. 4. Spojte dva setříděné soubory do dalšího setříděného souboru. 5. Připravte si do textového souboru obdélníkovou matici čísel čísel, čísla jsou uspořádána v řádcích a oddělena mezerami. Načtěte ji jednak do listboxu jako textový soubor, jednak jako matici celých čísel a tu zobrazte do StringGridu..


Řešení: type cisla=file of integer; var Form1: TForm1; f: cisla; {zobrazeni cisel do mema} procedure ukaz(var g:cisla;m:Tmemo); var x:integer; begin m.lines.clear; reset(f); while not eof(f) do begin read(f,x); m.lines.add(IntToStr(x)); end; end; procedure TForm1.FileListBox1Click(Sender: TObject); begin … else if ExtractFileExt(FileListBox1.FileName)='.dat' then begin assignfile(f,filelistbox1.FileName); {zobrazeni souboru z Filelistu do mema} ukaz(f,memo1); end … Ulozeni souboru cisel z mema procedure TForm1.Button1Click(Sender: TObject); var i,x:integer; begin if savedialog1.Execute then assignfile(f,savedialog1.filename); rewrite(f); for i:=0 to memo1.lines.count-1 do begin x:=StrToInt(memo1.lines[i]); write(f,x); end; closefile(f); end; Soubor ruznych: procedure TForm1.Button2Click(Sender: TObject); var x,y:integer; begin assignfile(g,'ruzna.dat'); rewrite(g); reset(f); read(f,x); write(g,x); y:=x; while not eof(f) do begin while (not eof(f)) and (y=x) do read(f,y); if not eof(f)then begin write(g,y); x:=y; end; end; closefile(g); ukaz(g,memo2); end; Slucovani: Jeden soubor vybereme z FileListBoxu, druhy naprogramujeme – zde 1,2,3} procedure TForm1.Button3Click(Sender: TObject); var i,n,x,y,z:integer;


begin listbox1.Clear;listbox2.Clear; assignfile(h,'123.dat'); rewrite(h); for i:=1 to 3 do write(h,i); closefile(h); assignfile(g,'sloucen.dat'); rewrite(g); reset(f); reset(h); read(f,x); read(h,y); while (not eof(f)) and (not eof(h)) do if xy) do begin write(g,y); read(h,y); end; if x

var b:pole; a:dimpole; procedure cisla(s:string; var p:pole;var nn:integer); {procedura prevede retezec (jeden radek matice) na pole cisel} var d:integer;{pocet cisel} i:integer; {pozice v retezci} x:char; {na cifry} pom:string; {na jednotliva cisla} begin i:=1;d:=1; while i<=length(s) do begin pom:=''; while s[i]<>' ' do begin pom:=pom+s[i]; inc(i); end; p[d]:=strtoint(pom); inc(i); inc(d); end; nn:=d-1; end; procedure TForm1.Button1Click(Sender: TObject); {vyzkouseni procedury – prevedeni retezce cisel z editu do cisel} var i,p:integer; begin cisla(edit1.Text,b,p);listbox1.clear; for i:=1 to p do listbox1.items.add(inttostr(b[i])); end; procedure TForm1.Button2Click(Sender: TObject); {vytvoreni matice z radku listboxu} var i,j,m,n,o:integer; begin listbox1.items.loadfromfile ('File2.txt'); m:=strtoint(listbox1.items[0]); n:=strtoint(listbox1.items[1]); stringgrid1.RowCount:=m+1; stringgrid1.ColCount:=n+1; for i:=1 to m do cisla(listbox1.items[i+1],a[i],o); for i:=1 to m do for j:=1 to n do stringgrid1.cells[j,i]:=inttostr(a[i,j]);

end; procedure TForm1.Button3Click(Sender: TObject); {vytvoreni matice z radku textoveho souboru} var i,j,m,n,o:integer;s:string;f:textfile; begin listbox1.items.loadfromfile ('File2.txt'); assignfile(f,'File2.txt'); reset(f); showmessage(‘soubor otevren’);


m:=strtoint(s); readln(f,s); n:=strtoint(s); stringgrid1.RowCount:=m+1; stringgrid1.ColCount:=n+1; for i:=1 to m do begin readln(f,s); cisla(s,a[i],o); end; for i:=1 to m do for j:=1 to n do stringgrid1.cells[j,i]:=inttostr(a[i,j]); end; end.

16. Dynamické datové typy, lineární spojový seznam Statické a dynamické objekty Statická proměnná je deklarována (var) a s deklarací je určena její platnost (ve které proceduře…) a také již v době překladu vyhrazena paměť (na zásobníku) Dynamická proměnná vzniká za běhu programu, rozsah platnosti není předem znám. Výhody: Protože se potřebná paměť alokuje dynamicky, její velikost lze operativně přizpůsobit nárokům programu. Hodí se když nevíme dopředu, kolik paměti budeme potřebovat, zvlášť pro práci se složitějšími datovými strukturami, jako jsou stromy, grafy atp. Nevýhody. Obtížnější programování, vyšší časové i paměťové nároky programu. (protože se každé přidělení či uvolnění paměti provádí během výpočtu, vzniká vyšší nárok na čas, kromě vlastní paměti ukládáme ukazatele – nároky na paměť. Práce se ukazatelským typem Dynamická proměnná není zavedena deklarací a nemá tedy přidělen identifikátor jako jméno. K její identifikaci se užívají ukazatele – jistá abstrakce adres. Proměnná typu ukazatel neobsahuje data, ale adresu na jinou proměnnou. (místo na části paměti, které se říká halda). Zabírá vždycky 4 B. Typ ukazatele specifikujeme podle dat, na která ukazuje. (ukazatel na integer, na pole, …)

Adresu proměnné můžeme zjistit buď procedurou Addr(jméno poměnné) nebo pomocí unárního operátoru @. ( Můžeme si ji pohlédnout ve Watch listu při trasování programu, o velikosti se přesvědčíme pomocí funkce sizeof(prom))

Příklad: Type Tretez = string[10]; Pretez = ^Tetez; Var P,Q:Tretez; {obor hodnot jsou ukazatelé identifikující řetězce. Konvence: Identifikátor typu začíná na T, identifikátor typu ukazatele na P. (Pointer)


Pomocí ukazatele lze také přistupovat k datům na místě, kam ukazují: P^:=’Ahoj’; } Pro práci s dynamickými proměnnými se používají procedury: New a GetMem pro vytvoření, Dispose a Freemem pro zrušení proměnné. New a Dispose odvodí velikost paměti, kterou mají alokovat podle typu ukazatele,u GetMem a FreeMem je třeba ji zadat. (Getmem(P, SizeOf(string[10])) New(P) alokátor New vytvoří dynamickou proměnnu typu řetěz s nedefinovanou hodnotou a ukazatel na ni se přiřadí do P. (Velikost alokované paměti 10 B) P^:=’Ahoj’; P

Q:=P;

?

P

P

Ahoj

Ahoj

Tady P=Q. protože oba ukazatele ukazují Q na stejné místo v paměti. Pokud např.: New(P); New(Q); P^:=’Ahoj’; Q^:=P^., P a Q mají různou hodnotu. Q

Ahoj

P

Ahoj

NIL ukazatel nikam – neidentifikuje žádnou dynamickou proměnnou. P:=nil; Uvolnění alokované paměti: dispose(P); P:=nil; Poznámky: Procedura new(P) nuluje hodnotu P^. Dispose je možné použít jen pro ukazatel vytvořený alokátorem new.

Lineární spojový seznam je struktura, kde jsou dynamické proměnné propojeny pomocí ukazatelů. V podstatě se jedná o posloupnost záznamů stejného typu seřazených za sebe. Každý prvek struktury je pak přístupný, ale ne přímo (jako u pole přes index), ale sekvenčním procházením seznamu Nejjednodušší je jednosměrný seznam, kterým se budeme zabývat dále. Prvek seznamu je záznam, který obsahuje jednak vlastní hodnotu, jednak ukazatele na následující prvek. (Dají se vytvářet i obousměrně zřetězené seznamy) PPrvek=^Tprvek; TPrvek=record hodnota:integer; dalsi:PPrvek; end;

Q^.hodnota je 0 , Q^.další je koncová šipka

Přidávání před první prvek seznamu: (přepokládejme, že na něj ukazuje ukazatel P.) Nejprve vytvoříme přidávaný prvek: new(q);

q^.hodnota:=0;


Potom ho připojíme před seznam (Do q^.další dosadíme P) q^.dalsi:=p; a na závěr posuneme ukazatel na začátek seznamu na nový začátek.

p:=q;

Vytvoření seznamu čísel 1 2 3 4 5 a jeho zobrazení do listboxu: procedure TForm1.Button2Click(Sender: TObject); var i:integer;p,q:pprvek; begin new(P); p^.hodnota:=5; p^.dalsi:=nil; for i:=4 downto 1 do begin new(q); q^.hodnota:=i; q^.dalsi:=p; p:=q; end; q:=p; while q<>nil do begin listbox1.items.add(inttostr(Q^.hodnota)); q:=q^.dalsi; end; end; Někdy se hodí seznam obousměrný – každý uzel obsahuje jednak vlastní informační hodnotu a dále dva ukazatele – na svého předchůdce a následníka.. Má sice vyšší paměťové nároky, ale některé operace (vypouštění prvku) se v něm snáze implementují.

Cvičení: Vytvořte spojový seznam záznamů o osobách – pro každou evidujete jméno (řetězec) a body (celé číslo). Nejprve vznikne ukazatel na prázdný seznam, pak bude možné přidávat pomocí formuláře. Na požádání uživatele se seznam zobrazí do Listboxu nebo Mema, zobrazí se osoba s max. počtem bodů a průměrný počet bodů.

Řešení: type osoba=record jmeno:string; body:integer; end; Puk=^Tpolozka; Tpolozka=record obsah:osoba; dalsi:Puk; end; var hlava:Puk; procedure TForm1.Button1Click(Sender: TObject);


begin hlava:=nil; showmessage('Byl vytvoren prazdny seznam'); end; procedure TForm1.Button2Click(Sender: TObject); var P:Puk; begin new(P); p^.obsah.jmeno:=Edit1.Text; p^.obsah.body:=StrToInt(Edit2.Text); p^.dalsi:=hlava; hlava:=p; edit1.Clear; edit2.clear; edit1.setfocus; end; procedure TForm1.Button3Click(Sender: TObject); var p:Puk; s:string; begin p:=hlava; Listbox1.clear; while p<>nil do begin s:=p^.obsah.jmeno+'***'+ IntToStr(p^.obsah.body); Listbox1.items.add(s); p:=p^.dalsi; end; end; procedure TForm1.Button4Click(Sender: TObject); var p:Puk; max:osoba; begin p:=hlava; max.body:=-10; while p<>nil do begin if max.bodynil do begin prum:=prum+p^.obsah.body; inc(poc); p:=p^.dalsi; end; prum:=prum/poc; showmessage('prumer bodu: '+FloatTostrF(prum,ffFixed,6,2)); end;

17. Práce se spojovým seznamem Projdeme si některé operace s lineárním spojovým seznamem, typ položek v uzlech zatím budou celá čísla. type Uk=Ûzel; Uzel=record Info:T


Info:T; {ukládaný typ} Dalsi:Uk; end; 1. Vytvoření lineárního spojového seznamu n položek vytvářením od konce přidáváním před existující prvky. procedure vytvor(n:integer; var p:Uk); {p ukazuje na zacatek seznamu} var q:uk; begin p:=nil; {nejprve vytvorime prazdny seznam} for i:=1 to n do begin new(q); q^.info:=n; q^.dalsi:=p; {pridam novy prvek q na zacatek} p:=q; {novy zacatek} end; end; 2. Vytvoření lineárního spojového seznamu n položek vytvářením od začátku ke konci – tedy přidáváním na konec. Abychom nemuseli před každým přidáním procházet celý seznam, budeme si pamatovat také ukazatele na poslední prvek. procedure vytvor2(n:integer;var p:uk); var q,r:Uk; i:integer; {p – prvni prvek, q – posledni prvek, r – prave vytvareny prvek} begin new(p); {nejprve vytvorime prvni prvek} p^.info:=1; p^.dalsi:=nil; q:=p; {prvni prvek je v tutochvili take poslednim prvkem} for i:=2 to n do begin new(r); r^.info:=I; q^.dalsi:=r; {pripojime novy za posledni prvek} q:=r; {posuneme ukazatele na konec na tento novy posledni prvek} end; q^.dalsi:=nil; {ukonceni seznemu} end; 3. Vkládání prvku do lineárního spojového seznamu za daný. procedure VlozZa(p,q:uk); {p ukazuje na prvek seznamu, za ktery se ma vkladat; q na nove vkladany prvek} begin q^.dalsi:=p^.dalsi; {podrzime si konec seznamu za p} p^.dalsi:=q; {vlozime pred nej q} end; 4.Vkládání prvku do seznamu před daný prvek {p ukazuje na prvek seznamu, pred ktery se ma vkladat; q na nove vkladany prvek} buď můžeme projít seznam od začátku, nalézt předchůdce prvku p a ze něj vložit q nebo použít trik: nový prvek zapojíme za prvek, na který ukazuje p a vyměníme hodnoty info f uzlech p^ a q^. procedure vlozpred(p,q:uk); var k:integer; begin k:=q^.info; {do k schovame obsah q^} q^:=p^; {zkopirujeme uzel p do q jako celek – info I dalsi} p^.info:=k; {dokoncime vymenu hodnot uzlu} p^.dalsi:=q; {zapojime novy prvek} end; 5. Vypustění prvku, pokud známe jeho předchůdce function Vypust(p:uk):uk; var q:uk;


{p ukazuje na predchudce vypousteneho prvku} {funkce vraci ukazatel na vypousteny prvek nebo nil, pokud byl P posledni prvek sezanmu} begin q:=p^.dalsi; {q ukazuje na ruseny prvek} if q<>nil then begin p^.dalsi:=q^.dalsi; q^.dalsi:=nil; {vypusteni q} end; vypust:=q; end; 6. Obtížnější je vypustit prvek, na který ukazuje daný ukazatel p. Buď můžeme projít seznam od začátku, najít jeho předchůdce a postupovta jako v předchozím případě nebo přesunout hodnotu následníka uzlu p^ do p^ a zrušit jeho následníka. To se ovšem nedá použít pro poslední prvek. 7. Průchod seznamem a provedení nějaké akce X pro každou položku procedure pruchod(p:uk) {p – zacatek seznamu} begin while p<> nil do begin X (p^.info); p:=p^.dalsi; end; end; 8. Hledání prvku s danou vlastností, dejme tomu najít ukazatele na prvek s obsahem X. pozor, pdobně jako u polí není ideální podmínka pro procházení ve tvaru while (q<>nil) and (q^.info<>x) do q:=q^.dalsi; protože na konci seznamu nabyde q hodnoty nil (při úplném vyhodnocování složeneé podmínky), ale přitom se bude chybně testovat q^.info<>x Jako u polí můžeme problém vyřešit použitím pomocné logické proměnné: procedure hledej(p:uk;x:integer):uk; {p – zacatek seznamu, x – hledana hodnota} {pokud je x v seznamu, dostaneme ukazatel na nej, pokud tam neni, vraci funkce nil} var q:uk;nasli:Boolean; begin q:=p; nasli:=false; while (q<>nil) and not nasli do if q^.info=x then nasli:=true else q:=q^.dalsi; hledej:=q; end; Také se dá použít zarážka – když vyhledávanou hodnotu umístíme před hledáním jako poslední prvek seznamu. procedure hledej2(p,r:uk;x:integer):uk; {p – zacatek seznamu, x – hledana hodnota} {r – ukazatel na zarazku, pokud chceme funkci opakovane pouzivat, je lepsi si uakzatel na tento “posledni” prvek pamatovat, nez ho trvale vyhledavat} {pokud je x v seznamu, dostaneme ukazatel na nej, pokud tam neni, vraci funkce nil} var q,r:uk; begin r^.info:=x; q:=p; while (q^.info<>x) do q:=q^.dalsi; if q=r then hledej2:=nil else hledej2:=q; end;

Cvičení: Pracujte se sepojovým seznamem řetězců. Naplňte ho nejprve mechanicky, potom implementujte procedury zobrazení, přidání na konec, na začátek, zjištění, zda seznam obsahuje nějaký řetězec, případně další popsané akce. Řešení type PPrvek=^Tprvek; Tprvek=record obsah:string;


next:Pprvek; end; var Form1: TForm1; h:Pprvek; procedure rada(var p:Pprvek); {vytvori seznam ze znaku A-K} var prv,pos,pom:Pprvek;pismeno:char; begin new(Prv); prv^.next:=nil; prv^.obsah:='A'; pos:=prv; for pismeno:='B' to 'K' do begin new(pom); pom^.obsah:=pismeno; pos^.next:=pom; pos:=pom; end; pos^.next:=nil; p:=prv; end; procedure zobraz(var p:Pprvek); var pom:Pprvek; begin form1.listbox1.items.clear; pom:=p; while pom<>nil do begin form1.listbox1.items.add(pom^.obsah); pom:=pom^.next end; end; procedure nazac(var p:Pprvek); {prida obsah edit. policka na zacatek} var pom:Pprvek; begin new(pom); pom^.obsah:=form1.edit1.text; pom^.next:=p; p:=pom; form1.Edit1.clear; form1.edit1.setfocus; end; procedure TForm1.Button2Click(Sender: TObject); begin rada(h); zobraz(h); end; procedure TForm1.Button3Click(Sender: TObject); begin nazac(h); zobraz(h); end; procedure zrus(var p:pprvek); {uvolneni pameti seznamu} var pom:PPrvek; begin while p<> nil do begin new(pom); pom:=p;


p:=p^.next; dispose(pom); end; end; procedure TForm1.FormDestroy(Sender: TObject); begin zrus(h); end; procedure nakon(var p:Pprvek); var pos,nov:pprvek; begin if p=nil then begin new(nov); nov^.obsah:=form1.edit1.Text; nov^.next:=nil; p:=nov; end else begin pos:=p; while pos^.next<>nil do pos:=pos^.next; new(nov); nov^.obsah:=form1.edit1.Text; nov^.next:=nil; pos^.next:=nov; end; form1.Edit1.clear; form1.edit1.setfocus; end; procedure TForm1.Button4Click(Sender: TObject); begin nakon(h); zobraz(h); end; procedure TForm1.FormCreate(Sender: TObject); begin new(h); end; procedure TForm1.Button5Click(Sender: TObject); {odeber prvni} var pom:pprvek; begin pom:=h; h:=h^.next; dispose(pom); zobraz(h); end; function jetam(var p:Pprvek;s:string):Pprvek; var vys,pom:pprvek; begin vys:=nil; pom:=p; while (vys=nil) and (pom<>nil) do if pom^.obsah=s then vys:=pom else pom:=pom^.next; Jetam:=vys; end; procedure TForm1.Button1Click(Sender: TObject);


{odeber posledni} var pom,rus:pprvek; begin pom:=h; if pom^.next=nil then dispose(pom) else begin while pom^.next^.next<> nil do pom:=pom^.next; {pom ukazuje na predposledni prvek} rus:=pom^.next; dispose(rus); pom^.next:=nil; zobraz(h); end; end;

procedure TForm1.Button7Click(Sender: TObject); begin if edit1.text='' then showmessage ('nejprve zadej hledane slovo do edit.policka'); if jetam(h,edit1.Text)<>nil then showmessage('jetam') else showmessage('neni tam') end; procedure TForm1.Button8Click(Sender: TObject); {ruseni vyhledaneho prvku} var pom,rus:pprvek; begin if edit1.text='' then showmessage('nejprve zadej hledane slovo do edit.policka'); if jetam(h,edit1.Text)<>nil then begin showmessage('jetam a likviduji ho'); if jetam(h,edit1.Text)^.next<>nil then {neni posledni} begin new(rus); pom:= jetam(h,edit1.Text); rus:=pom^.next; pom^.obsah:=pom^.next^.obsah; {dam do nej obsah naslednika a toho zrusim} {prepojim} pom^.next:=rus^.next; rus^.next:=nil; dispose(rus) end else {pokud je posledni, zrusime ho zvlast} begin pom:=h; while pom^.next^.next<> nil do pom:=pom^.next; {pom ukazuje na predposledni prvek} rus:=pom^.next; dispose(rus); pom^.next:=nil;


end; zobraz(h); end else showmessage('neni tam'); end;

18. Rekurze Je volání procedury nebo funkce dřív, než bylo dokončeno předchozí volání. Jedná se o analogii postupu, který znáte z matematiky – rekurentní určení posloupnosti. Pro jistotu si připomeňme: Většinou posloupnost zadáváme vzorcem pro n-tý člen nebo rekurentně: zadáme první člen, (eventuelně potřebný počet členů z počátku posloupnosti) a předpis, jak pomocí předchozích členů vypočítat člen následující. Přímá – volám tutéž funkci ze sebe samé nepřímá – f1 – f2 – f1…

Příklad 1. Výpočet n-tého členu Fibbonaciho posloupnosti: n = 0 F0 = 0 n = 1 F1 = 1 n > 1 Fn = Fn-1 +Fn-2 F2=1 F3=2 F4=3 F5=5 … function FIB(n: integer):integer; begin if n=0 then fib:=0 else if n=1 then fib:=1 else fib:=fib(n-1)+fib(n-2); end. Průběh volání Fib(4) Fib(3) Fib(2) Fib(2) Fib(1) Fib(1) Fib(0) Fib(1) Fib(0) 1 1 0 1 0 Poznámka k syntaxi: možná jste si dříve všimli, že když napíšete identifikátor funkce na pravé straně přiřazovacího příkazu, překladač vás upozorní,že očekává levou závorku – předpokládá totiž právě rekurzivní volání. Z hlediska efektivity je rekurze nevýhodná. Každé její volání vyžaduje provedení určitých pomocných akcí (např. vymezení paměti pro lokální proměnné) – takže se jí z praktických důvodů spíš vyhýbáme. Na druhou stranu představuje jiný způsob realizace cyklu a může velmi přirozeně zjednodušit některé úlohy

Příklad 2. Hanojské věže

1. 2. Úkol: Přeneste n disků z věže 1. na věž 3., věž 2. můžete používat jako pomocnou. Pravidla 1. V každém kroku lze přenést jediný disk 2. Nelze položit větší disk na menší 3. Můžeme si pomáhat třetí tyčí.


3.

Myšlenka: Mám-li dostat všechno na 3. tyč, musím tam nejdřív umístit největší disk, k tomu účelu je ovšem nutné ho uvolnit: 1. Přeneseme n – 1 disků z tyče 1. na tyč 2. 2. Přeneseme disk z tyče 1. na tyč 3. 3. Přeneseme n – 1 disků z tyče 2 na disk 3. Přemístění n – 1 disků z jedné tyče na druhou je ovšem jen řešení původního problému s menším počtem disků => rekurze. procedure TForm1.Button3Click(Sender: TObject); procedure hanoj(n:integer); procedure prenesdisk(z,na:integer); begin listbox1.items.add('prenes disk z tyce '+inttostr(z)+' na tyc '+inttostr(na)); end; procedure prenesvez(odkud,kam,pomoci,n:integer); begin if n>0then begin prenesvez(odkud,pomoci,kam,n-1); prenesdisk(odkud,kam); prenesvez(pomoci,kam,odkud,n-1); end; end; begin listbox1.clear; prenesvez(1,2,3,n); end; begin hanoj( strtoint(edit1.text)); end; Některé další příklady užití rekurze: Quick Sort – třídění rozdělováním (brzy bude) Tvorba a procházení složitějších datových struktur (binární stromy) Kvadrantový strom Příklad o mrkvi a petrželi Na zahradě je 10 záhonků vedle sebe. Na každá zaseju mrkev nebo petržel. Kolika různými způsoby lze osázet záhony, pokud nechci mít nikde 2 záhony s petrželí vedle sebe? Na 1. záhonku může být mrkev nebo petržel – 2 možnosti. Je-li na prvním mrkev, může být na druhé, mrkev nebo petržel, je-li na prvním petržel, může tam být pouze mrkev. – 3 možnosti … M P 2 M P M 3 M P M M P 5 M P M M P M P M 8 … Fibonacciho posloupnost – na 10. záhonku bude 55 + 89 = 144. (Hledám Fib(11)) Algoritmus kvadrantového stromu Pokud je obrázek prezentován maticí barevných bodů, nebere se ohled na velké plochy stejné barvy. Obraz se rozdělí na pravidelné čtverce a testuje se pokrytí pixely stejné barvy. Pokud je čtverec těmito pixely pokryt, končím, jinak opakuji dělení na čtverce.

Cvičení: Naprogramujte nerekurzivní funkci pro výpočet Fibbnacciho posloupnosti, řešte pomocí ní příklad o mrkvi a petrželi. 2. Naprogramujte rekurzivní funkci pro výpočet faktoriálu 3. Naprogramujte rekurzivní a nerekurzivní funkci pro výpočet kombinačního čísla (Můžete použít vzorců a tím pádem funkcí s faktoriály, ale tady dojde brzy k přetečení) 1.


n  n  n! n * (n − 1) * ...(n − k + 1)  =   =  ; n>=k>=1 = k n k ( n − k ) ! n ! −    

Rekurentně počítáme kombinační čísla z Pascalova trojúhelníka:

 0   1  1  n   n    =   =   =   =   = 1;  0   0  1  0   n 

Řešení 1.Fibbonacci nerekurzivně function f(n:integer):integer; var i,new,old,mid:integer; begin old:=0;mid:=1; for i:=1 to n do begin new:=old+mid; old:=mid; mid:=new; end; f:=new; end;

 n   n   n + 1   =    +   k   k + 1  k + 1

Mrkev a petržel procedure TForm1.Button1Click(Sender: TObject); var n,i:integer; begin listbox1.clear; n:=12; for i:=1 to n do listbox1.items.add(inttostr(fib(i))); end; 2. Faktoriál: function faktor(n:integer):integer; begin if n=0 then faktor:=1 else faktor:=faktor(n-1)*n end; 3. Kombinační číslo z Pascalova trojúhelníku rekurzivně function komb(n,k:integer):integer; begin if (n=0) and (k=0) then komb:=1 else if (k=0) or (k=n) then komb:=1 else komb:=komb(n-1,k-1)+komb(n-1,k); end; 4. Kombinační číslo nerekurzivně function kc(n,k:integer):integer; var i,p:integer; begin if k>n div 2 then k:=n-k; p:=1; for i:=1 to k do p:=p*(n-i+1) div i; result:=p; end;

19. Vyhledávání problém vyhledávání – přístup k datům uloženým ve strukturách Efektivnost algoritmů většinou poměřujeme počtem operací srovnání, které algoritmus potřebuje. Počet prvků dále uvažujeme n. Podoby:


• • •

počet výskytů vyhledávané položky, jejich umístění, logická informace – je nebo není ve struktuře přítomen účel vyhledání – editace položky, rušení, vkládání za nebo před… podoba struktury – pole, soubor, spojové seznamy, stromy, grafy…

Sekvenční vyhledávání v nesetříděné struktuře Složitost v nejhorším případě n – pokud prvek v poli není a je nutné ho projít celé Varianta se složenou podmínkou function Jetam(b:pole;x:integer):boolean; var nasel:boolean;i:integer; begin i:=1; nasel:=false; while not nasel and(i<=n) do if b[i]=x then nasel:=true else inc(i); jetam:=nasel; end; Varianta se zarážkou Vyhledávaný prvek se umístí na konec pole, složitost asi o 20% lepší, v nejhorším případě stejné (odpadne testování složené podmínky function zarazka (b:pole;x:integer):boolean; var i:integer; begin b[n+1]:=x; i:=1; while b[i]<>x do inc(i); zarazka:=(i<=n) end; Transpoziční heuristika Vyhledaný prvek vždy přesuneme na začátek pole, takže často vyhledávané prvky se dostanou na začátek a budou se vyhledávat kratší dobu.

Binární vyhledávání v setříděné posloupnosti Prvek porovnáme s prostředním, je-li menší, opakujeme hledání v první polovině struktury, je-li větší, ve druhé. Při prvním porovnání tak vyřadíme polovinu prvků, při druhém čtvrtinu…v nejhorším případě odpovídá počet porovnání:log2n Setříděná posloupnost se ale moc nehodí pro vkládání, proto vznikly další struktury. function binvyh(b:pole;x:integer):boolean; var i,j,s:integer; begin i:=1; j:=n; repeat s:=(i+j) div 2; if x>=b[s] then i:=s+1; if x<=b[s] then j:=s-1; until i>j; binvyh:=(x=b[s]) end;

Binární vyhledávací strom je složitější datová struktura používaná pro ukládání a vyhledávání údajů. Nejprve minimum potřebné teorie: Graf Termín graf používá matematika ve dvou odlišných významech. první, který známe takřka důvěrně, je grafické vyjádření průběhu matematické funkce.


Druhý význam(studuje teorie grafů) – graf si můžeme představit jako soustavu bodů (uzlů nebo vrchol grafu), spojených čarami – hrany grafu. pro účely programování vystačíme s konečným grafem, obrázek, který vytvoříme z vrcholů a hran se nazývá nakreslení grafu. tentýž graf má řadu různých nakreslení. Orientovaný graf je takový, kde hrany jsou představovány uspořádanými dvojicemi vrcholů. V nakreslení používáme šipku z prvního uzlu do druhého. Ohodnocené grafy jsou takové, kde uzlům přiřazujme hodnotu. (číslo, ale i záznam…) Cestou z vrcholu x do y nazýváme posloupnost hran, po které dojdeme z x do y. Cesta, která končí ve vrcholu, ze kterého vyšla, se nazývá cyklus Acyklický graf neobsahuje žádný cyklus. Strom je zvláštní případ acyklického grafu, zakořeněný strom má následující tvar: jeden význačný vrchol je kořenem grafu, ten má několik následníků (listů), z nichž každý má své následníky. Žádný vrchol ale není synem více otců. Vrcholy, které nemají následníky, se nazývají listy. Binární strom je takový, kde každý uzel má nejvýš dva následníky.

Jaký je vztah mezi výškou h stromu (počet pater) a počtem uzlů stromu N? Pokud by měl každý uzel jen jednoho následníka, dostaneme degenerovaný strom, kde h=n. pro naše účely je nejpříznivější případ, kdy má každý otec dva syny ( s výjimkou listů), takovému stromu říkáme vyvážený. Začíná kořenem, na první hladině má dva uzly, na druhé čtyři… Na k-té hladině má takový strom 2k-1 uzlů.Počet uzlů je n, tedy: 1 +2 +4 +…..2h-1 = n

2h −1 =n 2 −1

2h =n+1 h = log2(n+1), což je přibližně log2(n). Binární vyhledávací strom je orientovaný graf. Kořen – výchozí prvek Listy – nemají následníky Podstrom – část, která je rovněž stromem Binární – každý uzel má dva následníky. BVS – hodnota uložená v uzlu je větší než hodnoty uložené v levém podstromu a menší, než hodnoty v pravém podstromu.

16

24 16

4 levý podstrom 1

11 16 10 6

31 16

19 16 13 6

32 16

26 16

pravý podstrom

Hledanou hodnotu porovnáme s kořenem, když je menší, opakujeme hledání v levém podstromu, jinak v pravém Složitost je úměrná výšce a struktuře stromu.


V případě ideálně košatého stromu (halda) je log2n, v případě stromu bez větví (degenerovaný strom) počtu prvků n. Implementace: type PUzel=Ûzel; Uzel=record obsah:integer; lsyn,psyn:PUzel; end; function hledej(m:PUzel;x:integer):Puzel; {m ukazatel na koren stromu x hledana hodnota Je-li tam, vraci fce ukazatel na prislusny uzel, jinak nil} var nasli:boolean; begin nasli:=false; while (m<>nil) and not nasli do if m^.obsah=x then nasli:=true else if m^.obsah>x {jdu vlevo} then m:=m^.lsyn else m:=m^.psyn; {jdu vpravo} hledej:=m; end; Při přidávání uzlu do binárního stromu (postupným přidáváním strukturu vybudujeme), se postupuje analogicky, je třeba si zapamatovat uzel, kde procházení stromu skončilo a kam máme přidat uzel s novou hodnotou. Komplikovanější je vypouštění uzlu ze stromu.

Cvičení: 1. Naplňte pole celých čísel a vyzkoušejte si vyhledávací algoritmy. 2. Naplňte soubor setříděnou posloupností celých čísel a vyzkoušejte si binární vyhledávání. 3. Vybudujte binární vyhledávací strom a vyzkoušejte si vyhledávání v něm. Řešení 2. var f:file of integer; procedure TForm1.Button1Click(Sender: TObject); var i,x:integer; begin assignfile(f,'soubor.dat'); rewrite(f); x:=random(10); for i:=1 to 20 do begin write(f,x); listbox1.Items.add(inttostr(x)); x:=x+random(10); end; end; procedure TForm1.Button2Click(Sender: TObject); var i,j,s,n,x,y:integer; begin reset(f); x:=StrToInt(Edit1.Text); n:=filesize(f)-1; i:=0; repeat s:=(i+n) div 2;


seek(f,s); read(f,y); if x<=y then n:=s-1;{jdeme doleva} if x>=y then i:=s+1; {jdeme doprava} until i>n; if x=y then showmessage('nasli') else showmessage('nenasli') end; 3. type PUzel=Ûzel; Uzel=record obsah:integer; lsyn,psyn:PUzel; end; var koren:PUzel; Prázdný strom procedure TForm1.Button7Click(Sender: TObject); begin koren:=nil; end; Přidání do stromu procedure pridej(var m:PUzel;x:integer); {pri pridavani uzlu se postupuje jako pri vyhledavani, jen je treba pamatovat si uzel, v nemz prochazeni stromem skoncilo a pod ktery chceme pripojit novy uzel s pridavanou hodnotou m ukazatel na koren stromu x pridavana hodnota je-li tam uz, strom se nezmeni} var nasli:boolean; u:Puzel; {zkoumany uzel} pred:Puzel ;{jeho predchudce} begin nasli:=false; u:=m; pred:=nil; while (u<>nil) and not nasli do if u^.obsah=x then nasli:=true {konec} else if u^.obsah>x {jdeme doleva} then begin pred:=u; u:=u^.lsyn; end else {jdeme doprava} begin pred:=u; u:=u^.psyn; end; if not nasli {pripojit novy uzel za Pred} then begin new(u); u^.obsah:=x; u^.lsyn:=nil; u^.psyn:=nil; if pred=nil {novy koren stromu} then m:=u else if pred^.obsah>x then pred^.lsyn:=u else pred^.psyn:=u


end; end; Vyhledávání ve stromu procedure TForm1.Button8Click(Sender: TObject); {hodnoty se zobrazuji pod sebe do listboxu a soucasne ukladaji do BVS} var x:integer; begin x:=spinedit2.Value; if listbox2.items.indexof(inttostr(x))<0 then listbox2.Items.add(inttostr(x)); pridej(koren,x); end; function hledej(m:PUzel;x:integer):Puzel; {m ukazatel na koren stromu x pridavana hodnota Je-li tam, vraci fce ukazatel na prislusnzy uzel, jinak nil} var nasli:boolean; begin nasli:=false; while (m<>nil) and not nasli do if m^.obsah=x then nasli:=true else if m^.obsah>x {jdu vlevo} then m:=m^.lsyn else m:=m^.psyn; {jdu vpravo} hledej:=m; end; procedure TForm1.Button10Click(Sender: TObject); begin if hledej(koren,spinedit2.value)=nil then showmessage('neni') else showmessage('je'); end;

20. Třídění aneb jak ukládat data, aby k nim byl snadný přístup Problém: je dáno pole A[1]..A[n] nějakých prvků (v praxi tvorby informačních systémů nejčastěji záznamů) Chceme, aby po proběhnutí třídícího algoritmu platilo: a[1]<=a[2]<=… a[n] U záznamů třídíme podle jedné (v případě rovnosti podle další…) položky, které se říká třídící klíč.

Metoda rozděl a panuj Někteří autoři tak nazývají princip rozdělení problému na několik relativně nezávislých částí a jejich realizaci formou podprogramů. Většinou jde ale o techniku hledání algoritmů při řešení problémů. (ne jakýchkoliv) Řešený problém se rozdělí na dva nebo více menších podproblémů podobných problému původnímu. Dílčí problémy se vyřeší nezávisle na sobě a z nich se pak skládá celkový výsledek. Přehled: • Analýza Problémy konstantního rozsahu řešíme (třídění pole délky 1), zbytek se rozkládá na problémy menšího rozsahu. Vyvážený rozklad: n/2,…n/2 Nevyvážený rozklad 1,..n-1 • Rekurze


podproblémy menšího rozsahu se řeší stejně, až se dostaneme k problémům konstantního rozsahu, které umíme řešit. • Syntéza z vyřešených úloh menšího rozsahu syntetizujeme řešení původního problému.

Přehled nejznámějších algoritmů, složitost (opět porovnáváme počet srovnávacích operací, ve všech programových ukázkách třídíme pole p o 1..n celých číslech) Vsouvání a[1]<=a[2]<=…a[k] a[k+1] ? a[k+2]…? a[n] První část pole je setříděna, chceme zařadit další prvek. Začneme ho porovnávat se zařazenými prvky, když zjistíme místo, kam patří, zbytek odsuneme o jedno místo doprava. Složitost v nejhorším případě (opačně setříděné pole): 1+2+3+…n = n*(n-1)/2 ~ n2 – kvadratický algoritmus Nejlepší případ – setříděná posloupnost, složitost ~ n. (Na umístění jednoho prvku potřebujeme jedno porovnání) var i,j,x:integer; begin p[0]:=-maxint; for i:= 2 to n do begin j:=i; x:=p[i]; while p[j-1]>x do begin p[j]:=p[j-1]; dec(j); end; p[j]:=x; end; end; Přímý výběr Zabýváme se vždy úsekem pole od i do n, vyhledáme v něm minimum a vyměníme ho s i-tým prvkem. Složitost je opět kvadratická, navíc nerozlišuje nejlepší a nejhorší případ. (Rychlost při spuštění na počítači vyplývá z toho, že údaje pro for-cykly se připravují do cache procesoru, čímž se zpracování zrychlí) var i,j,imin:integer; begin for i:=1 to n-1 do begin imin:=i; for j:=i to n do if p[j]p[j+1] then vymen (p[j],p[j+1]); end; var i:integer;b:boolean; begin repeat b:=false;


for i:=1 to n-1 do if p[i]>p[i+1] then begin vymen(p[i],p[i+1]); b:=true; end until not b; end; Haldování Halda je v podstatě "hodně košatý" binární strom. (Přesná definice: • Cesty z kořene do listů se liší maximálně o jedničku • Listy mohou chybět jen v posledním patře a to zprava • Otec>= synové, levý syn>=pravý syn Princip algoritmu: Když bychom měli haldu hotovou, v jejím kořenu je maximum. Umístíme ho nakonec tříděné posloupnosti a uděláme haldu ze zbytku… Postup: • z tříděných prvků se vybuduje halda • halda se rozebere na setříděnou posloupnost Halda se dá implementovat jednorozměrným polem, jestliže otec má index [i], levý syn [2*i] a pravý syn [2*i+1], kořen haldy má index 1. Složitost je v nejhorším případě n*log2n, hodí se obzvlášť pro velké soubory. var i:integer; procedure Restore(i,j:integer); var k,m:integer; begin k:=i; while k<=j div 2 do begin if (2*k=j)or(p[2*k]>=p[2*k+1])then m:=2*k; {m je index syna, se kterym je treba porovnat vrchol} if p[m]>p[k] then begin vymen(p[k],p[m]); k:=m; end else k:=j end; {budovani haldy} end; begin for i:=(n div 2) downto 1 do restore(i,n); {[1]..p[n] je halda} for i:=n downto 2 do begin vymen(p[1], p[i]); {rozebirani haldy na setridenou posloupnost} restore(1,i-1) end ; end; Slučování Princip: postupné spojování dvou setříděných posloupností do jedné setříděné posloupnosti. Nejdřív setřídíme jednotlivé prvky do dvojic, dvojice do čtveřic,.. Délky pomocných posloupností: 20, 2, …n/2 Počet posloupností k: n/2 = 2k-1 takže k je přibližně log2n. V každé fázi provádíme n srovnání… celková složitost: n log2n Nevýhody: Není-li délka výchozí posloupnosti mocnina dvou, je to složité, navíc je algoritmus náročný na paměť. (používá pomocní pole) Rozdělování prakticky nejrychlejší algoritmus procedure Quick(k); {k – delka posloupnosti} begin if k>1 then begin Vyber z pole nejaky prvek (pivot) Vytvor dve nove posloupnosti : A={prvky mensi nebo rovny pivotovi}


B={prvky vetsi nez pivot} Quick(A)+pivot+Quick(B) {rekurze} end; procedure quickSort(var a:pole); procedure Sort(l,r:integer); var i,j,x:integer; begin i:=l;j:=r;x:=a[(l+r) div 2];{pivot} repeat while a[i]<x do inc(i); while xj; if l<j then sort(l,j); {pokud jsou nehotove kusy, pokracujeme stejne} if i
Klasifikace uvedených algoritmů z hlediska Divide et impera Nevyvážený rozklad s důrazem na analýzu: přímý výběr, bubliny, hlasování Nevyvážený rozklad s důrazem na syntézu: vsouvání Vyvážený rozklad s důrazem na syntézu: slučování Vyvážený rozklad s důrazem na analýzu: rozdělování

Cvičení: 1. Naplňte pole z generátoru náhodných čísel, zobrazte ho a vyzkoušejte si některé algoritmy 2. Slučte dvě setříděná dynamická pole do třetího 3. Vsuňte do setříděného souboru prvek tam kam patří. Řešení 2. type pole=array of integer; var a,b,c:pole; k,l,m:integer; procedure generuj(var p:pole;var n:integer); var i:integer; begin n:=random(10)+5; setlength(p,n); for i:=0 to n-1 do p[i]:=i+random(2); end; procedure zobraz(p:pole;l: tlistbox); var i:integer; begin l.Clear; for i:=0 to high(p) do l.Items.add(inttostr(p[i])); end; procedure TForm1.Button1Click(Sender: TObject); begin generuj(a,k); generuj(b,m); zobraz(a,listbox1);


zobraz(b,listbox2); end; procedure TForm1.FormCreate(Sender: TObject); begin randomize; end; procedure TForm1.Button2Click(Sender: TObject); var i,j,k,pom:integer; begin i:=0; pom:=high(a)+high(b); setlength(c,pom+2); j:=0;k:=0; while (i<=high(a)) and (j<=high(b)) do begin if a[i]x)and not eof(f) do read(f,x); {pokud je vkladanz prvek nejvetsi, prijde na konec} if eof(f) then write(f,y) else {budeme odsunovat} begin n:=filepos(f)-1; {kam prijde y} for i:=filesize(f)-1 downto (n)do begin seek(f,i); read(f,x); write(f,x); end; seek(f,n); write(f,y); end; seek(f,0); listbox2.Clear;


while not eof(f) do begin read(f,x); listbox2.Items.add(inttostr(x)); end; end;

21. Výčtový typ, grafické tlačítko s bitmapou Je podobně jako typ interval uživatelem definovaný ordinální typ. Pro jistotu si zopakujme: Ordinální typ: integer, char, boolean. Má nejmenší a největší hodnotu a každá hodnota uvnitř má svého následníka a předchůdce. Funkce a procedury low, high, ord, pred,succ a ord, pro znaky inverzní funkce k ord je chr. Příklady: low(integer)=-2147483648, pred(3)=2, ord(false)=0 Typ interval je podmnožinou některého ordinálního typu. Např: Type cifry=0..9; Procedury inc a dec dosadí do hodnoty proměnné následníka nebo předchůdce Při definici výčtu se uvádí seznam všech možných hodnot, ordinální číslo odpovídá pořadí, ordinální číslo první položky je nula. Příklad: Type planeta=(Merkur, Venuse, Zeme, Mars, Jupiter, Saturn, Uran, Neptun, Pluto) Succ(Jupiter)=Saturn, plati Zeme<Mars (Planety jsou seřazeny v tomto pořadí, nikoliv podle abecedy) Protože jde o ordinální typ, dají se použít v příkazu case i ve for cyklu. Delphi umějí pracovat s výčtovým typem také podobně jako s polem – Planeta(0) je Merkur Mnoho vlastností v Delphi je definováno jako výčtový typ. Např.: type TFormBorderStyle = (fbsNone, fbsSingle, fbsSizeable, fbsDialog, fbsToolWindow, fbsSizeToolWin); Výčtové typy se často používají v záznamech. Např: Tstav=(svobodny,zenaty,vdovec); Tosoba=record jmeno:string; plat:integer; stav:Tstav; end;

Obrázková tlačítka (Tbitbtn) Třída TBitBtn je potomkem třídy TButton, k vlastnostem obyčejných tlačítek přibývají další, související s používáním bitmap. Jsou na paletě komponent Additional. Lze pro ně nastavit barvu fontu. Některé vlastnosti: Glyph: obrázek, typ Tbitmap (soubor s bitovou mapou) (Při poklepání se spustí Picture editor a tlačítkem Load si můžeme vybrat vhodný soubor. – např. Program Files/CommonFiles/Borland Shared/Images/Buttons). Poznámka: připravené obrázky jsou dva, druhý se týká zakázaného tlačítka a objeví se, když nastavíte vlastnost Bitbtn.enabled:=false; Pozor, tlačítko pak musíte oživit odjinud, samo na klepnutí neraguje. LayOut : poloha obrázku vzhledem k textu. Kind: druh tlačítka – zahrnuje nejen popis a obrázek, ale také chování tlačítka za určitých okolností, např. při stisknutí tlačítka typu bkClose se zavře formulář. Glyph a Layout nastavujeme jen pro tlačítko typu bkCustom. type TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo, bkClose, bkAbort, bkRetry, bkIgnore, bkAll); property Kind: TBitBtnKind;


Skupiny komponent – GroupBox Pokud ji umístíme na fomulář a do ní vložíme několik dalších komponent, stává se GroupBox jejich vlastníkem (jako je formulář vlastníkem komponent na něm) To umožňuje souhrnnou manipulaci s těmito komponentami. (např. jejich zneviditelnění zneviditelněním GroupBoxu: GroupBox1.visible:=false;) GroupBox se chová jako pole komponent, jejich počet je ControlCount, indexuje se od nuly. Protože vložené komponenty mohou být nejrůznějšího typu, je třeba ohlídat přetypování. Kdybychom chtěli například zaškrtnout všechna políčka na obrázku. for i:=0 to groupbox1.ControlCount-1 do ((GroupBox1.Controls[i])as Tcheckbox).checked:=true;

Příklady

1. Na formulář umístíme tlačítko, jeho typ bude TBitbtn, přiřadíme mu obrázek Při stisknutítlačítka typy tlačítek se budou postupně zobrazovat všechny druhy – Titbtnkind. rocedure TForm1.FormCreate(Sender: TObject); begin bitbtn1.kind:= bkcustom; end; procedure TForm1.BitBtn1Click(Sender: TObject); begin if bitbtn2.kind=bkall then bitbtn2.kind:= bkcustom else bitbtn2.kind:=succ(bitbtn2.kind) {pozor pri kliknuti na bkClose se zavre formular} end; Pdobně by fungovaly další příkazy:( i je globální proměnná, inicializujeme ji na 0 v metodě FormCreate) if i=ord(high(TBitbtnKind))then i:=0 else inc(i); BitBtn2.Kind:=TBitBTnKind(i); 2. vstup dne – pořadové číslo (1 – pondělí), další tlačítka zobrazují co je na nich napsáno. type den=(pondeli, utery, streda, ctvrtek, patek, sobota, nedele); var day:den; procedure ctiden(var d:den); begin case form1.spinedit1.value of 1: d:=pondeli; 2: d:=utery; 3: d:=streda; 4: d:=ctvrtek; 5: d:=patek; 6: d:=sobota; 7: d:=nedele;


end; end; procedure pisden(d:den); var s:string; begin case ord(d) of 0: s:='pondeli'; 1: s:='utery'; 2: s:='streda'; 3: s:='ctvrtek'; 4: s:='patek'; 5: s:='sobota'; 6: s:='nedele'; end; showmessage(s); end; procedure TForm1.Button2Click(Sender: TObject); begin ctiden(day); pisden(day); end; procedure TForm1.Button3Click(Sender: TObject); begin if day=nedele then day:=pondeli else day:=succ(day); pisden(day); end; procedure TForm1.Button4Click(Sender: TObject); begin if day=pondeli then day:=nedele else day:=pred(day); pisden(day); end; procedure TForm1.Button5Click(Sender: TObject); begin if (day<>nedele) and (day<>sobota) then showmessage('ano') else showmessage('ne'); end; Pro vstup dat výčtového typu by se hodil seznam – listbox, radiogroup nebo rozvírací seznam combobox. Tento seznam vypadá jako editační řádka, vedle které je malá šipka. Pokud klepneme na šipku, rozvine se nabídka. Jeho jednou výhodou je úspora místa, další pak skutečnost, že komponenta sama umístí vybraný text do editační řádky. (text v editační řádce je Combobox1.text, položky jsou Combobox1.Items a jsou typu Tstrings. Přidávání do rozvíracího seznamu: procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char); begin if key=#13 then begin if (ComboBox1.Items.IndexOf(ComboBox1.text)<0) {text z editacniho policka neni v nabidce} and (ComboBox1.text<>'') then begin ComboBox1.Items.Add(ComboBox1.text); combobox1.Text:=''; end; end end;


Pokud vytvoříme formulář, kde budeme vybírat z více seznamů nebo vyplňovat několik políček, můžeme využít metodu SelectNext(NazevKomponenty, true, true), předá zaměření další komponentě, první parametr je název právě zaměřené komponenty, druhý rozhoduje o směru (true – následující, false – předchozí), poslední souvisí se stavem vlastnosti TabStop. (Help Delphi) Kdybychom chtěli vybírat den z ComboBoxu, můžeme to provést např.takto:´ procedure TForm1.ComboBox1Click(Sender: TObject); begin day:=den(Combobox1.itemIndex); end;

Cvičení: Vymyslete si vlastní příklad na použití výčtového typu – jak vašeho, tak předdefinovaného v Delphi.

22. Standardní dialogová okna, datový typ množina Množiny Tento datový typ se definuje nad některým z ordinálních typů, který má maximálně 256 hodnot. (nejčastěji se užívá výčtový typ nebo interval) Příklad: Type cifry=set of ‘0’..’9’; Type pismena = set of char; Var samohlasky, souhlasky: pismena ….. begin samohlasky:=[‘A’,’E’,’I’,’O’,’U’];souhlasky:=[]; (prázdná množina) Operátor sjednocení + Rozdíl (doplněk) Průnik * In – testuje zda množina obsahuje určitý prvek Souhlasky:=souhlasky+[‘B’,’C’] souhlasky=[‘B’,’C’] If ‘C’in souhlasky then… Samohlasky+souhlasky=:=[‘A’,’E’,’I’,’O’,’U’, ‘B’,’C’]; Samohlasky*souhlasky=[] Jednotlivé prvky lze do množin přidávat buď +[prvek], odebírat –[prvek], nebo můžeme použít procedury include, exclude. (viz nápověda). Implementace Např. pro množinu A=[1,3] typu set of 0..3 0 1

0

1

Častá použití: Když chceme zjistit, které různé prvky se vyskytují ve struktuře, přidáme je do množiny a tu pak zobrazíme: var m:set of 0..99;i:integer; {pole obsahuje nahodna cisla od 0 do 99} begin m:=[];listbox2.Clear; for i:=0 to n do m:=m+[a[i]]; for i:=0 to 99 do if i in m then listbox2.Items.add(inttostr(i)); Když testujeme zda daný objekt nabývá jedné z mnoha hodnot: if ch in samohalsky then… je efektivnější než if (ch=’A’) or… Použití v Delphi K definici nevylučujících se příznaků. Příklad. Vlastnost BorderIcon specifikuje, které ikony se objeví na okraji formuláře: type TBorderIcon = (biSystemMenu, biMinimize, biMaximize, biHelp); TBorderIcons = set of TBorderIcon;


Pokud bychom chtěli například vypínat a zase zapínat zobrazení posledních tří tlačítek v pravém horním rohu okna, můžeme na formulář umístit Label s textem +BiSystemMenu (případně -) a obsloužit klepnutí na něj. procedure TForm1.Label1Click(Sender: TObject); begin if label1.Caption[1]='+' then {label1.caption je retezec – pole znaku, jde tedy o 1. znak. } begin bordericons:=bordericons+[bisystemmenu] ; label1.Caption:='-bisystemmenu' end else begin bordericons:=bordericons-[bisystemmenu]; label1.Caption:='+bisystemmenu' end end;

MessageDlg Sofistikovanější okno se správou. function MessageDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Word; Msg – text správy DlgType – typ dialogu type TMsgDlgType = (mtWarning, mtError, mtInformation, mtConfirmation, mtCustom); Buttons: typ tlačítka se definuje rovněž jako výčtový typ type TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp); Množina tlačítek: TMsgDlgButtons = set of TMsgDlgBtn; Konstanty, které definují podmnožiny této množiny: const mbYesNoCancel = [mbYes, mbNo, mbCancel]; mbYesAllNoAllCancel = [mbYes, mbYesToAll, mbNo, mbNoToAll, mbCancel]; mbOKCancel = [mbOK, mbCancel]; mbAbortRetryIgnore = [mbAbort, mbRetry, mbIgnore]; mbAbortIgnore = [mbAbort, mbIgnore]; Message Dlg je funkce, která má návratovou hodnotu typu ModalResult, podle které (které tlačítko bylo stisknuto na dialogu) můžeme dál větvit program. Tlačítko modalResult mbOK mrOk mbCancel mrCancel mbYes mrYes mbNo mrNo mbAbort mrAbort mbRetry mrRetry mbIgnore mrIgnore mbAll mrAll mbNoToAll mrNoToAll mbYesToAll mrYesToAll Příklad: Ukončovací dialog aplikace: if MessageDlg('Welcome to my Object Pascal application. Exit now?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin MessageDlg('Exiting the Object Pascal application.', mtInformation, [mbOk], 0);


Close; end; Cvičení: 1. Pracujte s množinami malých celých čísel. Zajistěte vstup dvou množin od uživatele, (např. výberem ze seznamu) zobrazte jejich průnik a sjednocení, případně další množinové operace 2. Pracujte s textovým souborem, který zobrazíte do Mema, určete pomocí množiny počet samohlásek v textu. 3. Naeditujte dynamické pole celých čísel, zobrazte různá celá čísla, která se v něm vyskytují a zkuste pole setřídit pomocí četnosti čísel v něm – měly by vám stačit dva průchody, při prvním zjistíte četnosti a při druhém vypíšete do pomocného pole (nebo přímo jen do listboxu) každé číslo tolikrát, jaká je jeho četnost. 4. Zobrazte některý MsgDialog a stisknutím jiného tlačítka na něj přidávejte tlačítka.

Řešení 1. type mnozina=set of 0..9; var x,y:mnozina; b:TMsgDlgButtons ; knoflik:tMsgDlgBtn; … procedure TForm1.FormCreate(Sender: TObject); begin x:=[];y:=[]; end; Přidání do množiny vybraného čísla z listboxu procedure TForm1.ListBox1Click(Sender: TObject); begin x:=x+ [strtoint(listbox1.items[listbox1.itemindex])]; end; Zobrazení množiny procedure ukaz(m:mnozina); var s:string;i:integer; begin s:='[ '; for i:=0 to 9 do if i in m then s:=s+inttostr(i)+' '; s:=s+']'; showmessage(s); end; … Zobrazení průniku procedure TForm1.Button3Click(Sender: TObject); begin ukaz(x*y); end; 2. … počet samohlásek procedure TForm1.Button2Click(Sender: TObject); const sam=['A','E','I','O','U','Y','a','e','i',


'o','u','á','é','í','ù','ú','ó','ì','ý'] ; var poc:integer; x:char; begin poc:=0; reset(f); while not eof(f) do begin read(f,x); if x in sam then inc(poc); end; showmessage(IntToStr(poc)); end; 3. type pole=array of integer; var a:pole; … Různé prvky – viz.text Třídění četností procedure TForm1.FormCreate(Sender: TObject); var i:integer; begin setlength(a,n); randomize; for i:=0 to high(a) do begin a[i]:=random(15); listbox1.Items.add(inttostr(a[i])); end; 4. procedure TForm1.FormCreate(Sender: TObject); begin b:=[]; knoflik:= mbYes; end; . procedure TForm1.Button4Click(Sender: TObject); begin messagedlg('hahaha',mtinformation,b,0); b:=b+[knoflik]; knoflik:=succ(knoflik); end;

23. Menu, další formuláře Přidání formuláře, další vlastnosti Tlačítkem na liště nástrojů nebo File/New Form Formulář je také komponenta, která disponuje zděděnými vlastnostmi a metodami, připomeňme si, jak vypadá projekt, který vzniká když začneme pracovat s Delphi: program Project1; uses Forms, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. Application.CreateForm(TForm1, Form1); – tento příkaz vytvoří instanci třídy TForm1 se jménem Form1. Delphi samy vytvoří všechny formuláře, se které chcete používat hned na začátku programu.


V dialogovém okně na obrázku (Project/Options) lze formuláře přesunout do okna Available Forms, pak se ale o jejich vytvoření musíme postarat sami, jinak vzniká chyba. {$R *.res} – tato direktiva překladače připojí k projektu soubor se zdroji, k nimž patří také ikona. Můžeme ji změnit na kartě Application/Load icon Zobrazení za běhu programu: Form2.show Form2.showModal – v tom případě nelze dělat nic, dokud se tento formulář nezavře. (Tento typ Windows většinou používají pro dialogová okna) S každým formulářem je spojen unit. Při překladu Delphi nabídnou přidání příslušných unitů do implementační sekce, chceme-li je umístit do interface, je nutné to udělat ručně. (implementation uses Unit2, Unit3;) Jeden formulář musí být hlavní, implicitně je to Form1, lze to změnit opět na v okně Project/Options Hlavní formulář se zobrazí při spuštění projektu a jeho uzavření způsobí uzavření aplikace. Kromě přidání nových vlastních formulářů lze použít prefabrikáty a také své formuláře mezi ně přidat. File/New/Others-Forms a vybereme, vybraný formulář je potomek zde umístěného, takže ho lze dál upravovat. Stačí z jeho kontextové nabídky vybrat Add to repository

Akce ShowModal, Show mají také návratovou hodnotu typu ModalResult – takže podle výsledku jde dál větvit program. If aboutbox.showmodal=mrOk then…. Formuláře lze při vývoji aplikace zobrazit –View/Forms. S jejich zobrazením se také otevřou unity. Poznámka: chceme-li pracovat v jednom formuláři s proměnnými druhého, můžeme použít kvalifikovaný identifikátor: JménoFormuláře.JménoObjektu, případně JménoUnitu.JménoObjektu Některé vlastnosti: Width, Height, Top, Left – velikost a poloha na obrazovce Nevytvářejme formuláře zbytečně velké (větší než rozlišení aktuální rozlišení starších užívaných monitorů), aby se vešly na obrazovku. Protože dopředu nevíme, při jakém rozlišení bude náš program spuštěn, vyplatí se na začátku zvolit některou z předdefinovaných možností vlastnosti position. Formulář se zobrazeným systémovým menu můžeme zavrít zavíracím tlačítkem, je vhodné použít také příkaz close. (Form1.close). Aplikaci ukončuje zavření hlavního formuláře. Metoda close vyvolá událost OnCloseQuery, která vrací proměnnou logickou CanClose. Pokud je true, formulář se zavře.

Příklad: Vytvoříme projekt se třemi formuláři, modálním, nemodálním a AboutBoxem, vyzkoušíme si rozdíl v metodách zavírání a některé vlastnosti. var


Form1: TForm1; implementation uses Unit4, Unit2, Unit3; … procedure TForm1.Button3Click(Sender: TObject); begin Aboutbox.left:=strtoint(edit1.Text); AboutBox.top:=strtoint(edit2.Text); AboutBox.show; end; procedure TForm1.Button1Click(Sender: TObject); begin Form2.showmodal; showmessage('AHOJ'); end; procedure TForm1.Button2Click(Sender: TObject); begin form3.show; showmessage('AHOJ'); end; Všimněte si, že u nemodálního okna se vzkaz AHOJ objeví hned, u modálního teprve po jeho uzavření. procedure TForm1.Button4Click(Sender: TObject); begin close; end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose:=MessageDlg('Opravdu konec?', mtConfirmation,[mbYes,mbNo],0)=mrYes end; end.

Hlavní menu (MainMenu) Hlavní nabídka se umísťuje pod záhlaví formuláře, obvykle je víceúrovňová. Paleta komponent Standard – komponenta MainMenu Items – položky – můžeme definovat položky nabídky, stejně dvojklik na menu – tím se spustí Návrhář nabídek (Menu designer) Položky jsou typu TMenu Item a pokud některou vyberme, proběhne její událost OnClick. Tvorba vnořeného menu – místní nabídka položky, Create Submenu ShortCut – klávesová zkratka – v názvech (caption) & před písmenkem způsobí jeho podtržení a volání příslušného příkazu nabídky přes alt + toto písmenko do hlavní nabídky, jinak před písmenko. (Přesněji alt + písmenko rozvine nabídku, písmenko v nabídce spustí akci.) Pokud neprovedeme podtržení ručně, Delphi se o ně postarají samy. Oddělovací čára se vkládá jako pomlčka. Píšeme-li caption, vytváří se z něj name dle konvence převodu „windowsích“ názvů na dosovské. Chceked – je-li true, tlačítko je zaškrtnuté. Chceme-li volit pouze jednu z možností, nastavíme u položky radioitem na true. Pokud potřebujeme, aby se text položky měnil podle toho, co se právě v programu děje, je třeba to naprogramovat. Poznámka: k položkám menu lze také přistupovat jako k poli: Menu1.Items[0]


Příklad: Změna položky v menu: Na formulář umístíme komponentu Label a nabídku d položkou Titulek a podpoložkami Tučný, modrý.. Pokud položku vybereme poprvé, nastaví se barva (řez), podruhé se vše vrátí do původního stavu: procedure TForm1.un2Click(Sender: TObject); begin if un2.caption='&Tučný' then begin Label1.Font.Style:=[fsBold]; un2.caption:='&Normální' end else begin Label1.Font.Style:=[]; un2.caption:='&Tučný' end end; Znepřístupnění položky menu Dále do nabídky přidáme položku Skrýt, která titulek zneviditelní. procedure TForm1.Skrt1Click(Sender: TObject); begin label1.visible:=false; itulek1.Enabled:=false; {znepristupneni polozky menu} Zobrazit1.enabled:=true; end; Pak ovšem potřebujeme přidat do menu položku Zobrazit, se submenu Titulek, abychom se na něj zase dostali. procedure TForm1.itulek2Click(Sender: TObject); begin label1.visible:=true; itulek1.Enabled:=true; Zobrazit1.enabled:=false; end; Vyzkoušíme se ještě zaškrtávání položek menu: Na formulář přidáme groupbox se třemi zaškrtávacími políčky A,B,C a budeme je zaškrtávat pomocí menu. procedure TForm1.A1Click(Sender: TObject); begin if not checkbox1.checked then begin checkbox1.state:=cbchecked; A1.checked:=true; end else begin checkbox1.state:=cbUnchecked; A1.checked:=False; end end;´ A analogická obsluha políček: procedure TForm1.CheckBox1Click(Sender: TObject); begin a1.checked:=checkbox1.state=cbchecked end; Pokud se mají položky formuláře chovat jako radiogroup, nastavíme v jejich vlastnosti GroupIndex stejnou nenulovou hodnotu a vlastnost položky radioItem na True. Pokud je při vytváření aplikace třeba zásadně měnit strukturu nabídky (různá práva uživatelů. apos.) je nejjednodušší použít dvě (případně) více menu: Form1.menu:=MainMenu1;

Místní (kontextová) nabídka – PopUpMenu Aktivuje se pravým tlačítkem myši a obvykle nabízí to nejdůležitější, co se dá v daném okamžiku s komponentou pod kurzorem dělat. Paleta Standard – PopUp menu Událost OnPopup se hodí, když chceme změnit místní nabídku za běhu programu:


Je nutné ho přiřadit komponentě, ke které se vztahuje – vybráním Vlastnost AutoPopup nabídek musí být nastavena na True, jinak se Delphi nebudou starat o jejich zobrazování. Příklad: procedure TForm1.blue1Click(Sender: TObject); begin panel1.Color:=clblue; end; procedure TForm1.Hu1Click(Sender: TObject); begin panel1.caption:=(sender as Tmenuitem).caption end; procedure TForm1.PopupMenu1Popup(Sender: TObject); begin if panel1.color=clred then begin red1.checked:=true ; blue1.checked:=false end else begin blue1.checked:=true; red1.checked:=false end; if (panel1.caption='Ha') then begin Ha1.checked:=false; Hu1.checked:=true end else begin Ha1.checked:=true; Hu1.checked:=false end

Cvičení: 1. Vymyslete si vlastní projekt s nabídkami a více formuláři. 2. Připravte si projekt s několika formuláři jako výukový program. Bude začínat informativním textem, obsahovat nějaké otázky a pokračovat zobrazením dalších formulářů podle toho, co zvolí uživatel.

24. Panely nástrojů, stavový řádek, Richedit Memo Je víceřádková varianta editačního okna. Pojme text do 64kB – tedy jako Poznámkový blok. Některé vlastnosti a metody: WantReturns – určuje, zda může být do textu vložen ASCII kód Enter nebo Tab. Wordwrap – True – automatické zalamování konce řádku Alignment – zarovnání textu Align – umístění memo vzhledem k formuláři Lines – typu Tstrings –umožňuje zpracovávat řádky jako pole řetězců (viz nápověda k typu Tstrings) Memo1.lines[0] – první řádek Memo1.lines.Count – počet řádků Memo1.lines.Add(textový řetězec) – vložení textu do mema Memo1.IndexOf(textový řetězec) – funkce, vrací číslo řádku zadaného textu, pokud tam není -1. Memo1.lines.Move(i,j) – přesune řádek z i-té pozice na j-tou Text – celý obsah mema Clear – vyprázdnění Scrollbars – rolovátka LoadFromFile (textový soubor) – načtení souboru do mema


SavetoFile uložení obsahu mema do texzového souboru Práce se schránkou (týká se výběru) – CopyToClipboard, PasteFromClipboard, CutToClipBoard Anchors – ukotvení k formuláři – dle výběru z množiny [akleft, akTop, akRight, akBottom] – nastavuje se, aby se velikost komponenty měnila současně s velikostí formuláře.

RichEdit je umístěna na paletě Win32, protože se objevila s těmito Windows, je podobná, ale umí zvládat text ve formátu RTF, což umožňuje nastavovat atributy vybrané části textu.

Dialogy Záložka Dialogs na paletě komponent, práce se všemi je velmi podobná. Jsou to neviditelné komponenty, obvykle je umísťujeme někam na okraj formuláře (k horní liště), abychom o nich měli přehled. OpenDialog Filter – výběr typu souborů, které se okně mají zobrazovat

InitialDir – výchozí složka Title – nápis na tituní liště Opendialogu Provedení dialogu – metoda Execute if OpenDialog1.Execute then Memo1.Lines.LoadFromFile(OpenDialog1.FileName) else Memo1.Lines.Clear; FileName – plné jméno souboru vybraného v okně OpenDialog. SaveDialog – slouží k ukládání souborů OpenPictureDialog, SavePicturDialog – mají navíc náhled na obrázky FontDialog Vlastnost Font: if fontdialog1.Execute then memo1.font:=fontdialog1.Font Nastavení fontu všech tlačítek na formuláři: FontDialog1.Font := Form1.Font; if FontDialog1.Execute then for i := 0 to (Form1.ControlCount - 1) do if (Form1.Controls[i] is TButton) then (Form1.Controls[i] as TButton).Font := FontDialog1.Font ColorDialog Vlastnost Color if ColorDialog1.Execute then Shape1.Brush.Color := ColorDialog1.Color; PrintDialog – dialogové okno pro nastavení parametrů tisku PrinterSetupDialog – nastavení tiskárny FindDialog – zadání textu, který se má vyhledat ReplaceDialog – zadání textu, který se má nahradit

Panel nástrojů a stavový řádek Toolbar je lišta, na které jsou umístěna tlačítka, usnadňující přístup k nejpoužívanějším funkcím programu. Postup, který by se dal použít již v 16 bitových delphi spočívá v tom, že na komponentu panel umístíme urychlovací tlačítka speedbutton (paleta Additional) a naprogramujeme potřebné akce.


Od 32bitových Delphi si můžeme tvorbu nástrojové lišty podstatně usnadnit použitím komponenty Toolbar (Win32), na které jsou tlačítka typu TToolButton, která se nevyskytují samostatně, přidávají se např. pomocí kontextového nabídky toolbaru – New button Vlastnost Style nabízí různé podoby tlačítek tbsButton – klasické tlačítko tbsCheck – zůstane stisknuté a uvolní se až dalším stiskem tbsDropDown. – vedle šipka, která rozbaluje další nabídku tbsSeparator, tbsDivider – oddělovače Přidání tlačítka do skupiny –vlastnost grouped Většinou tlačítka toolbaru mají stejnou funkci jako položky nabídky – dá se to propojit: Každé tlačítko má vlastnost MenuItem, kam můžeme zadat akci existující nabídky. ShowCaptions – true – na tlačítkách se zobrazí popisky. protože je pro větší přehlednost většinou nepoužíváme, je obvyklé nastavit jejich bublinkovou nápovědu – vlastnost hint. (ShowHint na true) ImageList (také z Win32) se užívá k vkládání obrázků do aplikace.

Tlačítkem add se otevře okno pro otevření souborů, vyberme a vložíme obrázky. Číslo u obrázku je jeho ImageIndex (pro další použití) Dá se propojit např.s menu nebo toolbarem (ideální je obojí) – tak, že z properties Images vybereme příslušný Imagelist. Přiřazení obrázků položkám by mělo být podle pořadí, pokud zlobí, je vhodné nastavit přímo ImageIndexy. U toolbaru jsou navíc možnosti DisabledImages a HotImages pro změnu obrázků za určitého stavu tlačítka. (zakázané – tlačítko, jehož vlastnost enabled je nastavena na false, HotImage – pod kurzorem myši) Ikonky (popř. i jiné obrázky) si můžete přímo namalovat – Tool/Image Editor – a ve File New si pak můžete vybrat, co chcete malovat. Po uložení s příponou .ico je ikonka k dispozici.

Statusbar Také Win32 Panel u dolního okraje okna, zobrazuje některé informace. Kontextové menu statusbaru nebo vlastnost Panels: spustí se editor panelů Do vlastnosti text můžeme zapsat text. Bývá zvykem zde umísťovat např. nápovědu, panely prezentují vlastně pole řetězců. Takže když například používáme bublinkovou nápovědu (hint), stačí přidat proceduru. pro zobrazení textu nápovědy ve stavovém řádku. (přidá se ručně metod formuláře) procedure FormCreate(Sender: TObject); procedure ukaz(sender: TObject) private …. procedure TForm1.ukaz(sender: TObject); begin statusbar1.Panels[1].text:=application.hint; end; procedure TForm1.FormCreate(Sender: TObject); begin application.OnHint:=ukaz; end;


do

Příklad: Pokusíme se vytvořit textový editor s některými dalšími funkcemi, vybavit ho menu, Toolbarem a stavovým řádkem. Výměna řádků, jejichž čísla zadá uživatel na formuláři Form2: (v klauzuli usesForm2 je třeba doplnit Unit2, a,b jsou definovány v interface Unit2) procedure TForm1.Vymnit1Click(Sender: TObject); var s:string; begin form2.showmodal; if (a
Cvičení Dokončete textový editor přidáním obvyklých funkcí (práce se soubory apod.) dalších dialog,ů, případně vlastních vylepšení.


25. Datum a čas, časovač, dynamické knihovny Datum a čas Typ TDateTime – pro ukládání se používá double („hodně“ přesné reálné číslo) – udává počet dní od 30. 12. 1899 Konverzní funkce: • DateToStr • StrToDate • TimeToStr • StrToTime Now – konstanta Timer Paleta komponent System Neviditelná komponenta, pravidelně generuje událost Events – OnTimer Properties – Interval v ms časový interval, po kterém bude událost definovaná v proceduře OnTimer generována. Enable – False – timer mimo provoz, spouští se nastavením této hodnoty na True. Pozor: není to příliš přesné.

Příklady:

Tlačítko datum a čas zobrazí aktuální datum, aktuální čas se bude zobrazovat po vteřinách. Stisknutím tlačítka padám začne klesat dolů, tempo pádu nastavíme spineditem. Tlačítko rozdíl dat odečte ve dnech časové údaje z editačních políček, Stisknete-li za sebou tlačítka klik a klak, vypíše se časový interval mezi oběma akcemi. var cas1:Tdatetime; c:integer; Timer1 každou sekundu (interval je 1000) vypisuje nový aktuální čas. procedure TForm1.Timer1Timer(Sender: TObject); begin label2.Caption:=timetostr(now); end; Aktualizace timeru1 a zobrazení data. procedure TForm1.Button1Click(Sender: TObject); begin timer1.enabled:=true; label1.caption:=datetostr(now); end; nastavení nečinnosti obou časovačů (Timer2 poslouží k animaci pádu tlačítka, proměnná c udává velikost jeho svislého posuvu)


procedure TForm1.FormCreate(Sender: TObject); begin timer1.enabled:=false; timer2.enabled:=false; c:=5; end; Zapamatování aktuálního času při klepnutí na tlačítko klik. procedure TForm1.Button3Click(Sender: TObject); begin cas1:=now; end; Výpočet rozdílu časů klik a klak v milisekundách. procedure TForm1.Button4Click(Sender: TObject); var x:double; begin x:=(now-cas1)*24*3600*1000; showmessage(floattostrf(x,fffixed,10,3)+' ms'); end; Začátek pohybu panelu – aktivace časovače timer2. procedure TForm1.Panel1Click(Sender: TObject); begin timer2.Enabled:=true; end; Pád tlačítka a jeho odrážení mezi horní a dolní hranou formuláře procedure TForm1.Timer2Timer(Sender: TObject); begin panel1.Top:=panel1.Top +c; if panel1.Top>=clientheight -panel1.height then begin c:=-5; panel1.Caption:='stoupám' end; if panel1.Top<=0then begin c:=5; panel1.Caption:='padám'; end; end; Nastavení rychlosti pádu – interval timeru2. procedure TForm1.SpinEdit1Change(Sender: TObject); begin timer2.interval:=spinedit1.value end; Rozdíl časů procedure TForm1.Button2Click(Sender: TObject); var x,y:tdatetime; begin x:=strtodate(edit1.text); y:=strtodate(edit2.text); showmessage(floattostr(y-x)); end;

Dynamicky linkované knihovny obsahují zdrojové kódy procedur a funkcí, které může současně využívat několik běžících aplikací. (Např. sdílené zdroje Windows) Jsou to samostatné aplikace podobné .EXE souboru, pokud změníme DLL, stačí nahradit starou knihovnu novou verzí. (Unity jsou nedílnou součástí programu a v poslední fázi překladu jsou k němu neoddělitelně připojeny.


Při změně jednotky je nutné překompilovat celý program) Jednotlivé metody se načítají do paměti když jsou aktuální, takže užívání DLL šetří paměť. Jsou zcela univerzální, nezávisí na jazyku, ve kterém jsou naprogramovány. Vytváření: File-New-Other-DLL Wizard Do editoru kódu zapíšeme text, před begin a end je nutné umístit část Exports s názvy funkcí a procedur. Knihovnu překompilujeme a uložíme. Obsah DLL lze prohlížet v programu Zběžné zobrazení. library kombinatorika; uses SysUtils, Dialogs, {aby fungoval vychozi vzkaz} Classes; {$R *.res} function fakt(n:cardinal):cardinal; var i,f:cardinal; begin f:=1; for i:=1 to n do f:=f*i; result:=f; end; function vari (n,k:integer):integer; var i,v:cardinal; begin v:=1; for i:=1 to k do v:=v*(n-i+1); result:=v; end; exports fakt,vari; begin showmessage('pouzivame dll kombinatorika'); end. Použití Před použitím je třeba metody nadeklarovat, v sekci external uvedeme název knihovny dll, případně name přesné_původní jméno metody pokud je pro naše účely chceme změnit. (Citlivé na velká, malá písmena) function fa(n:cardinal):cardinal; external 'kombinatorika' name 'fakt'; function vari(n,k:integer):integer; external 'kombinatorika';

Cvičení: 1. Průhlednost objektů udává vlastnost alphablend. Informujte se o ní v nápovědě a naprogramujte formulář, který je při spuštění programu průhledný a postupně nabývá syté barvy. 2. Vložte na formulář editační políčka, ve kterých zadáme začátek a konec nějaké akce – datum a čas v celém počtu hodin od 0 do 24. Při stisknutí tlačítka se vypočítá trvání akce v hodinách. 3. Připravte si knihovnu dll, ve které nadefinujte funkci pro výpočet fyzikálních vzorců a vyzkoušejte je v programu. Řešení: 1. procedure TForm1.Timer1Timer(Sender: TObject); begin


alphablendvalue:=alphablendvalue+5; if alphablendvalue=255 then timer1.enabled:=false; end; procedure TForm1.FormCreate(Sender: TObject); begin timer1.Enabled:=true; end; 2. procedure TForm1.Button1Click(Sender: TObject); var d1,d2:Tdatetime;h1,h2:real; begin d1:=StrToDate(edit1.Text); d2:=StrToDate(edit3.Text); h1:=d1*24+StrToFloat(edit2.Text); h2:=d2*24+StrToFloat(edit4.Text); showmessage(FloatToStr(h2-h1)) end; 3. pro inspiraci – dráha a rychlost volného pádu Project2: function draha (t:real):real; begin draha:=5*t*t; end; function rychlost (t:real):real; begin draha:=10*t; end; exports draha,rychlost; begin end. Unit11: function draha(t:real):real; external 'Project2'; function rychlost(t:real):real; external 'Project2'; procedure TForm1.Button1Click(Sender: TObject); var t:real; begin t:=StrToFloat(edit1.text); showmessage('Teleso urazilo '+ Floattostr(draha(t))+' a dopadlo rychlosti ' + Floattostr(rychlost(t))) end;

26. Tisk, řetězce v Delphi Tisk Často potřebujete aplikaci, která zvládá výstup na tiskárnu a nemusí to být nutně jen editor textu nebo obrázků. Tisk fomuláře Vytištění celého formuláře – metoda Print O velikosti obrázku rozhoduje vlastnost PrintScale: PoNone – beze změny měřítka (vysoké rozlišení) PoProporcional – velikost obrázku na stránce odpovídá velikosti formuláře na obrazovce PoPrintToFit – roztáhne se na celou šířku stránky (snížená kvalita) Dialogová okna po tisk PrinterSetupDialog


PrinterDialog Obě mají metodu Execute, která zobrazí příslušné dialogové okno a vrací True, pokud bylo okno uzavřeno tlačítkem OK. Objekt Printer Je to globální proměnná jednotky Printers (nutno uvést do uses jednotky) Její typ je Tprinter, který umí manipulovat s tiskárnou. Na plátno tiskárny (Canvas) lze krelit i psát, tiskovou úlohu je třeba zahájit metodou BeginDoc. Libovolnou metodu třídy Tcanvas lze použít pro vytvoření výstupu, na tiskánu se nakonec odešle metodou EndDoc. Pokud během tisku dojde k chybě, lze jej zrušit metodou Abort. If printdialog1.execute then Begin printer.beginDoc; {kresleni} Printer.EndDoc; end; Tisk textu Bylo by možné použít metodu OutText Canvasu, ale výhodnější je asociovat tiskárnu jako textový soubor a pak s ní pracovat. Var f:TextFile; …AssignPrn(f), rewrite(f); fo i:=0 to memo1.lines.count-1 do writeln(f,memo1.lines[i]) closefile(f);

Příklady: 1. Tisk formuláře procedure TForm1.Label1Click(Sender: TObject); begin {if printdialog1.Execute then }print; {s nastavenim moznosti tisku} end; procedure TForm1.RadioGroup1Click(Sender: TObject); begin case radiogroup1.ItemIndex of 0: PrintScale:=poNone; 1: PrintScale:=poProportional; 2: PrintScale:=poPrintToFit end; end; procedure TForm1.Button1Click(Sender: TObject); begin PrinterSetupDialog1.execute end; 2. Tisk obrázku z Canvasu z canvasu procedure kruh(c:Tcanvas;x,y:integer); begin c.ellipse(10,10,x-10,y-10); end; procedure TForm1.Button1Click(Sender: TObject); begin if printdialog1.execute then begin Printer.BeginDoc; kruh(Printer.Canvas,Printer.PageWidth,Printer.PageHeight);


Printer.EndDoc; end; end; Tisk textu z mema procedure TForm1.Button2Click(Sender: TObject); var f:textfile; i:integer; begin if printdialog1.execute then begin AssignPrn(f); Rewrite(f); for i:=0 to memo1.lines.count-1 do writeln(f,memo1.lines[i]); closefile(f); end; end;

Řetězce v Delphi String var s: string; s:=’@@@’; s:=’’ length(s) – délka řetězce s[i] – i-tý znak Spojování a porovnávání ‘Ah’ +’oj’=’Ahoj” Delphi používají další tři typy (dále), pokud program vychází z typu String, rozhodnou se podle direktivy překladače $H. Je-li zapnutá ($H+ standardní nastavení), použije se AnsiString, jinak ShortString. WideString se musí deklarovat ručně. ShortString převzat z Pascalu, statické pole 256 bytů (znaků) AnsiString se objevuje s nástupem 32bitových Delphi. Jsou dynamicky alokované a mohou být libovolně dlouhé. Proměnná typu AnsiString je ukazatel, pokud je řetězec prázdný, má hodnotu NIL. var s: string; SetLength(s,20); Dvě proměnné mohou ukazovat na týž řetězec, na rozdíl od dynamických polí, pokud do jednoho přiřadíme jinou hodnotu, řetězec se zkopíruje a obě proměnné se oddělí. WideString Je podobný AnsiString, ale znaky jsou uloženy v kódování Unicode, takže zabírají 16 bitů. Windows, které jsou naprogramovány v C++ používají jiný typ řetězců – tzv. řetězce ukončené nulou. Proto v Delphi existuje navíc typ Pchar, který odpovídá ukazateli na nulou ukončený řetězec. Je kompatibilní s typem AnsiString, takže jej lze bez potíží přetypovat. var s:string; p:Pchar; …s:=’bbbbbbbbbbbbbbbbbbbb’; p:=Pchar(s);

Cvičení 1. Éxportujte soubor Lovciprac.xls z Excelu jako csv (textový soubor oddělený středníky). Načtěte ho do listboxu, zobrazte samostatně lovce, oblasti a kořist, vyplňte různé lovce a naprogramujte různé oblasti do radiogroupů. Naprogramujte agregační funkce podle požadavků (příklad – celková kořist lovce v určité oblasti)


2. Převeďt vstupující rodné číslo na datum. 3. Vyzkoušejte si tisk vlastního obrázku. Řešení type pole= array of string; var a:pole; lovec:pole; oblast:pole; korist:pole; procedure TForm1.Button1Click(Sender: TObject); var i:integer;{pocet zaznamu} k:integer; {pro pozici stredniku} begin listbox1.Items.LoadFromFile('lovciprac.csv'); setlength(a,listbox1.items.count); setlength(lovec,listbox1.items.count); setlength(oblast,listbox1.items.count); setlength(korist,listbox1.items.count); for i:=0 to high(a) do begin a[i]:=listbox1.items[i]; k:=pos(';',a[i]); lovec[i]:=copy(a[i],1,k-1); Delete(a[i],1,k); k:=pos(';',a[i]); oblast[i]:=copy(a[i],1,k-1); Delete(a[i],1,k); k:=pos(';',a[i]); korist[i]:=copy(a[i],1,k-1); end; end; procedure TForm1.Button2Click(Sender: TObject); var i:integer; begin for i:=0 to high(lovec) do begin listbox2.items.add(lovec[i]); listbox3.items.add(korist[i]); listbox4.items.add(oblast[i]); end; end; procedure TForm1.Button3Click(Sender: TObject); begin Radiogroup1.Items.Add(listbox2.Items[listbox2.itemindex]) end; procedure TForm1.Button4Click(Sender: TObject); var obl:pole;i,j:integer;b:boolean; s:string;


begin obl:=copy(oblast,1,high(oblast)-1); {pole obl setridime, aby stejne hodnoty byly vedle sebe} repeat b:=false; for i:=0 to high(obl)-1 do if obl[i]>obl[i+1] then begin s:=obl[i]; obl[i]:=obl[i+1]; obl[i+1]:=s; b:=true; end until not b; {setrideno} i:=0; repeat while (obl[i]=s) and (i=high(obl); end; procedure TForm1.Button5Click(Sender: TObject); var lov,ob:string;i,celkem:integer; begin lov:=radiogroup1.items[radiogroup1.itemindex]; ob:=radiogroup2.items[radiogroup2.itemindex]; celkem:=0; for i:=1 {0 je 'lovec'} to high(lovec) do if (lovec[i]=lov) and (oblast[i]=ob) then celkem:=celkem+StrToint(korist[i]); showmessage(IntToStr(celkem)); end; 2. function prevod(s:string):TDatetime; var rok,x,mesic,den:string;y:integer; begin rok:='19'+copy(s,1,2); x:=copy(s,3,2); if x>'50' then begin y:=strtoint(x); y:=y-50; x:=IntTostr(y); end; mesic:=x; den:=copy(s,5,2); x:=den+'.'+mesic+'.'+rok; prevod:=StrTODate(x); end;

27. Opakování Naprogramujte si nějakou hru – Člověče nezlob se, Hledač min, Pexeso apod. kde byste mohli využít pole komponent (tlačítek) Pro inspiraci zdrojový kód jednoduchého minsweeperu.


unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, buttons, comctrls, ToolWin, Menus, ExtCtrls, Gauges; const barvy: array[0..9] of TColor = (clBlack, clBlue, clGreen, clRed, clMaroon, clYellow, clNavy, clPurple, clTeal, clBlack); type TForm1 = class(TForm) Button1: TButton; MinLbl: TLabel; TestovaciTlacitko: TSpeedButton; XEdit: TLabeledEdit; YEdit: TLabeledEdit; Timer1: TTimer; TimeLbl: TLabel; Gauge1: TGauge; GenerujiLbl: TLabel; procedure Button1Click(Sender: TObject); procedure GameButtonClick(Sender: TObject); procedure VoidGameButtonClick(Sender: TObject); procedure GameButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private declarations } fieldcount: integer; public { Public declarations } end; const pocetX: integer = 15; pocety: integer = 10; //pocetmin = trunc(pocetx*pocety/8); var


Form1: TForm1; hraciplocha : array of array of tspeedbutton; miny : array of array of boolean; pocetmin, zbyvamin: integer; first: boolean; StartTime: TDateTime; implementation {$R *.dfm} procedure TForm1.GameButtonClick(Sender: TObject); var sx,sy,i,j,okoli: integer; procedure disableall; var i,j: integer; begin for i := 1 to pocetx do for j := 1 to pocety do if hraciplocha[i,j].enabled then begin hraciplocha[i,j].onclick := VoidGameButtonClick; if miny[i,j] then hraciplocha[i,j].caption := 'M'; end; end; begin if not Timer1.Enabled then begin // začátek hry: StartTime := Now; Timer1.Enabled := true; end; with sender as tspeedbutton do begin sx := tag div 100; sy := tag mod 100; if caption <> '' then exit; if miny[sx,sy] then begin disableall; Timer1.Enabled := false; showmessage('BUM!!!!!'); // caption := 'M'; end else begin okoli := 0; for i := sx-1 to sx+1 do for j := sy-1 to sy+1 do if miny[i,j] then inc(okoli); if okoli = 0 then begin caption := '.'; // kliknout na všechny okolní for i := sx-1 to sx+1 do for j := sy-1 to sy+1 do if (i > 0) and (i<=pocetx) and (j>0) and (j<=pocety) then if length(hraciplocha[i,j].caption) = 0 then hraciplocha[i,j].click end else caption := IntToStr(okoli); font.color := barvy[okoli]; dec(fieldcount); flat := true; if fieldcount <= pocetmin then begin disableall; Timer1.Enabled := false;


showmessage('Výborně, vyhrál jste! Čas: '+timetostr(Now-starttime)); end; end; end; end; procedure TForm1.GameButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbRight then begin with sender as tspeedbutton do begin // enabled := false; if caption = 'M' then begin caption := ''; inc(zbyvamin); end else if length(caption) = 0 then begin caption := 'M'; dec(zbyvamin); end; end; minlbl.Caption := 'Zbývá: ' + inttostr(zbyvamin) + ' min'; end; end; procedure TForm1.VoidGameButtonClick(Sender: TObject); begin showmessage('Hra byla dohrána, můžete začít novou hru'); end; procedure TForm1.Button1Click(Sender: TObject); var i,j,rx,ry: integer; begin // zobrazení gauge :) Gauge1.Visible := true; GenerujiLbl.Visible := true; gauge1.Progress := 0; timer1.Enabled := false; TimeLbl.Caption := ''; if not first then begin // smaže původní tlačítka: for i := 1 to pocetx do for j := 1 to pocety do hraciplocha[i,j].free; setlength(hraciplocha, 0); setlength(miny, 0); end; gauge1.AddProgress(10); application.ProcessMessages; first := false; randomize; try pocetx := strtoint(XEdit.Text); pocety := strtoint(YEdit.Text); if pocetx > 99 then pocetx := 99; if pocetx < 3 then pocetx := 3; if pocety > 99 then pocety := 99;


if pocety < 3 then pocety := 3; except on EConvertError do begin pocetx := 10; pocety := 15; end; end; setlength(hraciplocha, pocetx+1, pocety+1); setlength(miny, pocetx+2, pocety+2); pocetmin := trunc(pocetx*pocety/(random(5)+5)); zbyvamin := pocetmin; gauge1.AddProgress(5); application.ProcessMessages; width := pocety*16+70; height := pocetx*16+100; for i := 1 to pocetx do begin for j := 1 to pocety do begin hraciplocha[i,j] := TSpeedButton.Create(Self); with hraciplocha[i,j] do begin height := 16; width := 16; parent := form1; top := 40+i*16; left := 20+j*16; visible := true; onclick := GameButtonClick; onmouseup := gamebuttonmouseup; Font.Style := Font.Style + [fsBold]; font.color := barvy[9]; tag := 100*i + j; end; end; gauge1.Progress := (trunc(i*80/pocetx)+15); application.ProcessMessages; end; for i := 0 to pocetx+1 do for j := 0 to pocety+1 do miny[i,j] := false; randomize; for i := 1 to pocetmin do begin // generuj náhodnou dvojici: repeat rx := random(pocetx) + 1; ry := random(pocety) + 1; until not miny[rx,ry]; miny[rx,ry] := true; end; MinLbl.Caption := 'Počet min: ' + inttostr(pocetmin); fieldcount := pocetx*pocety; gauge1.AddProgress(5); application.ProcessMessages; gauge1.Visible := false; GenerujiLbl.Visible := false; end; procedure TForm1.FormCreate(Sender: TObject);


begin XEdit.Text := inttostr(pocetx); YEdit.Text := inttostr(pocety); first := true; end; procedure TForm1.Timer1Timer(Sender: TObject); begin TimeLbl.Caption := 'Čas: ' + timetostr(starttime-now); end; end.

Literatura: Marco Cantú: Mistrovství v Delphi 2.0 Tomáš Holan: Delphi v příkladech Slavoj Písek: Delphi (začínáme programovat) Januš DRózd, Rudolf Kryl: Začínáme s programováním Dana Tőpferová, Pavel Tőpfer: Sbírka úloh z programování Pavel Tőpfer : Algoritmy a programovací techniky Pavel Tőpfer: Základy programování v úlohách Pavel Přívětivý, Jiří Kolbaba: Borland Pascal skripta, Renáta Přívětivá, Michal Kozubek:Objektově orientované programování v Turbo Pascalu Tomáš Hála: Pascal pro střední školy

Computer Press,1996 MatfyzPress 1999 Grada Publishing 2002 Educa ’99, 1992 Educa ’99, 1992 Scientia, 1997 Prométheus, 1995 SPŠE Pardubice 1995 MU Brno,1993 Computer Press 1999

Obsah 1. Datový typ záznam ....................................................................................................................................... 1 2. Malování na canvas ...................................................................................................................................... 4 3. Malování se záznamy.................................................................................................................................... 7 4. Základní principy OOP – úvod...................................................................................................................... 9 5. Základní principy OOP – zapouzdření, dědičnost......................................................................................... 13 6. Základní principy OOP – potřetí.................................................................................................................. 19 7. Základní principy OOP – polymorfismus .................................................................................................... 23 8. Objektový model Delphi ............................................................................................................................. 29 9. Programování řízené událostmi ................................................................................................................... 35 10. Výjimky ................................................................................................................................................... 40 11. Opakovací cvičení..................................................................................................................................... 45 12. Soubor typový .......................................................................................................................................... 47 13. Soubor typový záznamů, bezpečnost ......................................................................................................... 52 14. Textový soubor ......................................................................................................................................... 57 15. Opakování ................................................................................................................................................ 61 Prostředky VCL pro práci se soubory.............................................................................................................. 61 16. Dynamické datové typy, lineární spojový seznam ...................................................................................... 66 17. Práce se spojovým seznamem.................................................................................................................... 69 18. Rekurze .................................................................................................................................................... 75 19. Vyhledávání.............................................................................................................................................. 77 20. Třídění...................................................................................................................................................... 82 21. Výčtový typ, grafické tlačítko s bitmapou................................................................................................. 87 22. Standardní dialogová okna, datový typ množina ........................................................................................ 90 23. Menu, další formuláře ............................................................................................................................... 93 24. Panely nástrojů, stavový řádek, Richedit.................................................................................................... 97 25. Datum a čas, časovač, dynamické knihovny............................................................................................ 101 26. Tisk, řetězce v Delphi ............................................................................................................................. 104 27. Opakování .............................................................................................................................................. 108 Obsah........................................................................................................................................................... 113



PDF created with pdffactory trial version kurak:boolean; end;

Recommend Documents