Bueno... encontré un tuto muy bueno que quiero compartir con ustedes
http://rapidshare.com/files/30851743/Dise_o_3D.rar
Explica como manejar el directx con VB para juegos o lo que sea.. estan bien chulos... aya va una sola parte de 10 en total:
Dim Anglex As Single
Dim Angley As Single
Dim Anglez As Single
Dim Dx As DirectX8
Dim D3D As Direct3D8
Dim D3DDevice As Direct3DDevice8
Dim Dx8 As New D3DX8
Dim BanderaDeSalida As Boolean
Const FVF_LVERTEX = (D3DFVF_XYZ Or D3DFVF_TEX1)
Private Type LITVERTEX
X As Single
Y As Single
Z As Single
tU As Single
tV As Single
End Type
Dim CubeVerts(0 To 35) As LITVERTEX ' para nuestro cubo
Dim vbCube As Direct3DVertexBuffer8 ' el buffer de vertices para nuestro cubo
Dim matProj As D3DMATRIX ' matrices que nos ayudaran en los calculos
Dim matView As D3DMATRIX
Dim matWorld As D3DMATRIX
Dim textura As Direct3DTexture8
Const PI = 3.14159
Const RAD = PI / 180
Const DEG = 180 / PI
' InicializarDX
Public Function InicializarDX(hwnd As Long) As Boolean
On Error GoTo ErrHandler:
Dim DispMode As D3DDISPLAYMODE ' describe nuestro modo de visualizacion
Dim tmpDispMode As D3DDISPLAYMODE ' variable temporal
Dim D3DWindow As D3DPRESENT_PARAMETERS ' describe nuestro Viewport
Dim I As Long ' para el ciclo de recorrido en los modos
Set Dx = New DirectX8
Set D3D = Dx.Direct3DCreate() ' creamos una interface 3D
'#######################
'## PANTALLA COMPLETA #
'#######################
For I = 0 To D3D.GetAdapterModeCount(0) - 1 ' lista los modos del adaptador primario en l debugger
D3D.EnumAdapterModes 0, I, tmpDispMode
Debug.Print tmpDispMode.Width & " x " & tmpDispMode.Height & " x " & tmpDispMode.Format
Next I
DispMode.Format = CheckDisplayMode(640, 480, 32)
Debug.Print "CHECKDISP(640,480,32) = ", DispMode.Format, D3DFMT_UNKNOWN
If DispMode.Format > D3DFMT_UNKNOWN Then
'640x480x32 si se soporta
Debug.Print "USANDO Modo 640x480x32"
DispMode.Width = 640: DispMode.Height = 480
Else
DispMode.Format = CheckDisplayMode(640, 480, 16)
If DispMode.Format > D3DFMT_UNKNOWN Then
'640x480x16 si se soporta
Debug.Print "USANDO modo 640x480x16"
DispMode.Width = 640: DispMode.Height = 480
Else
' hmm... tienes una tarjeta de video extraña
MsgBox "Tu hardware no parece soportar el modo de video:" _
& " 640x480 pixels con 16 bit o 32 bit de color. Terminando..." _
, vbInformation, "Error"
Unload Me
End
End If
End If
D3DWindow.BackBufferCount = 1
D3DWindow.Windowed = False
D3DWindow.BackBufferFormat = DispMode.Format
D3DWindow.BackBufferWidth = DispMode.Width
D3DWindow.BackBufferHeight = DispMode.Height
D3DWindow.hDeviceWindow = hwnd ' aqui va nuestra ventana
D3DWindow.AutoDepthStencilFormat = D3DFMT_D16
D3DWindow.EnableAutoDepthStencil = True
D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
' aqui creamos nuestro dispositivo 3D
Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _
hwnd, _
D3DCREATE_SOFTWARE_VERTEXPROCESSING, _
D3DWindow)
InicializarDX = True ' exito
Exit Function
ErrHandler:
Debug.Print "Codigo de error: " & Err.Number, Err.Description
InicializarDX = False
End Function
Public Sub Render()
' limpiamos el backbuffer y tambien el Z buffer
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, D3DColorRGBA(30, 30, 30, 255), 1#, 0
D3DDevice.BeginScene
' aqui especificamos como se renderizan las texturas,
' en este caso para la stage 0 que es la que estamos
' utilizando. escogemos la textura a utilizar:
D3DDevice.SetTexture 0, textura
' indicamos que el color se toma desde el argumento 1
D3DDevice.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_SELECTARG1
' indicamos que el argumento 1 es la textura
D3DDevice.SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
D3DDevice.SetVertexShader FVF_LVERTEX
'## METODO DE RENDERIZACION 2 ##
'## este metodo usa el buffer de vertices sin indices
D3DDevice.SetStreamSource 0, vbCube, Len(CubeVerts(0))
D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 12
D3DDevice.EndScene
' Presentamos los resultados(flip)
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
Private Sub InicializaEscena()
' configuramos nuestro dispositivo
D3DDevice.SetVertexShader FVF_LVERTEX ' indicamos que tipo de vertice estamos usando
D3DDevice.SetRenderState D3DRS_LIGHTING, False ' deshabilitamos iluminacion
D3DDevice.SetRenderState D3DRS_ZENABLE, True ' habilitamos el Z-buffer
D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE ' especificamos NO ocultamiento
' las siguientes dos lineas especifican que filtro
' se utilizan para el manejo de texturas, el especificado
' D3DTEXF_LINEAR da un mejor aspecto, pero disminuye
' el perfomance, puedes utilizar D3DTEXF_POINT que tiene
' menos calidad pero es mas rapido
D3DDevice.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
D3DDevice.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
Set textura = Dx8.CreateTextureFromFile(D3DDevice, App.Path + "\textura.bmp")
If textura Is Nothing Then Exit Sub
'configuramos las matrices
' la World Matrix
D3DXMatrixIdentity matWorld
D3DDevice.SetTransform D3DTS_WORLD, matWorld 'commit this matrix to the device
' la matriz de vista
D3DXMatrixLookAtLH matView, MakeVector(0, 5, 0), MakeVector(0, 0, 0), MakeVector(0, 0, 1)
D3DDevice.SetTransform D3DTS_VIEW, matView
' matriz de proyeccion
D3DXMatrixPerspectiveFovLH matProj, PI / 3, 1, 0.1, 75
D3DDevice.SetTransform D3DTS_PROJECTION, matProj
' definimos los vertices del cubo
'top
CubeVerts(0) = CreateLitVertex(-1, 1, -1, 0, 1#)
CubeVerts(1) = CreateLitVertex(1, 1, -1, 1#, 1#)
CubeVerts(2) = CreateLitVertex(-1, 1, 1, 0, 0)
CubeVerts(3) = CreateLitVertex(1, 1, -1, 1#, 1#)
CubeVerts(4) = CreateLitVertex(1, 1, 1, 1#, 0)
CubeVerts(5) = CreateLitVertex(-1, 1, 1, 0, 0)
'bottom
CubeVerts(6) = CreateLitVertex(-1, -1, -1, 0, 1#)
CubeVerts(7) = CreateLitVertex(1, -1, -1, 1#, 1#)
CubeVerts(8) = CreateLitVertex(-1, -1, 1, 0, 0)
CubeVerts(9) = CreateLitVertex(1, -1, -1, 1#, 1#)
CubeVerts(10) = CreateLitVertex(1, -1, 1, 1#, 0)
CubeVerts(11) = CreateLitVertex(-1, -1, 1, 0, 0)
'left
CubeVerts(12) = CreateLitVertex(-1, 1, -1, 1, 0)
CubeVerts(13) = CreateLitVertex(-1, 1, 1, 0, 0)
CubeVerts(14) = CreateLitVertex(-1, -1, -1, 1, 1)
CubeVerts(15) = CreateLitVertex(-1, 1, 1, 0, 0)
CubeVerts(16) = CreateLitVertex(-1, -1, 1, 0, 1)
CubeVerts(17) = CreateLitVertex(-1, -1, -1, 1, 1)
'right
CubeVerts(18) = CreateLitVertex(1, 1, -1, 1, 0)
CubeVerts(19) = CreateLitVertex(1, 1, 1, 0, 0)
CubeVerts(20) = CreateLitVertex(1, -1, -1, 1, 1)
CubeVerts(21) = CreateLitVertex(1, 1, 1, 0, 0)
CubeVerts(22) = CreateLitVertex(1, -1, 1, 0, 1)
CubeVerts(23) = CreateLitVertex(1, -1, -1, 1, 1)
'front
CubeVerts(24) = CreateLitVertex(-1, 1, 1, 0, 0)
CubeVerts(25) = CreateLitVertex(1, 1, 1, 1, 0)
CubeVerts(26) = CreateLitVertex(-1, -1, 1, 0, 1)
CubeVerts(27) = CreateLitVertex(1, 1, 1, 1, 0)
CubeVerts(28) = CreateLitVertex(1, -1, 1, 1, 1)
CubeVerts(29) = CreateLitVertex(-1, -1, 1, 0, 1)
'back
CubeVerts(30) = CreateLitVertex(-1, 1, -1, 0, 0)
CubeVerts(31) = CreateLitVertex(1, 1, -1, 1, 0)
CubeVerts(32) = CreateLitVertex(-1, -1, -1, 0, 1)
CubeVerts(33) = CreateLitVertex(1, 1, -1, 1, 0)
CubeVerts(34) = CreateLitVertex(1, -1, -1, 1, 1)
CubeVerts(35) = CreateLitVertex(-1, -1, -1, 0, 1)
' creamos el buffer de vertices del cubo
Set vbCube = D3DDevice.CreateVertexBuffer(Len(CubeVerts(0)) * 36, D3DUSAGE_WRITEONLY, FVF_LVERTEX, D3DPOOL_MANAGED)
If vbCube Is Nothing Then Debug.Print "ERROR: no se pudo crear el buffer de vertices": Exit Sub
D3DVertexBuffer8SetData vbCube, 0, Len(CubeVerts(0)) * 36, 0, CubeVerts(0)
End Sub
Private Function CreateLitVertex(X As Single, Y As Single, Z As Single, tU As Single, tV As Single) As LITVERTEX
CreateLitVertex.X = X
CreateLitVertex.Y = Y
CreateLitVertex.Z = Z
CreateLitVertex.tU = tU
CreateLitVertex.tV = tV
End Function
Private Function MakeVector(X As Single, Y As Single, Z As Single) As D3DVECTOR
MakeVector.X = X: MakeVector.Y = Y: MakeVector.Z = Z
End Function
Private Function CheckDisplayMode(Width As Long, Height As Long, Depth As Long) As CONST_D3DFORMAT
Dim I As Long
Dim DispMode As D3DDISPLAYMODE
For I = 0 To D3D.GetAdapterModeCount(0) - 1
D3D.EnumAdapterModes 0, I, DispMode
If DispMode.Width = Width Then
If DispMode.Height = Height Then
If DispMode.Format = D3DFMT_R5G6B5 Or D3DFMT_X1R5G5B5 Or D3DFMT_X4R4G4B4 Then
'16 bit mode
If Depth = 16 Then
CheckDisplayMode = DispMode.Format
Exit Function
End If
ElseIf DispMode.Format = D3DFMT_R8G8B8 Or D3DFMT_X8R8G8B8 Then
'32bit mode
If Depth = 32 Then
CheckDisplayMode = DispMode.Format
Exit Function
End If
End If
End If
End If
Next I
CheckDisplayMode = D3DFMT_UNKNOWN
End Function
Private Sub Form_Click()
BanderaDeSalida = False
End Sub
Private Sub Form_Load()
Dim matTemp As D3DMATRIX
Me.Show 'nos aseguramos que nuestra ventana es visible
BanderaDeSalida = InicializarDX(FrmMain.hwnd)
InicializaEscena
Anglex = 0
Angley = 0
Anglez = 0
Do While BanderaDeSalida
D3DXMatrixIdentity matWorld
D3DXMatrixIdentity matTemp
D3DXMatrixRotationX matTemp, Anglex * RAD
D3DXMatrixMultiply matWorld, matWorld, matTemp
D3DXMatrixIdentity matTemp
D3DXMatrixRotationY matTemp, Angley * RAD
D3DXMatrixMultiply matWorld, matWorld, matTemp
D3DXMatrixIdentity matTemp
D3DXMatrixRotationZ matTemp, Anglez * RAD
D3DXMatrixMultiply matWorld, matWorld, matTemp
D3DDevice.SetTransform D3DTS_WORLD, matWorld
Render ' realizamos un nuevo frame
DoEvents ' tiempo para que Windows "Piense"
Loop 'proximo frame
' borramos y destruimos los objetos creaos
On Error Resume Next
Set textura = Nothing
'Set dx8 = Nothing
Set D3DDevice = Nothing
Set D3D = Nothing
Set Dx = Nothing
' fin
Unload Me
End
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Anglex = Y / 2
Anglez = -X / 2
End Sub
Bueno... con esto hacemos un cubo con textura metalica que gura junto con el mouse en pantalla completa usando el directx.
Fuente: http://www.geocities.com/oswaldovarela/inicial.htm
PD: tratar con mucho cuidado esta web porque geocities cierra el host cuando la visitan mucho por unas horas.
Creo que con esto ya pueden empezar a crear sus propios juegos en 3D