VB中使用DirectX库的简明教程(8)

'预先定义主绘图平面的属性
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)

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有