Tipp 0074 Direct3D-Engine
Autor/Einsender:
Datum:
  Richard Schubert
03.06.2001
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
Diese Direct3D-Engine zeigt einen Kegel aus 100 Polygonen. Man kann das Objekt um alle 3 Achsen rotieren lassen (auch gleichzeitig). Es kann zwischen PointLight und AmbientLight umgeschaltet werden, sowie zwischen Wireframe und gefüllten Polygonen gewählt werden. Jedes Polygon und die Anzahl der Polygone sind im Quelltext frei einstellbar.
Der Autor hat im Download-Beispiel den Quellcode sehr gut kommentiert, es wurde hier jedoch aus Gründen der Übersicht darauf verzichtet.
Code im Codebereich des Moduls m01_Variablen
 
Public Const PI As Double = 3.14159265359
Public Const MaxVertexes As Integer = 3000

Public DX As New DirectX7
Public DD As DirectDraw7
Public D3D As Direct3D7

Public PrimaryBuffer As DDSURFACEDESC2
Public Primary As DirectDrawSurface7
Public BackBuffer As DirectDrawSurface7
Public EmptyRect As RECT

Public GetZBuffer As Direct3DEnumPixelFormats
Public PrimaryZBuffer As DDSURFACEDESC2
Public PixFMTZBuffer As DDPIXELFORMAT
Public ZBuffer As DirectDrawSurface7

Public D3DDevice As Direct3DDevice7
Public ViewPort As D3DVIEWPORT7
Public RectViewport(0) As D3DRECT
Public matProj As D3DMATRIX
Public matView  As D3DMATRIX
Public Material As D3DMATERIAL7
Public Vertex(MaxVertexes) As D3DVERTEX
Public MaxPolys As Integer

Public TempVector As D3DVECTOR
Public RotationMitte As D3DVECTOR

Public LightColor As D3DCOLORVALUE
Public Light As D3DLIGHT7

Public Quit As Boolean
Public XA As Boolean
Public YA As Boolean
Public ZA As Boolean
Public PointLight As Boolean
Public DrawModus As Integer
Public Speed As Single

Public ResolutionX As Integer
Public ResolutionY As Integer
Public ColorDepth As Byte

Public FPSTimer As Long
Public FPSCounter As Integer
Public FPS As Integer

Public n As Integer
Public m As Integer
Public l As Integer
 
Code im Codebereich des Moduls m02_3DEngine
 
Public Sub Rotation(ByRef Vector As D3DVECTOR, Mitte As _
            D3DVECTOR, Achse As Integer, ByVal Winkel As Single)
  Dim RMat As D3DMATRIX
  Dim PMat As D3DMATRIX
  Dim DMat As D3DMATRIX

  DX.IdentityMatrix RMat
  DX.IdentityMatrix PMat
  DX.IdentityMatrix DMat

  If Achse = 0 Then DX.RotateXMatrix RMat, Winkel
  If Achse = 1 Then DX.RotateYMatrix RMat, Winkel
  If Achse = 2 Then DX.RotateZMatrix RMat, Winkel

  PMat.rc41 = Vector.x - Mitte.x
  PMat.rc42 = Vector.y - Mitte.y
  PMat.rc43 = Vector.z - Mitte.z

  RMat.rc41 = Mitte.x
  RMat.rc42 = Mitte.y
  RMat.rc43 = Mitte.z

  DX.MatrixMultiply DMat, PMat, RMat

  Vector.x = DMat.rc41
  Vector.y = DMat.rc42
  Vector.z = DMat.rc43

End Sub

Public Sub Paint3D()

  sub3DMotion

  If DrawModus = 2 Then D3DDevice.SetRenderState _
                        D3DRENDERSTATE_FILLMODE, 2
  If DrawModus = 3 Then D3DDevice.SetRenderState _
                        D3DRENDERSTATE_FILLMODE, 3

  If PointLight Then
    D3DDevice.SetRenderState D3DRENDERSTATE_AMBIENT, RGB(0, 0, 0)
    D3DDevice.LightEnable 0, True
  Else
    D3DDevice.SetRenderState D3DRENDERSTATE_AMBIENT, _
                             RGB(255, 255, 255)
    D3DDevice.LightEnable 0, False
  End If

  D3DDevice.Clear 1, RectViewport(), D3DCLEAR_ZBUFFER Or _
                  D3DCLEAR_TARGET, RGB(50, 0, 0), 1, 0

  D3DDevice.BeginScene

  For n = 0 To MaxPolys Step 3
    D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, D3DFVF_VERTEX, _
                            Vertex(n), 3, D3DDP_WAIT
  Next

  D3DDevice.EndScene

