Tipp 0309 Specular Lighting
Autor/Einsender:
Datum:
  Richard Schubert
30.01.2003
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 8
Dieses Beispiel zeigt die Verwendung von Specular Lighting mittels Direct3D 8. Neben einem Wechsel zwischen Spot Light und Directional Light, um die Unterschiede zwischen den beiden Lichtarten zu verdeutlichen, kann auch zwischen Kamera- und Lichtdrehung gewechselt werden.
Weiterhin lässt sich das WireFrame ein und ausschalten.
 
Option Explicit

Const D3DFVF_CUSTOMVERTEX As Long = _
        (D3DFVF_XYZ Or D3DFVF_NORMAL Or D3DFVF_TEX1)

Const PI As Single = 3.1415

Const PARTS_X As Long = 50
Const PARTS_Y As Long = 10

Const PRIMITIVES As Long = PARTS_X * PARTS_Y * 2
Const VERTICES   As Long = PARTS_X * PARTS_Y * 6

Private Type CUSTOMVERTEX
  position As D3DVECTOR
  normal   As D3DVECTOR
  tu       As Single
  tv       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_Texture   As Direct3DTexture8

Dim g_LRotate   As Boolean
Dim g_Specular  As Boolean
Dim g_LightType As Boolean
Dim g_WireFrame As Boolean

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

  g_Specular = True
  g_LightType = True

  Do
    DoEvents

    CalcFPS
    Render
  Loop
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyEscape Then Unload Me
  If KeyCode = vbKeyS Then g_Specular = Not g_Specular
  If KeyCode = vbKeyC Then g_LRotate = Not g_LRotate
  If KeyCode = vbKeyL Then g_LightType = Not g_LightType
  If KeyCode = vbKeyW Then g_WireFrame = Not g_WireFrame
End Sub

Function InitD3D(hWnd As Long) As Boolean
  On Local Error Resume Next

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

  Dim mode As D3DDISPLAYMODE
  g_D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, mode

  Dim d3dpp As D3DPRESENT_PARAMETERS
  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_Texture = g_D3DX.CreateTextureFromFile(g_D3DDevice, _
        App.Path + "\tex.bmp")

  InitD3D = True
End Function

Function Normalize(ByRef v As D3DVECTOR)
  Dim div As Single
  div = Sqr(v.x * v.x + v.y * v.y + v.z * v.z)

  v.x = v.x / div
  v.y = v.y / div
  v.z = v.z / div
End Function

Function GetNormal(ByRef v1 As D3DVECTOR, _
        ByRef v2 As D3DVECTOR) As D3DVECTOR
  Dim vResult As D3DVECTOR

  vResult.x = v1.y * v2.z - v1.z * v2.y
  vResult.y = v1.z * v2.x - v1.x * v2.z
  vResult.z = v1.x * v2.y - v1.y * v2.x

  Normalize vResult
  GetNormal = vResult
End Function

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

  VertexSizeInBytes = Len(Vertex(0))

  Dim n As Long
  Dim m As Long

  Dim Tile As Long
  Dim VTile As Long

  For n = 0 To PARTS_X - 1
    theta = (2 * PI * n) / (PARTS_X)
    thetas = 2 * PI / (PARTS_X)

    For m = 0 To PARTS_Y - 1
      Tile = PARTS_X * 6 * m + n * 6

      Vertex(Tile + 0).position = vec3(Sin(theta + thetas), _
              (m + 1) / PARTS_Y * 3 - 1, Cos(theta + thetas))
      Vertex(Tile + 0).tu = 4 * (n + 1) / (PARTS_X)
      Vertex(Tile + 0).tv = (m + 1) / PARTS_Y

      Vertex(Tile + 1).position = vec3(Sin(theta), _
              (m + 1) / PARTS_Y * 3 - 1, Cos(theta))
      Vertex(Tile + 1).tu = 4 * n / (PARTS_X)
      Vertex(Tile + 1).tv = (m + 1) / PARTS_Y

      Vertex(Tile + 2).position = vec3(Sin(theta), _
              (m) / PARTS_Y * 3 - 1, Cos(theta))
      Vertex(Tile + 2).tu = 4 * n / (PARTS_X)
      Vertex(Tile + 2).tv = m / PARTS_Y

      Vertex(Tile + 3) = Vertex(Tile + 2)

      Vertex(Tile + 4).position = vec3(Sin(theta + thetas), _
              (m) / PARTS_Y * 3 - 1, Cos(theta + thetas))
      Vertex(Tile + 4).tu = 4 * (n + 1) / (PARTS_X)
      Vertex(Tile + 4).tv = m / PARTS_Y

      Vertex(Tile + 5) = Vertex(Tile + 0)
    Next
  Next

  Dim v1 As D3DVECTOR
  Dim v2 As D3DVECTOR

  For n = 0 To PARTS_X - 1
    For m = 0 To PARTS_Y - 1
        Tile = PARTS_X * 6 * m + n * 6

        v1.x = Vertex(Tile + 1).position.x - _
                    Vertex(Tile + 0).position.x
        v1.y = Vertex(Tile + 1).position.y - _
                    Vertex(Tile + 0).position.y
        v1.z = Vertex(Tile + 1).position.z - _
                    Vertex(Tile + 0).position.z

        v2.x = Vertex(Tile + 4).position.x - _
                    Vertex(Tile + 0).position.x
        v2.y = Vertex(Tile + 4).position.y - _
                    Vertex(Tile + 0).position.y
        v2.z = Vertex(Tile + 4).position.z - _
                    Vertex(Tile + 0).position.z

        Vertex(Tile + 0).normal = GetNormal(v1, v2)
        Vertex(Tile + 5).normal = Vertex(Tile + 0).normal
    Next
  Next

  Dim Tile11 As Long
  Dim Tile10 As Long
  Dim Tile01 As Long

  For n = 0 To PARTS_X - 1
    For m = 0 To PARTS_Y - 1
      Tile = PARTS_X * 6 * m + n * 6

      Tile11 = PARTS_X * 6 * (m - 1) + (n - 1) * 6
      Tile10 = PARTS_X * 6 * m + (n - 1) * 6
      Tile01 = PARTS_X * 6 * (m - 1) + n * 6

      If Tile01 < 0 Then Tile01 = Tile
      If Tile11 < 0 Then Tile11 = _
                  PARTS_X * 6 * m + (n + PARTS_X - 1) * 6
      If Tile10 < 0 Then Tile10 = _
                  PARTS_X * 6 * m + (n + PARTS_X - 1) * 6

      Vertex(Tile + 2).normal = Vertex(Tile11 + 0).normal
      Vertex(Tile + 1).normal = Vertex(Tile10 + 0).normal
      Vertex(Tile + 3).normal = Vertex(Tile11 + 0).normal
      Vertex(Tile + 4).normal = Vertex(Tile01 + 0).normal
    Next
  Next

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

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

  InitStereometry = True
