Tvorba her v DelphiX - 2. díl - Builder.cz - Informacni server o programovani

9. října 2000, 00.00 | Tvorba her pod Delphi. Tentokrát detailní rozbor kreslení a práce s grafikou pod DelphiX.

V dnešním díle si ukážeme, jak pracovat v DelphiX s  canvasem, který je podobný canvasu ve windows, ale nabízí i nějaké ty specialitky. Nakonec vytvoříme ukázkový program, který sice nebude mít s hrou nic společného, ale zato bude plně využívat DirectX. Tak se do toho dáme.

V delphiX kreslíme na povrch, který nazýváme surface. Kde se tedy vzal onen canvas? Jedná se o jednu z vlastností surface, a přistupujeme k němu pomocí DXDraw.surface.canvas a je velice podobný jako canvas ve windows (vzpomeňme na Form.canvas, nebo Image.picture.Bitmap.canvas). Pomocí něj můžeme kreslit jednoduché obrazce jako např. čtverce, obdélníky, kruhy, elipsy, polygony, kruhové výřezy, čáry, bezierovy křivky nebo třeba vyplňovat pixely. A právě s pixely začneme. Ještě jedna užitečná rada - pokud kreslíme na canvas, musíme ho nakonec uvolnit procedurou Release, jinak se nám program zhroutí !!!

Pixel po pixelu...

Jak každý asi ví, pixel je nejmenší částečka na monitoru, kterou můžeme vidět. Kolik je na obrazovce pixelů poznáme podle rozlišení obrazovky, takže např. při rozlišení 800x600 máme 800 pixelů na šířku a 600 na výšku. Celkově je to tedy 480 000 což je velice velké číslo, a proto je např. vyplňování obrazovky pixel po pixelu nevhodné, jelikož je to velice pomalé. Přístup po pixelu se hodí pouze pro vyplňování několika málo bodů, kdy určitému pixelu přiřadíme určitou barvu (např. Canvas.Pixels[10,20]:=clBlack vyplní bod x=10 a y=20 černou barvou). Ještě více se však hodí použití, pokud chceme získat barvu daného bodu, kdy postupujeme přesně obráceně - např. Form1.color:=DXDraw1.surface.canvas.pixels[20,20].

Čáry a linky...

Jako další máme čáry. Stejně jako všude kreslíme čáru procedurou LineTo(x,y), která kreslí čáru do bodu x,y. Odkud se bode čára kreslit určuje PenPos, a pokud tuto hodnotu chcete změnit, tak procedurou MoveTo(x,y). Kromě toho můžeme ještě měnit tloušťku čáry vlastností Canvas.Pen.Width, barvu vlastností Canvas.Pen.Color a styl vlastností Canvas.Pen.Style.

Čtverce a obdélníky...

Dále jsou tady čtverce a obdélníky. Kreslí se procedurou Rectangle(x1,y1,x2,y2), nebo pokud máme definovanou proměnnou typu TRect, můžeme vyžít Rectangle(Rect). Barvu, styl a šířku čáry můžeme měnit stejně jako u čar pomocí Canvas.Pen.Color,Style,Width... Výplň obdélníku se nastavuje ve vlastnosti Canvas.Brush a můžeme nastavit barvu (Color), styl (Style) a bitmapu (Bitmap), která má rozměry 8x8 pixelů.

Kruhy a elipsy...

Jelikož elipsy jsou hodně podobné obdélníkům (akorát že jsou kulaté), zmíním se o nich jen stručně. Kreslí se pomocí Ellipse(x1,y1,x2,y2), nebo Ellipse(Rect). Výplň a okraj elipsy se nastavuje stejně jako u obdélníků.

Kulaté obdélníky...

Teď si asi myslíte, že jsem se zbláznil, jelikož je něco jako kulatý čtverec ve světě normálním i počítačovém nemožné. Abych tedy uvedl věc na pravou míru -  mám na mysli obdélníky se zaoblenými rohy. V angličtině však toto nazývají RoundRect, což si někdo může přeložit jako... Ale k věci. Obdélníky se zaoblenými rohy kreslíme pomocí RoundRect(x1,y1,x2,y2,x3,y3). Proměnné x1,y1 a x2,y2 stejně jako u rectanglu určují hranice obdélníku a x3 a y3 určují, jak hodně bude obdélník zaoblený po ose x a y. Výsledek může vypadat např. takto (všimněte si, že po ose x je zaoblený méně než po ose y):

Text...

