Модератор: Mikle
Dim TexBothka As Direct3DTexture8 'текстура бочки
Private Type GameMesh
Model As D3DXMesh
MeshMaterials() As D3DMATERIAL8
NumMaterials As Long
End Type
Dim Bothka As GameMesh 'Mesh бочки
......
Private Sub InitGeometry()
'загружаю .Х
Bothka = CreateGameMesh(App.Path + "\Bothka.x")
End Sub
Private Function CreateGameMesh(FileName As String) As GameMesh
Dim MtrlBuffer As D3DXBuffer
Dim i As Long
Set CreateGameMesh.Model = d3dx.LoadMeshFromX(FileName, D3DXMESH_MANAGED, _
d3dDevice, Nothing, MtrlBuffer, CreateGameMesh.NumMaterials)
ReDim CreateGameMesh.MeshMaterials(CreateGameMesh.NumMaterials)
For i = 0 To CreateGameMesh.NumMaterials - 1
d3dx.BufferGetMaterial MtrlBuffer, i, CreateGameMesh.MeshMaterials(i)
CreateGameMesh.MeshMaterials(i).Ambient = CreateGameMesh.MeshMaterials(i).diffuse
Next
Set TexBothka = d3dx.CreateTextureFromFile(d3dDevice, App.Path + "\Bothka.dds")'загружаю текстуру
Set MtrlBuffer = Nothing
End Function
Private Sub Render()
d3dDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, SkyColor, 1, 0
d3dDevice.BeginScene
d3dDevice.SetTexture 0, TexBothka 'рендер
DrawGameMesh Bothka, 0, 0, 0 'модели
d3dDevice.EndScene
d3dDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
Очень жаль! Но, я попробую помочь!DrKillJoy спасибо но у меня VB6
Private Sub LoadMesh(ByVal file As String)
Dim mtrl As ExtendedMaterial() = Nothing
mesh = mesh.FromFile(file, MeshFlags.SystemMemory, Direct3D_Device, mtrl)
If meshMaterials Is Nothing Then
' Мы должны извлечь свойств материалов и имена текстур
meshTextures = New Texture(mtrl.Length) {}
meshMaterials = New Direct3D.Material(mtrl.Length) {}
Dim i As Integer
For i = 0 To mtrl.Length - 1
meshMaterials(i) = mtrl(i).Material3D
' Установить окружающего цвета материала (D3DX этого не делает)
meshMaterials(i).Ambient = meshMaterials(i).Diffuse
If mtrl(i).TextureFilename <> Nothing Then
' Создание текстуры
meshTextures(i) = TextureLoader.FromFile(Direct3D_Device, mtrl(i).TextureFilename)
End If
Next i
End If
End Sub
Private Sub DrawMesh(ByVal yaw As Single, ByVal pitch As Single, ByVal roll As Single, ByVal x As Single, ByVal y As Single, ByVal z As Single)
angle += 0.01
Direct3D_Device.Transform.World = Matrix.RotationYawPitchRoll(yaw, pitch, roll) * Matrix.Translation(x, y, z)
Dim i As Integer
For i = 0 To meshMaterials.Length - 1
Direct3D_Device.Material = meshMaterials(i)
Direct3D_Device.SetTexture(0, meshTextures(i))
mesh.DrawSubset(i)
Next
End Sub
longwair писал(а):можно ли на VB6 сделать игруху типа Half-Life 1.
longwair писал(а):с какими текстурами лучше работать, я в смысле формата какого?
longwair писал(а):у меня seleron 1800, radeon 9600. оперативы 512
longwair писал(а):Наконец то нашёл почему так падал FPS
longwair писал(а):Текстуры накладываются как надо, но это серьёзно ударило по FPS с 72 упал до 30-40
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 15