| |
Dim objD3DRM As Direct3DRM3
Dim objD3DMB As Direct3DRMMeshBuilder3
Dim objD3DFrame As Direct3DRMFrame3
Dim objD3DMesh As Direct3DRMMesh
Public Type XGroup
IndexList() As Integer
VertexList() As D3DVERTEX
RenderVertexList() As D3DLVERTEX
Texture As DirectDrawSurface7
TextureFileName As String
End Type
Public GroupCount As Long
Public Groups() As XGroup
Public Sub XFile_Load(ByVal FileName As String)
Dim GIndex As Long
Dim IIndex As Long
Dim Index As Long
Dim ArraySize As Long
Dim IArray() As Long
Dim VertCount As Long
Dim FaceCount As Long
Dim FaceVertCount As Long
Dim TempVertex As D3DVERTEX
Dim TempRMVertex As D3DRMVERTEX
On Error GoTo ErrOut
'Direct3D RM Objekt erstellen
Set objD3DRM = DX7.Direct3DRMCreate
'Direct3D RM MeshBuilder erstellen
Set objD3DMB = objD3DRM.CreateMeshBuilder
'Es wird versucht das XFile ohne Frames zu laden
On Error Resume Next
objD3DMB.LoadFromFile App.Path & "\" & FileName, "", _
D3DRMLOAD_FIRST, Nothing, Nothing
'Schlug dies fehl, wird versucht das XFile mit Frames zu laden
If Err.Number <> 0 Then
Err.Clear
On Error GoTo ErrOut
Set objD3DMB = objD3DRM.CreateMeshBuilder
Set objD3DFrame = objD3DRM.CreateFrame(Nothing)
objD3DFrame.LoadFromFile App.Path & "\" & FileName, _
"", D3DRMLOAD_FIRST, Nothing, Nothing
objD3DMB.AddFrame objD3DFrame
End If
'Die Normalen einstellen
objD3DMB.GenerateNormals 3.14 / 4, _
D3DRMGENERATENORMALS_USECREASEANGLE
'Da die Informationen aus dem MeshBuilder nicht so einfach
'ausgelesen werden können, wird ein Mesh-Objekt mit den
'Informationen erstellt
Set objD3DMesh = objD3DMB.CreateMesh
'Anzahl der Objekte im XFile feststellen
GroupCount = objD3DMesh.GetGroupCount
ReDim Groups(GroupCount - 1)
'Die Informationen der Objekte aus dem XFile werden ausgelesen
For GIndex = 0 To objD3DMesh.GetGroupCount - 1
'Grössenangaben ermitteln
With Groups(GIndex)
ReDim .IndexList(0)
ReDim .VertexList(0)
End With
objD3DMesh.GetSizes GIndex, VertCount, FaceCount, _
FaceVertCount, ArraySize
ReDim IArray(ArraySize)
'Objekt-Faces auslesen
objD3DMesh.GetGroupData GIndex, IArray()
'Falls Textur vorhanden, dann DDSurface erstellen
If Not objD3DMesh.GetGroupTexture(GIndex) Is Nothing Then
Groups(GIndex).TextureFileName = App.Path & "\" & _
objD3DMesh.GetGroupTexture(GIndex).GetName
Load_TEXTUR Groups(GIndex).TextureFileName, _
Groups(GIndex).Texture
End If
'Schleife über alle Faces des Objektes um die
'entsprechenden Faces zu ermitteln
Dim fanIndex As Long
Dim j As Long
Dim bGetFaceCount As Boolean
IIndex = 0
bGetFaceCount = False
If FaceVertCount = 0 Then bGetFaceCount = True
Do While IIndex < ArraySize
If bGetFaceCount Then
FaceVertCount = IArray(IIndex)
IIndex = IIndex + 1
End If
fanIndex = IIndex
For j = 0 To FaceVertCount - 3
'Startpunkt hinzufügen
AddVertexIndex GIndex, IArray(fanIndex)
'und die beiden anderen Punkte
AddVertexIndex GIndex, IArray(IIndex + j + 1)
AddVertexIndex GIndex, IArray(IIndex + j + 2)
Next
IIndex = IIndex + FaceVertCount
Loop
'Schleife über alle Vertexe des Objektes um die
'entsprechenden Vertexe zu ermitteln
For Index = 0 To VertCount - 1
objD3DMesh.GetVertex GIndex, Index, TempRMVertex
With TempRMVertex
TempVertex.x = .position.x
TempVertex.y = .position.y
TempVertex.z = .position.z
TempVertex.nx = .Normal.x
TempVertex.ny = .Normal.y
TempVertex.nz = .Normal.z
TempVertex.tu = .tu
TempVertex.tv = .tv
End With
AddVertex GIndex, TempVertex
Next
'Schleife durch die Faces um die RenderListe zu erstellen
ReDim Groups(GIndex).RenderVertexList(ArraySize - 1)
For Index = 0 To ArraySize - 1
With Groups(GIndex)
.RenderVertexList(Index).x = _
.VertexList(VertexIndex(GIndex, Index)).x
.RenderVertexList(Index).y = _
.VertexList(VertexIndex(GIndex, Index)).y
.RenderVertexList(Index).z = _
.VertexList(VertexIndex(GIndex, Index)).z
.RenderVertexList(Index).tu = _
.VertexList(VertexIndex(GIndex, Index)).tu
.RenderVertexList(Index).tv = _
.VertexList(VertexIndex(GIndex, Index)).tv
.RenderVertexList(Index).color = _
DX7.CreateColorRGBA(1#, 1#, 1#, 1#)
.RenderVertexList(Index).specular = _
DX7.CreateColorRGBA(1#, 1#, 1#, 1#)
End With
Next
Next
Set objD3DRM = Nothing
Set objD3DMB = Nothing
Set objD3DFrame = Nothing
Set objD3DMesh = Nothing
Exit Sub
ErrOut:
MsgBox "XFile konnte nicht geladen werden"
End Sub
Private Sub AddVertex(groupid As Long, Vertex As D3DVERTEX)
With Groups(groupid)
LSet .VertexList(UBound(.VertexList)) = Vertex
ReDim Preserve .VertexList(UBound(.VertexList) + 1)
End With
End Sub
Private Function VertexIndex(groupid As Long, _
Index As Long) As Long
With Groups(groupid)
VertexIndex = .IndexList(Index)
End With
End Function
Private Sub AddVertexIndex(groupid As Long, VertexIndex As Long)
With Groups(groupid)
.IndexList(UBound(.IndexList)) = VertexIndex
ReDim Preserve .IndexList(UBound(.IndexList) + 1)
End With
End Sub
Public Sub Render3D()
Dim i As Integer
Device.Clear 1, ClearRec(), D3DCLEAR_TARGET Or _
D3DCLEAR_ZBUFFER, _
DX7.CreateColorRGBA(0.04, 0.04, 0.07, 1), 1, 0
Device.BeginScene
Call Device.SetTexture(0, texTextur)
'TexturKoordinaten ausserhalb der Textur werden nicht gespiegelt
Call Device.SetTextureStageState( _
0, D3DTSS_ADDRESS, D3DTADDRESS_WRAP)
'Bilinearen Texturfilter verwenden damit die Textur nicht so
'grob gerastert wird
Call Device.SetTextureStageState( _
0, D3DTSS_MAGFILTER, D3DTFG_LINEAR)
Call Device.DrawPrimitive(D3DPT_TRIANGLELIST, _
D3DFVF_LVERTEX, vxSkyBox(0), 36, D3DDP_WAIT)
'Alle Gruppen (Meshes) aus dem XFile rendern
For i = 0 To GroupCount - 1
Call Device.SetTexture(0, Groups(i).Texture)
Call Device.SetTextureStageState( _
0, D3DTSS_ADDRESS, D3DTADDRESS_WRAP)
Call Device.SetTextureStageState( _
0, D3DTSS_MAGFILTER, D3DTFG_LINEAR)
Call Device.DrawPrimitive(D3DPT_TRIANGLELIST, _
D3DFVF_LVERTEX, Groups(i).RenderVertexList(0), _
UBound(Groups(i).RenderVertexList) + 1, D3DDP_WAIT)
Next
Device.EndScene
End Sub
|
|
Vorheriger Tipp
Zum Seitenanfang 