Tipp 0302 Multitexturing
Autor/Einsender:
Datum:
  Richard Schubert
10.01.2003
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 8
Dieser Tipp zeigt, wie man mittels Direct3D 8 Multitexturing verwendet. So können mehrere Texturen auf ein Objekt gelegt werden, ohne dieses öfter darstellen zu müssen. Die Texturen und sogar Vertex-Farbwerte werden bei der Ausgabe miteinander verrechnet. Letzteres Feature ist in Visual Basic leider nur bedingt möglich.
 
Option Explicit

Const D3DFVF_CUSTOMVERTEX As Long = (D3DFVF_XYZ Or D3DFVF_TEX2)

Const PI As Single = 3.1415

Private Type CUSTOMVERTEX
  position As D3DVECTOR
  tu1 As Single
  tv1 As Single
  tu2 As Single
  tv2 As Single
End Type

Dim g_DX As New DirectX8
Dim g_D3D As Direct3D8
Dim g_D3DX As New D3DX8
Dim g_D3DDevice As Direct3DDevice8
Dim g_VB As Direct3DVertexBuffer8

Dim g_Texture1 As Direct3DTexture8
Dim g_Texture2 As Direct3DTexture8

Dim FPSTimer As Long
Dim FPSCounter As Integer
Dim FPS As Integer
Dim ConstSpeed As Single

Private Sub Form_Load()
  Dim b As Boolean

  Me.Show
  DoEvents

  b = InitD3D(Me.hWnd)
  If Not b Then
    MsgBox "Unable to CreateDevice"
    End
  End If

  b = InitStereometry()
  If Not b Then
    MsgBox "Unable to Create VertexBuffer"
    End
  End If

  Do
    DoEvents

    CalcFPS
    Render
  Loop
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyEscape Then Unload Me
End Sub

Function InitD3D(hWnd As Long) As Boolean
  Dim mode As D3DDISPLAYMODE
  Dim d3dpp As D3DPRESENT_PARAMETERS

  On Local Error Resume Next

  Set g_D3D = g_DX.Direct3DCreate()
  If g_D3D Is Nothing Then Exit Function

  g_D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, mode

  d3dpp.Windowed = 1
  d3dpp.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
  d3dpp.BackBufferFormat = mode.Format
  d3dpp.BackBufferCount = 1
  d3dpp.EnableAutoDepthStencil = 1
  d3dpp.AutoDepthStencilFormat = D3DFMT_D16

  Set g_D3DDevice = g_D3D.CreateDevice(D3DADAPTER_DEFAULT, _
        D3DDEVTYPE_HAL, hWnd, _
        D3DCREATE_SOFTWARE_VERTEXPROCESSING, d3dpp)
  If g_D3DDevice Is Nothing Then Exit Function

  g_D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE

  g_D3DDevice.SetRenderState D3DRS_ZENABLE, 1

  Set g_Texture1 = g_D3DX.CreateTextureFromFile( _
        g_D3DDevice, App.Path + "\tex1.bmp")
  Set g_Texture2 = g_D3DX.CreateTextureFromFile( _
        g_D3DDevice, App.Path + "\tex2.bmp")

  InitD3D = True
End Function

Function InitStereometry() As Boolean
  Dim Vertex(0 To 3) As CUSTOMVERTEX
  Dim VertexSizeInBytes As Long
  Dim theta As Single
  Dim thetas As Single

  VertexSizeInBytes = Len(Vertex(0))

  Vertex(0).position.x = -1
  Vertex(0).position.y = 1
  Vertex(0).position.z = 0
  Vertex(0).tu1 = 0
  Vertex(0).tv1 = 0

  Vertex(1).position.x = -1
  Vertex(1).position.y = -1
  Vertex(1).position.z = 0
  Vertex(1).tu1 = 0
  Vertex(1).tv1 = 1

  Vertex(2).position.x = 1
  Vertex(2).position.y = 1
  Vertex(2).position.z = 0
  Vertex(2).tu1 = 1
  Vertex(2).tv1 = 0

  Vertex(3).position.x = 1
  Vertex(3).position.y = -1
  Vertex(3).position.z = 0
  Vertex(3).tu1 = 1
  Vertex(3).tv1 = 1

  Set g_VB = g_D3DDevice.CreateVertexBuffer( _
        VertexSizeInBytes * 4, 0, _
        D3DFVF_CUSTOMVERTEX, D3DPOOL_DEFAULT)
  If g_VB Is Nothing Then Exit Function

  D3DVertexBuffer8SetData g_VB, 0, _
        4 * VertexSizeInBytes, 0, Vertex(0)

  InitStereometry = True
