Programování pod DirectX ve VB (1.)

Chceme-li programovat ve VB hru, musíme mít typovou knihovnu pro podporu DirectX ve Visual Basicu. Založme tedy nový projekt Standard Exe a v Referencích (Project / Referencis .../) vyberte položku DirectX 7 for Visual Basic Type Library. Tím máme zaručenou podporu DirectX a můžeme začít programovat.

Pokud v referencích uvedená položka chybí, nezbude nic jiného, než si jí stáhnout někde z internetu

Pro úplnost uvádím, že DirectX verze 7 je již starší, proto jsem ho použil v ukázkovém příkladu. Pro další (vyšší) verze je nutné přepsat moduly s funkcemi a deklaracemi DirectX rozhraní.

A nyní vzhůru k programování. Nejprve otestujeme podporu rozlišení, které chceme ve hře použít.

Na formulář vložte dvě tlačítka (Command1 a Command2)
a jeden Label (Label1)

Vložte tento kód a můžete testovat.

Option Explicit

Dim tFormTop
Dim tFormLeft
Dim tFormWidth
Dim tFormHeight
Dim ScreenCurW
Dim ScreenCurH
Dim ScreenCurBPP


Private Sub Command1_Click()
  Testing
End Sub

Private Sub Form_Load()
  Me.Caption = "Test podpory rozliseni"
  Command1.Caption = "&Test"
  
  With Command2
    .Caption = "&Start"
    .Enabled = False
  End With
  
  Label1.Caption = "Otestujte podporu"
    With Me
        tFormTop = (Screen.Height  2) - (.Height  2)
        tFormLeft = (Screen.Width  2) - (.Width  2)
        tFormWidth = .Width
        tFormHeight = .Height
        Form_Resize
    End With
End Sub

Private Sub Form_Resize()
  With Me
    .Top = tFormTop
    .Left = tFormLeft
    .Width = tFormWidth
    .Height = tFormHeight
  End With
End Sub

Private Function TestRes() As Boolean
  Dim dxTest As New DirectX7
  Dim ddTest As DirectDraw7

  On Error GoTo errResTest
  Set ddTest = dxTest.DirectDrawCreate("")
  ddTest.SetCooperativeLevel Me.hWnd, _
                             DDSCL_EXCLUSIVE Or _
                             DDSCL_FULLSCREEN Or _
                             DDSCL_ALLOWMODEX
  ddTest.SetDisplayMode ScreenCurW, ScreenCurH, _
                        ScreenCurBPP, 0, DDSDM_DEFAULT
  ddTest.RestoreDisplayMode
  ddTest.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
  Set ddTest = Nothing
  Set dxTest = Nothing
  Form_Resize
  TestRes = True
  Exit Function
errResTest:
    Form_Resize
    TestRes = False
    DoEvents
End Function

Private Function Testing()
  ScreenCurW = 800  'Rozlišení vodorovně (640,800,...)
  ScreenCurH = 600  'Rozlišení svisle    (480,600,...)
  ScreenCurBPP = 32 '16,8
  If TestRes Then
    Command2.Enabled = True
    Label1.Caption = "OK."
  End If
End Function

Příšte: Jak načíst obrázky a zvuky a jejich zobrazení, přehrání.