分析上面的程序，基本的实现过程大家可能已经有一些基本的了解，首先建立DirectX7对象，然后建立并初始化DirectDraw、再建立Direct3D对象。接下来利用CreateCube函数建立立方体框架，利用InitDeviceObjects函数为Direct3DDevice对象建立纹理、光照效果以及材质，利用RenderScene函数可以将不同的纹理赋予立方体不同的表面并将其绘制在DirectDrawSurface7对象。对于FrameMove函数中的内容可能大家不太了解。在Direct3D场景中有两个不同的坐标系，一个是以Direct3D场景的中心为坐标原点的坐标系，另外一个是以虚拟的观察者为中心的坐标系。在Direct3D世界中的对象的旋转、平移是通过改变对象的坐标系来实现的，D3DMATRIX对象定义了一个4*4的矩阵，Direct3D场景中的某一点到另外一点的变换是使用如下公式来进行的：
展开如下：
其中x'、y'、z'为新坐标。FrameMove函数中的SetTransform方法就是根据D3DMATRIX对象定义的4*4的矩阵进行坐标系变换的函数。另外作者还编写了一个平移对象的FrameMove函数，函数如下：
Private Sub FrameMove(stepVal As Single, bType As Boolean)
Dim matView As D3DMATRIX
Dim matWorld As D3DMATRIX
'建立线形矩阵
g_dx.IdentityMatrix matView
matView.rc11 = 1
matView.rc22 = Cos(-0.5)
matView.rc23 = Sin(-0.5)
matView.rc32 = -Sin(-0.5)
matView.rc33 = Cos(-0.5)
matView.rc43 = iViewSize
If bType Then
g_dx.RotateXMatrix matView, stepVal
Else
g_dx.RotateYMatrix matView, stepVal
End If
Direct3DDevice.SetTransform D3DTRANSFORMSTATE_VIEW, matView
g_dx.IdentityMatrix matWorld
matWorld.rc11 = 1
matWorld.rc22 = Cos(-0.5)
matWorld.rc23 = Sin(-0.5)
matWorld.rc32 = -Sin(-0.5)
matWorld.rc33 = Cos(-0.5)
matWorld.rc43 = iViewSize
Direct3DDevice.SetTransform D3DTRANSFORMSTATE_WORLD, matWorld
End Sub |
你可以将这个函数代入上面的程序运行，程序运行时首先按-键将立方体缩小，然后按动上下左右键看立方体是如何平移的。
接下来介绍Direct3D保留模式对象编程，由于Direct3D保留模式对象比较多而且相对立即模式使用起来比较简单，我们就来直接切入程序。
建立一个新的工程文件，保存文件，为了添加纹理，你需要在工程文件所在目录下建立一个名字为glass.bmp 的位图文件。加入DirectX7说明库，然后在Form1的代码窗口中假如以下代码：
Option Explicit
Dim g_dx As New DirectX7
Dim g_dd As DirectDraw4
Dim pcClipper As DirectDrawClipper
Dim g_ddsd As DDSURFACEDESC2
Dim MainBuffer As DirectDrawSurface4
Dim BackBuffer As DirectDrawSurface4
'Direct3DRM对象
Dim D3DRM As Direct3DRM3
'三维设备对象
Dim RMDevice As Direct3DRMDevice3
'三维视区对象
Dim RMViewPort As Direct3DRMViewport2
'三维场景对象
Dim RMFrameScene As Direct3DRMFrame3
Dim RMFrameCamera As Direct3DRMFrame3
Dim RMFrameDirLight As Direct3DRMFrame3
Dim RMFrameAmbientLight As Direct3DRMFrame3
'光源对象
Dim RMDirLight As Direct3DRMLight
Dim RMAmbientLight As Direct3DRMLight
'Direct3DRMMeshBuilder3对象是提供与mesh对象象交互作用的对象
'一个mesh对象是一个由多个多边形组成德多面体
Dim meshbox As Direct3DRMMeshBuilder3
Dim framebox As Direct3DRMFrame3
Dim g_rcDest As RECT, g_rcSrc As RECT
Sub CleanUp()
Err.Clear
On Local Error Resume Next
Set RMFrameCamera = Nothing
Set RMFrameScene = Nothing
Set RMFrameDirLight = Nothing
Set RMFrameAmbientLight = Nothing
Set RMDirLight = Nothing
Set RMAmbientLight = Nothing
g_dd.RestoreDisplayMode
g_dd.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
Set BackBuffer = Nothing
Set MainBuffer = Nothing
Set g_dd = Nothing
Set RMViewPort = Nothing
Set RMDevice = Nothing
End Sub
Private Sub InitDDraw()
Set RMViewPort = Nothing
Set RMDevice = Nothing
'建立DirectDraw对象
Set g_dd = g_dx.DirectDraw4Create("")
'设定DirectDraw对象的协作模式
g_dd.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
'预先定义主绘图平面的属性
g_ddsd.lFlags = DDSD_CAPS
g_ddsd.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
'建立主绘图平面
Set MainBuffer = g_dd.CreateSurface(g_ddsd)
Set pcClipper = g_dd.CreateClipper(0)
pcClipper.SetHWnd Me.hWnd
MainBuffer.SetClipper pcClipper
g_dx.GetWindowRect Me.hWnd, g_rcDest
g_ddsd.lFlags = DDSD_HEIGHT Or DDSD_WIDTH Or DDSD_CAPS
g_ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_3DDEVICE
g_dx.GetWindowRect Me.hWnd, g_rcDest
g_ddsd.lWidth = g_rcDest.Right - g_rcDest.Left
g_ddsd.lHeight = g_rcDest.Bottom - g_rcDest.Top
'建立后台绘图平面
Set BackBuffer = g_dd.CreateSurface(g_ddsd)
End Sub
'InitS函数设定三维场景
Sub InitS()
Set D3DRM = g_dx.Direct3DRMCreate
'建立三维场景
Set RMFrameScene = D3DRM.CreateFrame(Nothing)
'建立相机
Set RMFrameCamera = D3DRM.CreateFrame(RMFrameScene)
'设置相机位置
RMFrameCamera.SetPosition Nothing, 0, 0, -10
'建立方向光源以及设置亮度
Set RMFrameDirLight = D3DRM.CreateFrame(RMFrameScene)
Set RMDirLight = D3DRM.CreateLightRGB(D3DRMLIGHT_DIRECTIONAL, 1, 1, 1)
'建立环境光源，环境光源的亮度只有方向光源的1/5
Set RMAmbientLight = D3DRM.CreateLightRGB(D3DRMLIGHT_AMBIENT, 0.2, 0.2, 0.2)
'将光源添加到三维场景中
RMFrameDirLight.AddLight RMDirLight
RMFrameScene.AddLight RMAmbientLight
'设置光源位置
RMFrameDirLight.SetPosition Nothing, 5, 5, -5
RMFrameDirLight.LookAt RMFrameScene, Nothing, 0
End Sub
'InitD3DRM函数设定三维设备和视区
Sub InitD3dRM()
Dim f As Direct3DRMFace2
Dim ddsd As DDSURFACEDESC2
Dim r As RECT
Dim D3DTexture As Direct3DRMTexture3
'获得窗口矩形区域
Call g_dx.GetWindowRect(Me.hWnd, r)
ddsd.lWidth = r.Right - r.Left
ddsd.lHeight = r.Bottom - r.Top
ddsd.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_3DDEVICE Or _
DDSCAPS_SYSTEMMEMORY
'在后台绘图平面的基础上建立D3dRMDevice
Set RMDevice = D3DRM.CreateDeviceFromSurface("IID_IDirect3DRGBDevice", _
g_dd, BackBuffer, 0)
'三维设备接管窗口的绘制
RMDevice.HandleActivate 0
RMDevice.HandlePaint Me.hWnd
'建立视区，视区的范围为窗口的范围
Set RMViewPort = D3DRM.CreateViewport(RMDevice, RMFrameCamera, 0, 0, _
ddsd.lWidth, ddsd.lHeight)
'建立高路德渲染
RMDevice.SetQuality D3DRMRENDER_GOURAUD
'建立子场景
Set framebox = D3DRM.CreateFrame(RMFrameScene)
Set meshbox = D3DRM.CreateMeshBuilder
Set D3DTexture = D3DRM.LoadTexture(App.Path + "\glass.bmp")
'为meshbox建立六个平面并设置纹理
Set f = D3DRM.CreateFace()
f.AddVertex 2, 2, -2
f.AddVertex 2, -2, -2
f.AddVertex -2, -2, -2
f.AddVertex -2, 2, -2
f.SetTextureCoordinates 0, 0, 0
f.SetTextureCoordinates 1, 0, 4
f.SetTextureCoordinates 2, 4, 4
f.SetTextureCoordinates 3, 4, 0
f.SetTexture D3DTexture
meshbox.AddFace f
Set f = Nothing
Set f = D3DRM.CreateFace()
f.AddVertex -2, 2, 2
f.AddVertex -2, -2, 2
f.AddVertex 2, -2, 2
f.AddVertex 2, 2, 2
f.SetTextureCoordinates 0, 0, 0
f.SetTextureCoordinates 1, 0, 4
f.SetTextureCoordinates 2, 4, 4
f.SetTextureCoordinates 3, 4, 0
f.SetTexture D3DTexture
meshbox.AddFace f
Set f = Nothing
Set f = D3DRM.CreateFace()
f.AddVertex 2, 2, 2
f.AddVertex 2, -2, 2
f.AddVertex 2, -2, -2
f.AddVertex 2, 2, -2
f.SetTextureCoordinates 0, 0, 0
f.SetTextureCoordinates 1, 0, 4
f.SetTextureCoordinates 2, 4, 4
f.SetTextureCoordinates 3, 4, 0
f.SetTexture D3DTexture
meshbox.AddFace f
Set f = Nothing
Set f = D3DRM.CreateFace()
f.AddVertex -2, -2, 2
f.AddVertex -2, 2, 2
f.AddVertex -2, 2, -2
f.AddVertex -2, -2, -2
f.SetTextureCoordinates 0, 0, 0
f.SetTextureCoordinates 1, 0, 4
f.SetTextureCoordinates 2, 4, 4
f.SetTextureCoordinates 3, 4, 0
f.SetTexture D3DTexture
meshbox.AddFace f
Set f = Nothing
Set f = D3DRM.CreateFace()
f.AddVertex 2, 2, -2
f.AddVertex -2, 2, -2
f.AddVertex -2, 2, 2
f.AddVertex 2, 2, 2
f.SetTextureCoordinates 0, 0, 0
f.SetTextureCoordinates 1, 0, 4
f.SetTextureCoordinates 2, 4, 4
f.SetTextureCoordinates 3, 4, 0
f.SetTexture D3DTexture
meshbox.AddFace f
Set f = Nothing
Set f = D3DRM.CreateFace()
f.AddVertex 2, -2, 2
f.AddVertex -2, -2, 2
f.AddVertex -2, -2, -2
f.AddVertex 2, -2, -2
f.SetTextureCoordinates 0, 0, 0
f.SetTextureCoordinates 1, 0, 4
f.SetTextureCoordinates 2, 4, 4
f.SetTextureCoordinates 3, 4, 0
f.SetTexture D3DTexture
meshbox.AddFace f
Set f = Nothing
meshbox.SetName "Box"
Set f = D3DRM.CreateFace
meshbox.SetName "Color Box"
framebox.SetPosition Nothing, -5, 0, 10
framebox.SetRotation Nothing, 1, 1, 1, 0.05
'分别设置六个平面德颜色
meshbox.GetFace(0).SetColor g_dx.CreateColorRGB(1, 1, 0)
meshbox.GetFace(1).SetColor g_dx.CreateColorRGB(0, 1, 0)
meshbox.GetFace(2).SetColor g_dx.CreateColorRGB(0, 0, 1)
meshbox.GetFace(3).SetColor g_dx.CreateColorRGB(1, 1, 0)
meshbox.GetFace(4).SetColor g_dx.CreateColorRGB(0, 1, 1)
meshbox.GetFace(5).SetColor g_dx.CreateColorRGB(1, 1, 1)
'将立方体对象添加到场景中
framebox.AddVisual meshbox
End Sub
Private Sub Form_Load()
Dim rectMe As RECT
Dim rectEmpty As RECT
Me.Show
Me.ScaleMode = 3
InitS
InitDDraw
InitD3dRM
g_dx.GetWindowRect Me.hWnd, rectMe
While True
DoEvents
'清除视区内德内容
RMViewPort.Clear D3DRMCLEAR_ZBUFFER Or D3DRMCLEAR_TARGET
'重新渲染视区内的场景
RMViewPort.Render RMFrameScene
'更新三维设备
RMDevice.Update
'将后台绘图平面的内容翻转到前台来
Call MainBuffer.Blt(rectMe, BackBuffer, rectEmpty, DDBLT_WAIT)
Wend
End Sub
Private Sub Form_Unload(Cancel As Integer)
CleanUp
End
End Sub |
运行程序，在窗口中就会出现一个立方体，可以看到，相对于使用立即模式，上面的保留模式就简单的多了。首先调用InitS函数建立场景、设置灯光以及相机，然后调用InitDDraw函数建立DirectDraw对象，最后调用InitD3dRM函数建立Direct3D对象以及设备并绘制三维立方体，设置立方体每面的颜色并添加到场景中（演员登场）。如果想让三维对象动起来，可以通过设置三维对象的位置、场景的角度以及相机的角度来分别实现。
|
