dotNETportal.cz

Smyčka

V minulém dílu jsme si nastínili základy rozhraní DirectDraw, vysvětlili si, co je to Device a co jsou to FrontBuffer a BackBuffer. Pro vykreslování jsme používali časovač, což bylo pro první seznámení nejjednodušší, v praxi se to ale tak nedělá.

Pro co nejlepší využití výkonu počítače se musíme snažit vykreslit tolik snímků, kolik jen zvládneme. K tomuto účelu se používá smyčka. Je to většinou cyklus While, který běží po celou dobu běhu programu. Jakmile smyčka skončí, skončí i program.

Programy se ve Visual Basic .NET standardně spouští přes hlavní formulář. Ten se nastaví ve vlastnostech projektu a jakmile jej zavřeme, skončí i naše aplikace.

My však potřebujeme druhý způsob, protože formulář má jen události a není vhodné, aby některá běžela po celou dobu existence formuláře. Proto nejprve do formuláře přidáme modul. V Solution Exploreru klikněte pravým tlačítkem na název projektu a vyberte v kontextové nabídce Add / Module. Do něj vložte tuto hlavní proceduru.

     Public Sub Main() 
  
         'vytvořit formulář 
         Dim f1 As New Form1() 
         'zobrazit formulář 
         f1.Show() 
  
         'opakovat, dokud formulář existuje 
         While f1.Created 
             'vykreslit aktulání snímek 
             f1.Render() 
             'dát příležitost ostatním procesům 
             Application.DoEvents() 
         End While 
  
     End Sub

Visual Studio nám podtrhne slovo Render, protože formulář žádnou proceduru Render nemá, ale o to se postaráme později.

Nyní nastavíme, aby program reprezentovala procedura Main. Při spuštění naší aplikace se začne provádět právě tato procedura, která si vytvoří novou instanci formuláře a dokud tato instance existuje, volá v ní proceduru Render, která provádí vykreslování. Nesmíme zapomenout na důležitý řádek Application.DoEvents(), který je potřeba provádět po každém snímku, neboť tento řádek na chvíli pozastaví náš proces a dá příležitost ostatním aplikacím, aby mohly udělat to, co potřebují. Neexperimentujte s tímto řádkem! Pokud jej tam nedáte, výkonaplikace se zvýší asi tak o 1 procento, ale aplikace bude pořád ve stavu Neodpovídá a systém se stane neovladatelným, protože nedostane šanci na zpracování vstupu z klávesnice. Tento řádek tedy má své opodstatnění a rozhodně tam není zbytečný!

V Solution Exploreru dvakrát klikněte na položku My Project a dostanete se na okno vlastností projektu. Nejprve zrušte zaškrtnutí volby Enable Application Framework, která povolí druhý způsob běhu aplikace. Pak v rozbalovacím seznamu Startup Form vyberte položku Module1, která řekne, že spouštěcí procedura se bude hledat v tomto modulu. Také přidejte na záložce References naše dvě knihovny, které potřebujeme, tedy Microsoft.DirectX a Microsoft.DirectX.DirectDraw, to už z minulého dílu umíme. Uložte a zavřete vlastnosti projektu.

Aby nám aplikace fungovala tak, jak má, je potřeba přidat procedury formuláře z minulého dílu - konkrétně obsluhu události Form1_Load a procedury createDevice a createBuffers, které tato událost volá, dále událost Form1_KeyDown, která obsluhuje ukončení aplikace klávesou ESC.

Dále musíme přidat celou proceduru Render, kterou tvoří kód z události Timer1_Tick z minulého dílu.