End Sub

Public Sub sub3DMotion()

  RotationMitte.x = 0
  RotationMitte.y = 0
  RotationMitte.z = 0

  For n = 0 To MaxPolys
    TempVector.x = Vertex(n).x
    TempVector.y = Vertex(n).y
    TempVector.z = Vertex(n).z

    If XA Then Rotation TempVector, RotationMitte, 0, Speed
    If YA Then Rotation TempVector, RotationMitte, 1, Speed
    If ZA Then Rotation TempVector, RotationMitte, 2, Speed

    Vertex(n).x = TempVector.x
    Vertex(n).y = TempVector.y
    Vertex(n).z = TempVector.z
  Next

End Sub
 
Code im Codebereich des Moduls m04_Berechnungen
 
Public Sub CalcFPS()

  If FPSTimer + 1000 <= DX.TickCount Then
    FPSTimer = DX.TickCount
    FPS = FPSCounter
    FPSCounter = 0
  Else
    FPSCounter = FPSCounter + 1
  End If

End Sub
 
Code im Codebereich der Form
 
PrivateSub Form_Load()

  Me.Show

  InitDDraw
  InitD3D

  Dim rd As Single
  MaxPolys = 300
  For n = 0 To MaxPolys - 3 Step 3
    rd = rd + PI * 2 / (MaxPolys / 3)
    DX.CreateD3DVertex 0, 0, 10, 0, 0, 0, 0, 0, Vertex(n)
    DX.CreateD3DVertex Sin(rd) * 10, Cos(rd) * 10 _
                       , 0, 0, 0, 0, 0, 0, Vertex(n + 1)
    DX.CreateD3DVertex Sin(rd + PI * 2 / (MaxPolys / 3)) * 10 _
                       , Cos(rd + PI * 2 / (MaxPolys / 3)) * 10 _
                       , 0, 0, 0, 0, 0, 0, Vertex(n + 2)
  Next n

  Do
    Paintgame
    DoEvents
  Loop Until Quit = True

  DD.SetCooperativeLevel Form1.hWnd, DDSCL_NORMAL
  DD.RestoreDisplayMode

  Set DD = Nothing
  Set D3DDevice = Nothing
  Set DX = Nothing
  End

End Sub

Private Sub InitDDraw()

  Set DX = New DirectX7
  Set DD = DX.DirectDrawCreate("")

  DD.SetCooperativeLevel Form1.hWnd, DDSCL_FULLSCREEN Or _
            DDSCL_EXCLUSIVE
  DD.SetDisplayMode 1024, 768, 16, 0, DDSDM_DEFAULT

  PrimaryBuffer.lFlags = DDSD_BACKBUFFERCOUNT Or DDSD_CAPS
  PrimaryBuffer.ddsCaps.lCaps = DDSCAPS_COMPLEX Or _
            DDSCAPS_FLIP Or DDSCAPS_PRIMARYSURFACE Or _
            DDSCAPS_VIDEOMEMORY Or DDSCAPS_3DDEVICE
  PrimaryBuffer.lBackBufferCount = 1
  Set Primary = DD.CreateSurface(PrimaryBuffer)

  Dim Caps As DDSCAPS2
  Caps.lCaps = DDSCAPS_BACKBUFFER
  Set BackBuffer = Primary.GetAttachedSurface(Caps)

  BackBuffer.SetForeColor RGB(255, 255, 255)

End Sub