End Function

Sub SetupMatrices()
  Dim matView As D3DMATRIX
  If g_LRotate Then
    D3DXMatrixLookAtLH matView, _
          vec3(5, 3, -8), vec3(0, 0, 0), vec3(0, 1, 0)
  Else
    D3DXMatrixLookAtLH matView, _
          vec3(Cos(Timer * 0.5) * 8, 3, -Sin(Timer * 0.5) * 8), _
          vec3(0, 0, 0), vec3(0, 1, 0)
  End If

  g_D3DDevice.SetTransform D3DTS_VIEW, matView

  Dim matProj As D3DMATRIX
  D3DXMatrixPerspectiveFovLH matProj, PI / 4, 1, 1, 100
  g_D3DDevice.SetTransform D3DTS_PROJECTION, matProj
End Sub

Sub SetupLights()
  Dim col As D3DCOLORVALUE

  Dim mtrl As D3DMATERIAL8
  With col:    .r = 1: .g = 1: .b = 1: .a = 1:   End With
  mtrl.diffuse = col
  mtrl.Ambient = col
  mtrl.specular = col

  mtrl.power = 10

  g_D3DDevice.SetMaterial mtrl

  Dim light As D3DLIGHT8

  If g_LightType Then
    light.Type = D3DLIGHT_SPOT
  Else
    light.Type = D3DLIGHT_DIRECTIONAL
  End If

  light.Ambient.r = 0.1
  light.Ambient.g = 0.1
  light.Ambient.b = 0.1

  light.diffuse.r = 0
  light.diffuse.g = 0
  light.diffuse.b = 1

  light.specular.r = 1
  light.specular.g = 1
  light.specular.b = 1

  light.position.x = 0
  light.position.y = -2
  light.position.z = -3

  If g_LRotate Then
    light.Direction.x = Cos(Timer * 0.5)
    light.Direction.y = 0.9
    light.Direction.z = Sin(Timer * 0.5)
  Else
    light.Direction.x = Sin(0)
    light.Direction.y = 0.9
    light.Direction.z = Cos(0)
  End If

  light.Range = 100

  light.Falloff = 0.5
  light.Phi = PI / 2
  light.theta = PI / 3
  light.Attenuation0 = 0.5

  g_D3DDevice.SetLight 0, light
  g_D3DDevice.LightEnable 0, 1
  g_D3DDevice.SetRenderState D3DRS_LIGHTING, 1

  If g_Specular Then
    g_D3DDevice.SetRenderState D3DRS_SPECULARENABLE, 1
  Else
    g_D3DDevice.SetRenderState D3DRS_SPECULARENABLE, 0
  End If
End Sub

Sub Render()
  Me.Caption = "Specular Lighting   FPS: " & FPS

  Dim v As CUSTOMVERTEX
  Dim sizeOfVertex As Long

  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

    SetupLights
    SetupMatrices

    If g_WireFrame Then
      g_D3DDevice.SetRenderState D3DRS_FILLMODE, 2
      g_D3DDevice.SetTexture 0, Nothing
    Else
      g_D3DDevice.SetRenderState D3DRS_FILLMODE, 3
      g_D3DDevice.SetTexture 0, g_Texture
    End If

    sizeOfVertex = Len(v)
    g_D3DDevice.SetStreamSource 0, g_VB, sizeOfVertex
    g_D3DDevice.SetVertexShader D3DFVF_CUSTOMVERTEX
    g_D3DDevice.DrawPrimitive _
          D3DPT_TRIANGLELIST, 0, PARTS_X * PARTS_Y * 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

Sub Cleanup()
  Set g_VB = 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  (39 kB) Downloads bisher: [ 1239 ]

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: Donnerstag, 28. Juli 2011