Přepněte se do režimu kódu formuláře, celý obsah smažte a nahraďte tímto kódem. Je to víceméně kopírování z minulého dílu, takže by mělo být vše jasné.

 Imports Microsoft.DirectX 
 Imports Microsoft.DirectX.DirectDraw 
  
 Public Class Form1 
  
     Dim dev As Device       'zařízení 
     Dim backBuffer As Surface, backBufferDesc As SurfaceDescription     'BackBuffer a jeho parametry 
     Dim frontBuffer As Surface, frontBufferDesc As SurfaceDescription   'FrontBuffer a jeho parametry 
     Dim clip As Clipper     'oříznutí 
  
     Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown 
         'ukončení programu 
         If e.KeyCode = Keys.Escape Then 
             End 
         End If 
     End Sub 
  
     Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load 
         'vytvořit a nastavit zařízení 
         createDevice() 
         'vytvořit buffery 
         createBuffers() 
         'nahrát obsah 
         loadContents() 
     End Sub 
  
     Public Sub createDevice() 
         'vytvořit a nastavit zařízení 
         dev = New Device() 
         dev.SetCooperativeLevel(Me, CooperativeLevelFlags.FullscreenExclusive) 
     End Sub 
  
     Public Sub createBuffers() 
         'kontrola 
         If Not Me.Focused Then Exit Sub 
  
         'nastavit zařízení 
         dev.SetCooperativeLevel(Me, CooperativeLevelFlags.FullscreenExclusive) 
  
         'vytvořit FrontBuffer 
         If frontBuffer IsNot Nothing Then 
             frontBuffer.Restore() 
         Else 
             frontBufferDesc = New SurfaceDescription() 
             frontBufferDesc.SurfaceCaps.PrimarySurface = True 
             frontBufferDesc.SurfaceCaps.Flip = True 
             frontBufferDesc.SurfaceCaps.Complex = True 
             frontBufferDesc.BackBufferCount = 1 
             frontBuffer = New Surface(frontBufferDesc, dev) 
         End If 
  
         'vytvořit BackBuffer 
         If backBuffer IsNot Nothing Then 
             backBuffer.Restore() 
         Else 
             backBufferDesc = New SurfaceDescription() 
             backBufferDesc.SurfaceCaps.BackBuffer = True 
             backBuffer = frontBuffer.GetAttachedSurface(backBufferDesc.SurfaceCaps) 
         End If 
  
         'nastavit oříznutí 
         clip = New Clipper(dev) 
         clip.Window = Me 
         frontBuffer.Clipper = clip 
     End Sub 
  
     Public Sub loadContents() 
         'nahrát obsah 
  
     End Sub 
  
     Public Sub Render() 
         'kontrola 
         If Not Me.Created Then Exit Sub 
         If frontBuffer Is Nothing Or backBuffer Is Nothing Then Exit Sub 
         If Not Me.Focused Then Exit Sub 
  
         Try 
  
             'vykreslit scénu na BackBuffer 
             backBuffer.ColorFill(Color.Black) 
  
             'převrátit buffery 
             frontBuffer.Flip(backBuffer, FlipFlags.Wait) 
  
         Catch ex As Exception 
  
             'po obnovení z minimalizace 
             If ex.GetType() Is GetType(SurfaceLostException) Then 
                 createBuffers() 
             End If 
  
         End Try 
     End Sub 
 End Class

Na první pohled by se mohlo zdát, že se nespustí inicializace formuláře, ale to není pravda. Procedura Form1_Load se spustí při vytváření formuláře a zavolá tedy vše, co je potřeba ke spuštění aplikace.

Do formuláře jsem ještě přidal proceduru loadContents, do které vložíme kód pro načtení obrázků a dalšího obsahu.

Načtení obrázků

Nyní napíšeme jednoduchou scénu, ve které se budou na spodním okraji obrazovky zobrazovat balónky a budou létat vzhůru, každý různou rychlostí.

Obrázky balónků si můžete stáhnout zabalené v archivu. Je třeba, aby tyto obrázky byly ve formátu BMP. Neukládejte tyto ukázkové, jsou totiž ve formátu PNG. 

Tyto obrázky si stáhněte, v Solution Exploreru klikněte pravým tlačítkem na název projektu a vyberte volbu Add / New Folder, pojmenujte ji images a přetáhněte do ní naše 4 obrázky.

Na každý z nich v Solution Exploreru klikněte a nastavte jim vlastnost Copy To Output Directory na Copy Always, čímž si zajistíme, že se obrázkyzkopírují do adresáře aplikace.

Každý obrázek nahrajeme do vlastního objektu Surface. Nadeklarujeme si tedy 4 proměnné typu Surface. Tento řádek přidejte do deklarací formuláře.

Private b1, b2, b3, b4 As Surface

Do procedury loadContent přidejte tyto příkazy, které načtou obrázky ze souboru a nastaví jim ColorKey (průhlednou barvu) na černou, což je standardní, proto ji nemusíme nastavovat, stačí vytvořit objekt ColorKey, který má tuto barvu již nastavenou.

     Public Sub loadContents() 
         'nahrát obsah 
         Dim sd As New SurfaceDescription 
         b1 = New Surface("images\b1.bmp", sd, dev) 
         b2 = New Surface("images\b2.bmp", sd, dev) 
         b3 = New Surface("images\b3.bmp", sd, dev) 
         b4 = New Surface("images\b4.bmp", sd, dev) 
  
         'nastavit průhlednou barvu (standardní je černá) 
         Dim ck As New ColorKey() 
         b1.SetColorKey(ColorKeyFlags.SourceDraw, ck) 
         b2.SetColorKey(ColorKeyFlags.SourceDraw, ck) 
         b3.SetColorKey(ColorKeyFlags.SourceDraw, ck) 
         b4.SetColorKey(ColorKeyFlags.SourceDraw, ck) 
     End Sub 

Vykreslení balónků

Do procedury Render přidejte mezi řádky s voláními ColorFill a Flip tyto 4 řádky, které vykreslí naše balónky.

         'vykreslit balónky 
         backBuffer.DrawFast(100, 100, b1, DrawFastFlags.SourceColorKey) 
         backBuffer.DrawFast(200, 100, b2, DrawFastFlags.SourceColorKey) 
         backBuffer.DrawFast(300, 100, b3, DrawFastFlags.SourceColorKey) 
         backBuffer.DrawFast(400, 100, b4, DrawFastFlags.SourceColorKey)

