Título: Directx 3D en Visual Basic Publicado por: WHK en 12 Mayo 2007, 10:54 am 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 ;D (http://www.subir-imagenes.com/imagenes/c53fba1939.gif) (http://www.subir-imagenes.com/imagenes/c9542334a4.gif) (http://www.subir-imagenes.com/imagenes/559dc84b7c.jpg) Título: Re: Directx 3D en Visual Basic Publicado por: Hans el Topo en 12 Mayo 2007, 11:26 am Estos tutos ya han sido posteados varias veces... el de fuego me da que no es de vb... respecto al code posteado... la etiqueta code es para algo...xD
si te soy sincero... eso no sirve para crear un juego xD Título: Re: Directx 3D en Visual Basic Publicado por: WHK en 12 Mayo 2007, 18:04 pm Ok no sabia. Alguien puede borrar este post porque yo no puedo. Grax.
Título: Re: Directx 3D en Visual Basic Publicado por: vih@dead en 12 Mayo 2007, 19:22 pm eso sirve para hacer graficas de topografia asi como isolineas curvas de nivel etc. relacionado con la ing civil , topografica , geofisica , y afines pero casi ningun ing programa una grafica para ver sus resultados lo hacen en autocad xdd
De todos modos no veo por que borrarlo pero en fin. Título: Re: Directx 3D en Visual Basic Publicado por: ranslsad en 25 Mayo 2007, 01:16 am Yo esto lo vi en un engine, hay varios OCX Y DDL para crear juegos, yo personalmente probe varios...
Busquen en google si estan interesados en este tema! Suerte! Salu2 Ranslsad Título: Re: Directx 3D en Visual Basic Publicado por: satan69 en 30 Mayo 2007, 05:00 am 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 ;D (http://www.subir-imagenes.com/imagenes/c53fba1939.gif) (http://www.subir-imagenes.com/imagenes/c9542334a4.gif) (http://www.subir-imagenes.com/imagenes/559dc84b7c.jpg) salvaje...!!! exelente aporte |