End Function

Sub RotateTexture()
  Dim VertexSizeInBytes As Long
  Dim speed As Single

  Dim Vertices(0 To 3) As CUSTOMVERTEX

  speed = 4

  VertexSizeInBytes = Len(Vertices(0))

  D3DVertexBuffer8GetData g_VB, 0, _
        VertexSizeInBytes * 4, 0, Vertices(0)

    Vertices(0).tu2 = Cos(Timer * speed) / 1.7 + 0.5
    Vertices(0).tv2 = Sin(Timer * speed) / 1.7 + 0.5

    Vertices(1).tu2 = Cos(Timer * speed - PI / 2) / 1.7 + 0.5
    Vertices(1).tv2 = Sin(Timer * speed - PI / 2) / 1.7 + 0.5

    Vertices(2).tu2 = Cos(Timer * speed + PI / 2) / 1.7 + 0.5
    Vertices(2).tv2 = Sin(Timer * speed + PI / 2) / 1.7 + 0.5

    Vertices(3).tu2 = Cos(Timer * speed + PI) / 1.7 + 0.5
    Vertices(3).tv2 = Sin(Timer * speed + PI) / 1.7 + 0.5

  D3DVertexBuffer8SetData g_VB, 0, _
        4 * VertexSizeInBytes, 0, Vertices(0)
End Sub

Sub SetupMatrices()
  Dim matView As D3DMATRIX
  Dim matProj As D3DMATRIX

  D3DXMatrixLookAtLH matView, vec3(0, 0, -3), _
                              vec3(0, 0, 0), _
                              vec3(0, 1, 0)

  g_D3DDevice.SetTransform D3DTS_VIEW, matView

  D3DXMatrixPerspectiveFovLH matProj, PI / 4, 0.75, 1, 100
  g_D3DDevice.SetTransform D3DTS_PROJECTION, matProj
End Sub

Sub Render()
  Dim v As CUSTOMVERTEX
  Dim sizeOfVertex As Long

  Me.Caption = "Multi Texturing   FPS: " & FPS

  If g_D3DDevice Is Nothing Then Exit Sub

  g_D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or _
        D3DCLEAR_ZBUFFER, &H50&, 1, 0

  g_D3DDevice.BeginScene

  SetupMatrices
  RotateTexture

  g_D3DDevice.SetTexture 0, g_Texture1
  g_D3DDevice.SetTexture 1, g_Texture2

  g_D3DDevice.SetTextureStageState 0, D3DTSS_COLOROP, _
          D3DTOP_SELECTARG1
  g_D3DDevice.SetTextureStageState 0, D3DTSS_COLORARG1, _
          D3DTA_TEXTURE

  g_D3DDevice.SetTextureStageState 1, D3DTSS_COLOROP, _
          D3DTOP_MODULATE
  g_D3DDevice.SetTextureStageState 1, D3DTSS_COLORARG1, _
          D3DTA_TEXTURE

  g_D3DDevice.SetTextureStageState 0, D3DTSS_MAGFILTER, _
          D3DTEXF_LINEAR
  g_D3DDevice.SetTextureStageState 1, D3DTSS_MAGFILTER, _
          D3DTEXF_LINEAR

  sizeOfVertex = Len(v)
  g_D3DDevice.SetStreamSource 0, g_VB, sizeOfVertex
  g_D3DDevice.SetVertexShader D3DFVF_CUSTOMVERTEX
  g_D3DDevice.DrawPrimitive D3DPT_TRIANGLESTRIP, 0, 2

  g_D3DDevice.EndScene

  g_D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub

Function vec3(x As Single, y As Single, z As Single) As D3DVECTOR
  vec3.x = x
  vec3.y = y
  vec3.z = z
End Function

Sub CalcFPS()
  If FPSTimer + 1 <= Timer Then
    FPSTimer = Timer
    FPS = FPSCounter
    FPSCounter = 0
  Else
    FPSCounter = FPSCounter + 1
  End If

  If FPS > 0 Then ConstSpeed = 85 / FPS
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Cleanup
  End
End Sub

Sub Cleanup()
  Set g_VB = Nothing
  Set g_Texture1 = Nothing
  Set g_Texture2 = Nothing
  Set g_D3DDevice = Nothing
  Set g_D3D = Nothing
End Sub
 
Hinweis
Um dieses Beispiel ausführen zu können, wird die DirectX 8 for Visual Basic Type Library benötigt (siehe dazu die Erläuterungen in der DirectX-Rubrik).

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (72,7 kB) Downloads bisher: [ 1141 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Freitag, 9. September 2011