Metoda DrawFast vykreslí na pozice udané prvními dvěma argumenty obrázek udaný třetím argumentem. Poslední parametr říká, že se musí použít průhledná barva z obrázků. Výsledek vypadá asi takto:

Pokud by ale balónky byly u kraje obrazovky a kousek by byl mimo, nastane chyba, protože DirectDraw nekontroluje, jestli nekreslíme mimo Surface. Napíšeme si tedy proceduru BltFast, která zjistí, jestli není část obrázku mimo obrazovku a v takovém případě vytvoří strukturu typu Rectangle, která ohraničí na obrázku oblast, která se vykreslit má.

     Public Sub BltFast(ByVal X As Integer, ByVal Y As Integer, ByRef s As Surface) 
         'vykreslit obrázek 
         Dim left As Integer = 0, width As Integer = s.SurfaceDescription.Width 
         Dim top As Integer = 0, height As Integer = s.SurfaceDescription.Height 
  
         'spočítat ořezový čtverec 
         If Y < 0 Then top = -Y : height = s.SurfaceDescription.Height + Y 
         If Y + s.SurfaceDescription.Height > dev.DisplayMode.Height Then height = dev.DisplayMode.Height - Y 
         If X < 0 Then left = -X : width = s.SurfaceDescription.Width + X 
         If X + s.SurfaceDescription.Width > dev.DisplayMode.Width Then width = dev.DisplayMode.Width - X 
  
         'pokud je na obrazovce, vykreslit ho 
         If X + s.SurfaceDescription.Width > 0 And Y + s.SurfaceDescription.Height > 0 And _ 
            X < dev.DisplayMode.Width - 1 And Y < dev.DisplayMode.Height - 1 Then 
             backBuffer.DrawFast(Math.Max(0, X), Math.Max(0, Y), s, New Rectangle(left, top, width, height - 1), DrawFastFlags.SourceColorKey) 
         End If 
     End Sub

Na vykreslování tedy budeme používat tuto proceduru, která obrázek ořízne a vykreslí jen to, co na obrazovce je.

Pohyb balónků

Nadeklarujeme si novou instanci objektu pro generování náhodných čísel, datovou strukturu pro uložení informací o jednom balónku a pole pro 50 balónků tohoto datového typu. O každém balónku si potřebujeme pamatovat pozici X, pozici Y, rychlost a barvu. V proceduře projdeme cyklem každý balónek a pokud nemá vygenerovanou náhodnou rychlost nebo je již nad horním krajem obrazovky, vygenerujeme mu novou rychlost, barvu a pozici X, pozicy Y nastavíme na spodní kraj obrazovky.

Posouvání balónků funguje tak, aby nezáleželo na počtu snímků za sekundu. V proměnné lastFrame si uchováváme informaci o tom, kdy byl dokončen minulý snímek a v proměnné lastFrameTime máme počet milisekund, kolik trvalo renderování posledního snímku. A právě touto proměnnou vynásobíme rychlost balónku a bude se pohybovat stejně při 50fps tqak i při 20fps, protože pokud budeme mít pouze 2 snímky za sekundu, hodnota bude 50 a balónek se posune o větší kus než při 50 fps, kdy hodnota proměnné bude 20.

Přidejte tedy do formuláře tuto deklaraci:

     Structure Balloon       'informace o jednom balónku 
         Dim X As Integer 
         Dim Y As Integer 
         Dim Speed As Single 
         Dim Color As Integer 
     End Structure 
     Dim Balloons(59) As Balloon 'pole čtyřiceti balónků 
  
     Dim r As New Random() 
     Dim lastFrameTime As Integer, lastFrame As Integer

A na samý závěr procedura, která balónky rozhýbe a vykreslí.

     Public Sub moveBalloons() 
         'spočítat, kolik milisekund uběhlo od posledního snímku 
         lastFrameTime = Environment.TickCount - lastFrame 
         lastFrame = Environment.TickCount 
  
         'pohyb a vykreslení balónků 
         For i As Integer = 0 To Balloons.Length - 1 
             With Balloons(i) 
                 'balónek letí nahoru 
                 .Y = .Y - .Speed * lastFrameTime 
  
                 'pokud už není vidět, vygenerovat mu novou pozici, anebo pokud jsme mu pozici ještě nevygenerovali 
                 If .Y < -100 Or .Speed = 0 Then 
                     .X = r.Next(dev.DisplayMode.Width) 
                     .Y = dev.DisplayMode.Height - 10 
                     .Speed = 0.3 + r.NextDouble() / 2 
                     .Color = r.Next(4) 
                 End If 
  
                 'vykreslit balónek 
                 BltFast(.X, .Y, b(.Color)) 
             End With 
         Next 
     End Sub

Její princip je popsán výše a myslím, že není třeba jej dále rozvádět. Ještě místo vykreslení 4 balónků pomocí DrawFast dejte volání procedury moveBalloons bez parametrů a aplikace je hotova.

Výsledek vypadá asi takto: