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的显示模式,程序将退出" End End If
On Error Resume Next '首先尝试建立硬件3维设备对象(HAL) Set Direct3DDevice = d3d.CreateDevice("IID_IDirect3DHALDevice", BackBuffer) '如果Direct3DDevice为Nothing说明显示卡不支持硬件Direct3D设备 '尝试建立RGB3维设备。 If Direct3DDevice Is Nothing Then Set Direct3DDevice = d3d.CreateDevice("IID_IDirect3DRGBDevice", BackBuffer) End If
'保存对视角的设置 With ViewPortRect(0) .X1 = 0: .Y1 = 0 .X2 = VPDesc.lWidth .Y2 = VPDesc.lHeight End With iViewSize = 4 End Sub
'InitDeviceObjects函数建立三维物体 Private Sub InitDeviceObjects()
'建立立方体的顶点数据 CreateCube g_vCube
'通过位图文件建立三个纹理表面 Set TextureSurface1 = CreateTextureSurface("t1.bmp") Set TextureSurface2 = CreateTextureSurface("t2.bmp") Set TextureSurface3 = CreateTextureSurface("t3.bmp")