Jako další zde máme kreslení textu. To provedeme pomocí TextOut(x,y,text), kdy se na souřadnice x a y napíše text text. Vlastnosti fontu textu můžeme měnit v Canvas.Font, a to jméno fontu (Name), velikost (Size), styl (Style) a barvu (Color). S textem souvisí také dvě funkce TextHeight(Text) a TextWidth(Text), které vrací výšku (šířku) textu Text v pixelech.

Polygon a Polyline...

Jako poslední je zde polyline a polygon. Nejprve tedy Polyline. Jedná se o zjednodušení práce s čarami, abychom nemuseli při kreslení více čar pořád psát MoveTo a LineTo, nadefinujeme si proměnnou Points jako pole TPointů a poté nakreslíme Polyline pomocí Polyline(points). Pokud zadáme poslední bod stejný jako první, vznikne nám neuzavřený útvar. Naproti tomu polygon vytvoří vždy uzavřený útvar, i když poslední bod je jiný než první a vyplní jej nastavenou výplní (okraj a výplň opět měníme stejně jako u rectanglů). Pro kreslení polygonu použijeme Polygon(points).

Praktická část:

A konečně je zde již na začátku zmiňovaný program, ve kterém si odzkoušíme pár z výše uvedených věcí. Jedná se o to, že na povrch nakreslíme pár tlačítek, přes které pokud přejedeme myší dostanou focus a pokud myš stiskeme, tlačítko se stiskne. Nad toto nakreslíme také kurzor, ne však kopírováním obrázku kurzoru, ale kreslením polygonu. Zde je náhled na program:

Vytvořte tedy nový projekt, Form1 přejmenujte na MainForm a na formulář přidejte komponentu DXDraw. Pokračujeme tím, že si definujeme proměnné. Do sekce public tedy přidáme následující kód:

ClShadow,ClLight,ClNormal:TColor;
ButtonStyle:array [0..5] of integer;
MouseDown:boolean;
Texty:array [0..5] of String;
Recty:array [0..5] of TRect;

Zde je vysvětlení jednotlivých položek: Proměnné ClShadow,ClLight a ClNormal jsou barvy, kterými budeme kreslit tlačítka. Označují normální barvu, barvu stínu a barvu světla. Dále je zde ButtonStyle, který určuje stav jednotlivých tlačítek. Pokud je 0, je tlačítko normální, při 1 má tlačítko focus a pokud je buttonStyle 2, je tlačítko stisknuté. Dále je zde proměnná MouseDown, která určuje, je-li stisknutá myš, pole Textů, ve kterém jsou uložený nápisy tlačítek a Recty, ve kterém jsou uloženy pozice jednotlivých tlačítek.

Dále následuje kreslení kurzoru. Jak jsem již zmínil na začátku, budeme jej kreslit jako polygon, jelikož kurzor šipka je vlastně několik čar. Zde je obrázek, jak vypadá (oranžově jsou označeny body polygonu):

Pro kreslení kurzoru si vytvoříme speciální proceduru, ve které si definujeme pole bodů pro polygon a pozici kurzoru typu TPoint. Funkcí GetCursorPos získáme pozice kurzoru, které pak převedeme pomocí ScreenToClient na pozici ve formuláři. Nadefinujeme si jednotlivé body polygonu a pak jej už jen nakreslíme. Zde je výpis procedury:

Procedure DrawCursor; // kreslení kurzoru
var CursorPos:Tpoint;
Points: array [0..8] of TPoint;
begin
GetCursorPos(CursorPos);
CursorPos:=MainForm.ScreenToClient(CursorPos);
Points[0]:=Point(CursorPos.x,CursorPos.y);
Points[1]:=Point(CursorPos.x+10,CursorPos.y+10);
Points[2]:=Point(CursorPos.x+6,CursorPos.y+10);
Points[3]:=Point(CursorPos.x+9,CursorPos.y+17);
Points[4]:=Point(CursorPos.x+8,CursorPos.y+18);
Points[5]:=Point(CursorPos.x+7,CursorPos.y+18);
Points[6]:=Point(CursorPos.x+6,CursorPos.y+17);
Points[7]:=Point(CursorPos.x+3,CursorPos.y+11);
Points[8]:=Point(CursorPos.x,CursorPos.y+14);
with MainForm.DXDraw1.Surface.Canvas do
begin
Pen.Color:=clBlack;
Brush.Color:=clWhite;
Brush.Style:=bsSolid;
Polygon(Points);
end;

MainForm.DXDraw1.Surface.Canvas.release;
end;