Private Sub InitD3D()

  Set D3D = DD.GetDirect3D
  Set D3DDevice = D3D.CreateDevice("IID_IDirect3DHALDevice", _
                  BackBuffer)

  Set GetZBuffer = D3D.GetEnumZBufferFormats _
                   ("IID_IDirect3DHALDevice")

  For i = 1 To GetZBuffer.GetCount()
    Call GetZBuffer.GetItem(i, PixFMTZBuffer)
    If PixFMTZBuffer.lFlags = DDPF_ZBUFFER Then Exit For
  Next

  PrimaryZBuffer.lFlags = DDSD_CAPS Or DDSD_WIDTH Or _
                          DDSD_HEIGHT Or DDSD_PIXELFORMAT
  PrimaryZBuffer.ddsCaps.lCaps = DDSCAPS_ZBUFFER 
  PrimaryZBuffer.lWidth = 1024
  PrimaryZBuffer.lHeight = 768
  PrimaryZBuffer.ddpfPixelFormat = PixFMTZBuffer

  Set ZBuffer = DD.CreateSurface(PrimaryZBuffer)
  BackBuffer.AddAttachedSurface ZBuffer

  D3DDevice.SetRenderState D3DRENDERSTATE_ZENABLE, 2

  ViewPort.lX = 0
  ViewPort.lY = 0
  ViewPort.lWidth = 1024
  ViewPort.lHeight = 768
  D3DDevice.SetViewport ViewPort

  With RectViewport(0)
    .X1 = 0
    .Y1 = 0
    .X2 = 1024
    .Y2 = 768
  End With

  DX.IdentityMatrix matView

  Call DX.ViewMatrix(matView, Vector(0, 0, -15), Vector(0, 0, 0), _
                    Vector(0, 1, 0), 0)

  D3DDevice.SetTransform D3DTRANSFORMSTATE_VIEW, matView

  DX.IdentityMatrix matProj

  Call DX.ProjectionMatrix(matProj, 1, 1000, PI / 2)
  D3DDevice.SetTransform D3DTRANSFORMSTATE_PROJECTION, matProj

  D3DDevice.SetRenderTarget BackBuffer

  D3DDevice.SetRenderState D3DRENDERSTATE_CULLMODE, D3DCULL_NONE
  D3DDevice.SetRenderState D3DRENDERSTATE_FILLMODE, 3

  Material.diffuse.r = 1
  Material.diffuse.g = 1
  Material.diffuse.b = 1
  Material.diffuse.a = 1

  Material.Ambient.r = 1
  Material.Ambient.g = 1
  Material.Ambient.b = 1
  Material.Ambient.a = 1

  Material.specular.r = 1
  Material.specular.g = 1
  Material.specular.b = 1
  Material.specular.a = 1

  Material.power = 0

  D3DDevice.SetMaterial Material
  D3DDevice.SetRenderState D3DRENDERSTATE_AMBIENT, RGB(0, 0, 0)

  LightColor.r = 1
  LightColor.g = 1
  LightColor.b = 1

  Light.diffuse = LightColor
  Light.specular = LightColor
  Light.Ambient = LightColor
  Light.attenuation1 = 0.3
  Light.dltType = D3DLIGHT_POINT
  Light.position = Vector(0, 0, -5)
  Light.range = 30
  D3DDevice.SetLight 0, Light
  D3DDevice.LightEnable 0, True

  YA = True
  PointLight = True
  Speed = 0.01
  DrawModus = 3

End Sub

Private Function Vector(ByVal a As Double, ByVal b As Double, _
    ByVal c As Double) As D3DVECTOR
  Dim VecOut As D3DVECTOR

  With VecOut
    .x = a
    .y = b
    .z = c
  End With

  Vector = VecOut
End Function

Public Sub Paintgame()

  CalcFPS
  Paint3D

  BackBuffer.DrawText 10, 10, "FPS: " & FPS, False
  BackBuffer.DrawText 10, 30, "Direct 3D", False

  BackBuffer.DrawText 10, 60, "Speed (+/-): " & _
                      Round(1000 * Speed) / 1000, False
  BackBuffer.DrawText 10, 80, "DrawModus (SPACE): " & _
                      DrawModus, False
  If PointLight Then BackBuffer.DrawText 10, 100, _
                      "LichtModus (L): PointLight", False
  If Not PointLight Then BackBuffer.DrawText 10, 100, _
                      "LichtModus (L): AmbientLight", False

  BackBuffer.DrawText 10, 720, "Tasten 'x','y','z'", False
  BackBuffer.DrawText 10, 740, _
                 "Rotation um Achse:      ,      ,", False

  If XA Then BackBuffer.DrawText 145, 740, "X", False
  If YA Then BackBuffer.DrawText 170, 740, "Y", False
  If ZA Then BackBuffer.DrawText 195, 740, "Z", False

  Primary.Flip Nothing, DDFLIP_WAIT

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyEscape Then Quit = True
  If KeyCode = vbKeyX Then XA = Not XA
  If KeyCode = vbKeyY Then YA = Not YA
  If KeyCode = vbKeyZ Then ZA = Not ZA
  If KeyCode = vbKeyL Then PointLight = Not PointLight
  If KeyCode = vbKeyAdd Then Speed = Speed + 0.001
  If KeyCode = vbKeySubtract Then Speed = Speed - 0.001
  If KeyCode = vbKeySpace Then DrawModus = DrawModus + 1
  If DrawModus = 4 Then DrawModus = 2
End Sub
 
Weitere Links zum Thema
Bewegen im 3D-Raum
Hinweis
Um dieses Beispiel ausführen zu können, wird die DirectX 7 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  (6,4 kB) Downloads bisher: [ 2911 ]

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: Samstag, 8. Oktober 2011