bIsRunning = True
Do While bIsRunning = True
RenderScene
FrameMove (CNT / 360), bRoAn
g_dx.GetWindowRect Me.hWnd, g_rcDest
'将后台绘图平面的内容复制到前台
j = MainBuffer.Blt(g_rcDest, BackBuffer, g_rcSrc, DDBLT_WAIT)
If j <> DD_OK Then
MsgBox "无法将后台绘图平面的内容拷贝到前台，错误代码：" & Hex(j)
End
End If
DoEvents
Loop
End Sub
Private Sub FrameMove(stepVal As Single, bType As Boolean)
Dim matView As D3DMATRIX
Dim matTemp As D3DMATRIX
'建立线形矩阵
g_dx.IdentityMatrix matView
' matView.rc11 = Cos(0.5)
' matView.rc12 = Sin(0.5)
' matView.rc21 = Sin(-0.5)
' matView.rc22 = Cos(0.5)
' matView.rc33 = 1
' matView.rc43 = iviewsize
'你可以尝试将下面5句注释掉而使用上面5句进行视矩阵变换，看有什么效果
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
'对视矩阵进行角度变换
Direct3DDevice.SetTransform D3DTRANSFORMSTATE_VIEW, matView
Dim matWorld As D3DMATRIX
g_dx.IdentityMatrix matWorld
If bType Then
g_dx.RotateXMatrix matWorld, stepVal
Else
g_dx.RotateYMatrix matWorld, stepVal
End If
Direct3DDevice.SetTransform D3DTRANSFORMSTATE_WORLD, matWorld
End Sub
'RenderScene函数执行场景重绘和渲染
Private Sub RenderScene()
Dim i As Integer
'将整个视界背景设置为蓝色，并清除Z缓冲
Direct3DDevice.Clear 1, ViewPortRect(), D3DCLEAR_TARGET, &HFF, 1, 0
'开始绘制场景
Direct3DDevice.BeginScene
'将TextureSurface1设置为Direct3DDevice的纹理平面
Direct3DDevice.SetTexture 0, TextureSurface1
'使用TextureSurface1作为纹理绘制g_vCube(0)到g_vCube(3)顶点之间的平面，
Call Direct3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, g_vCube(0), _
4, D3DDP_DEFAULT)
'使用TextureSurface1作为纹理绘制g_vCube(4)到g_vCube(7)顶点之间的平面，
Call Direct3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, g_vCube(4), _
4, D3DDP_DEFAULT)
'将TextureSurface2设置为Direct3DDevice的纹理平面
Direct3DDevice.SetTexture 0, TextureSurface2
'使用TextureSurface2作为纹理绘制g_vCube(8)到g_vCube(11)顶点之间的平面，
Call Direct3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, g_vCube(8), _
4, D3DDP_DEFAULT)
'使用TextureSurface2作为纹理绘制g_vCube(12)到g_vCube(15)顶点之间的平面，
Call Direct3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, g_vCube(12), _
4, D3DDP_DEFAULT)
'将TextureSurface3设置为Direct3DDevice的纹理平面
Direct3DDevice.SetTexture 0, TextureSurface3
'使用TextureSurface3作为纹理绘制g_vCube(16)到g_vCube(19)顶点之间的平面，
Call Direct3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, g_vCube(16), _
4, D3DDP_DEFAULT)
'使用TextureSurface3作为纹理绘制g_vCube(20)到g_vCube(23)顶点之间的平面，
Call Direct3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, g_vCube(20), _
4, D3DDP_DEFAULT)
'结束绘制场景
Direct3DDevice.EndScene
End Sub
Private Sub Form_Unload(Cancel As Integer)
bIsRunning = False
End Sub
'InitDDraw函数初始化DirectDraw对象，包括建立主绘图平面以及后台绘图平面
Private Sub InitDDraw()
'建立DirectDraw对象
Set g_dd = g_dx.DirectDrawCreate("")
'设定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)
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)
'将后台绘图平面的尺寸保存到g_rcSrc中
With g_rcSrc
.Left = 0: .Top = 0
.Bottom = g_ddsd.lHeight
.Right = g_ddsd.lWidth
End With
Dim pcClipper As DirectDrawClipper
Set pcClipper = g_dd.CreateClipper(0)
pcClipper.SetHWnd Me.hWnd
MainBuffer.SetClipper pcClipper
End Sub
'InitD3D函数初始化Direct3D对象，包括3D设备、光源、视角以及材质
Sub InitD3D()
Dim d3d As Direct3D7
Dim ddsd As DDSURFACEDESC2
'从DirectDraw对象中获得Direct3D对象
Set d3d = g_dd.GetDirect3D
'获得DirectDraw对象的显示颜色深度，如果小于16位色，则程序出错退出
g_dd.GetDisplayMode ddsd
If ddsd.ddpfPixelFormat.lRGBBitCount <= 8 Then
MsgBox "本程序不支持颜色位数小于16bit的显示模式，程序将退出"
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