Nyní zkuste přidat do procedury MainForm.OnCreate proc. ShowCursor(false); která zakáže zobrazování windowsovského kurzoru a na form přidejte komponentu DXTimer, ke které vytvořte proceduru OnTimer do které přidejte následující:

procedure TMainForm.DXTimer1Timer(Sender: TObject; LagCount: Integer);
var i:integer;
begin
// pokud nemůžeme na surface kreslit, tak pryč...
if not DXDraw1.candraw then exit;

// vymazání povrchu
DXDraw1.Surface.Fill(0);

// kreslení kurzoru
DrawCursor;

// a flip...
DXdraw1.Flip;
end;

Projekt zkompilujte a spusťte pomocí F9 a pohněte myší - kurzor by se měl zobrazit. 

To ale není ještě konec, jelikož my potřebujeme zobrazit tlačítka. K tomu, abychom je mohli kreslit, musíme vědět, jak vůbec vypadají. Zde je náhled:

Vlevo nahoře jsou nakresleny jednotlivé barvy - světlá, normální a tmavá, dále vidíme tlačítko s focusem, normální tlačítko a stisknuté tlačítko. Celé toto budeme kreslit pomocí čtverců a čar. Vytvoříme si zase zvláštní proceduru, která již bude mít několik parametrů. Bude to x,y,width,height,style a text. V této proceduře budeme kreslit tlačítko podle stylu Style (0-normální,1-s focusem,2-stisknuté) široké Width a vysoké Height na pozici x,y. Navíc ještě budeme kreslit doprostřed text. Výpis celé procedury snad není ani třeba uvádět, jelikož je dost dlouhá, a v podstatě se v ní neustále opakuje MoveTo a LineTo.

Nakonec stačí v proceduře OnCreate definovat bervy:

ClShadow:=RGB(97,97,97);
ClLiGht:=RGB(218,218,218);
ClNormal:=RGB(171,171,171);

A nastavení oblastí buttonů a textů buttonů:

// nastavení oblastí
for i:= 0 to 5 do
begin
Recty[i].Left:=10;
Recty[i].Top:=30+ i * 35;
Recty[i].Right:=Recty[i].Left+70;
Recty[i].Bottom:=Recty[i].Top+30;
end;

// nastavení textů
Texty[0]:='Tlačítko 0';
Texty[1]:='Tlačítko 1';
Texty[2]:='Tlačítko 2';
Texty[3]:='Tlačítko 3';
Texty[4]:='Tlačítko 4';
Texty[5]:='Tlačítko 5';

A do procedury DXTimer.OnTimer přidat kód, který zajistí zobrazení správné barvy pozadí a nakreslení tlačítek:

// nakreslení barvy pozadí
DXDraw1.Surface.Canvas.Brush.Color:=ClNormal;
DXDraw1.Surface.Canvas.FillRect(rect(0,0,
DXDraw1.surfacewidth,DXDraw1.surfaceHeight));
DXDraw1.Surface.Canvas.Release;

// kreslení tlačítka
for i:= 0 to 5 do
begin
DrawButton(Recty[i].left,Recty[i].top,
Recty[i].right-Recty[i].left,
Recty[i].bottom-Recty[i].top,ButtonStyle[i],Texty[i]);
end;

A ještě přidat procedury, které zajistí, aby při pohybu myši nad tlačítko dostalo tlačítko focus a při stisku myši nad tlačítkem se tlačítko také stisklo:

procedure TMainForm.DXDraw1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var i:integer;
begin
for i:=0 to 5 do
begin
if PtInRect(Recty[i],Point(x,y)) then
begin
ButtonStyle[i]:=1; // myč je nad tlačítkem -> tlačítko dostane focus
if MouseDown then
begin
ButtonStyle[i]:=2; // myš je stisklá nad tlačítkem -> stisknout tlačítko
end;
end
else
ButtonStyle[i]:=0; // myš není nad tlačítkem -> zobrazit normální tlačítko
end;
end;

procedure TMainForm.DXDraw1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseDown:=true;
MainForm.DXDraw1MouseMove(nil,shift,x,y);  // volat proceduru OnMouseMove
end;

procedure TMainForm.DXDraw1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseDown:=false;   // myš již není stisknutá
end;

Nakonec projekt přeložte a spusťte a zkuste hýbnout myší nad jedno z tlačítek - mělo by dostat focus. Pokud tomu tak doopravdy je, gratuluji vám.

Zde si můžete program stáhnout (200Kb)