强制变量声名

1、'*Option Explicit '强制变量声名Dim xAngle As GLfloat '正方体绕X轴旋转的角度Dim yAngle As GLfloat '正方体绕Y轴旋转的角度Dim zAngle As GLfloat '正方体绕Z轴旋转的角度Private Sub cmdBack_Click() CameraBack '视点:后退End SubPrivate Sub cmdDown_Click() Tilt_Camera_Down '视点:俯视End SubPrivate Sub cmdForward_Click() Came

2、raForward '视点:前进End SubPrivate Sub cmdLeft_Click() CameraLeft '视点:左转End SubPrivate Sub cmdRight_Click() CameraRight '视点:右转End SubPrivate Sub cmdUp_Click() Tilt_Camera_Up '视点:仰视End SubPrivate Sub Form_Load() Dim hGLRC As Long Dim fAspect As GLfloat Call InitializeArrays '初始化程序 xAn

3、gle = 0 yAngle = 0 zAngle = 0 SetupPixelFormat hDC '设置DC(设备描述表)的像素模式 hGLRC = wglCreateContext(hDC) '创建RC(渲染描述表) wglMakeCurrent hDC, hGLRC '将DC设置为当前RC相关联的设备描述表（一个线程只允许一个RC） glEnable GL_DEPTH_TEST '使深度测试有效 glEnable GL_DITHER '开启颜色抖动 glDepthFunc GL_LESS '简单测试（只比较Z值） glClearDepth

4、 1 '清除深度缓存，都设置为1（最远处） glClearColor 0, 0, 0, 0 '设置清屏颜色 glMatrixMode GL_PROJECTION '设置当前操作的矩阵堆栈为投影的（即为三维到二维屏幕的投影方式） glLoadIdentity '将当前矩阵置为单位矩阵 If frmMain.ScaleHeight > 0 Then fAspect = frmMain.ScaleWidth / frmMain.ScaleHeight Else fAspect = 0 End If gluPerspective 60, fAspect, 1, 2

5、000 '定义透视矩阵（角度，长宽比，视点与两个裁平面的距离near,far) glViewport 0, 0, frmMain.ScaleWidth, frmMain.ScaleHeight '定义视区（要画的区域，一般为整个窗口） glMatrixMode GL_MODELVIEW '设置当前操作的矩阵堆栈为视图的（即为场景） glLoadIdentity '单位化 glLightfv GL_LIGHT0, GL_POSITION, LightPos(0) '设置0光源的位置 glEnable GL_LIGHTING '开启光照 glEnab

6、le GL_LIGHT0 '打开0光源 glShadeModel GL_SMOOTH '设置颜色过渡模式为平滑 glFrontFace GL_CCW '设置顶点逆时针顺序的多边形为前表面 glEnable GL_COLOR_MATERIAL glColorMaterial GL_FRONT, GL_AMBIENT_AND_DIFFUSE glMaterialfv GL_FRONT, GL_SPECULAR, SpecRef(0) '设置前表面的材质：镜面反光颜色 glMateriali GL_FRONT, GL_SHININESS, 50 '设置前表面的

7、材质：镜面反光参数'* 'BuildCube '画正方体 BuildTriangle '画sierpinski三角形'* BuildGrid '画网格 Form_Paint '画窗口End SubPrivate Sub Form_Paint() Dim i As Integer Dim a As Integer Dim b As Integer Dim c As Integer glLoadIdentity '单位化 '定义观察方向 gluLookAt m_Translate_X, m_Translate_Y, m_Tra

8、nslate_Z, m_Translate_X + (100# * (Cos(m_camera_radsFromEast), m_Translate_Y + m_camera_direction_y, m_Translate_Z - (100# * Sin(m_camera_radsFromEast), 0#, 1#, 0# glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT '清除颜色缓存和深度缓存 glPushMatrix '当前矩阵压栈 glTranslatef 0, 0, -3 '平移 glRotatef xAn

9、gle, 0.1, 0, 0 '旋转 glRotatef yAngle, 0, 0.1, 0 glRotatef zAngle, 0, 0, 1 '* glCallList m_triangle '调用画sierpinski三角形的显示列表 '* glPopMatrix '弹出当前栈顶矩阵 glPushMatrix glTranslatef 0, -2, 0 DisplayGrid '画网格 glPopMatrix SwapBuffers hDC '交换帧缓存 End SubPrivate Sub Form_Resize() glView

10、port 0, 0, frmMain.ScaleWidth, frmMain.ScaleHeight '定义视区（要画的区域，一般为整个窗口） Form_Paint '画窗口End SubPrivate Sub Form_Unload(Cancel As Integer) If hGLRC <> 0 Then wglMakeCurrent 0, 0 '御载RC和DC wglDeleteContext hGLRC '删除RC End If If hPalette <> 0 Then DeleteObject hPalette '删除

11、调色板 End IfEnd Sub'*'画sierpinski三角形，并生成显示列表 索引为 m_triangleSub BuildTriangle()m_triangle = glGenLists(1)glNewList m_triangle, lstCompileAndExecute Drawscene 2.19, -0.7, -0.5, -0.9, 2.398, -0.5, -0.9, -0.7, 2.598, -2.4, -2.2, -2, 3glEndListEnd Sub'*'画正方体Sub BuildCube() Dim i As Integer

12、Dim a As Integer Dim b As Integer Dim c As Integer m_Cube = glGenLists(1) '得到一个未使用有显示列表索引 glNewList m_Cube, GL_COMPILE_AND_EXECUTE '显示列表执行并保存 For i = 0 To TRIANGLE_COUNT - 1 a = index(i, 0) b = index(i, 1) c = index(i, 2) Call RenderTriangle(a, b, c) Next glEnd glEndListEnd SubSub BuildGrid(

13、) Dim r As Integer Dim c As Integer Dim nStep As Integer nStep = 5 glPushMatrix m_Grid = glGenLists(1) '得到一个未使用有显示列表索引 glNewList m_Grid, GL_COMPILE '显示列表保存,不执行 glBegin (GL_LINES) For r = -50 To 50 Step nStep glVertex3f r, 0#, -50# glVertex3f r, 0#, 50# Next For c = -50 To 50 Step nStep glVer

14、tex3f 50#, 0#, c glVertex3f -50#, 0#, c Next glEnd glEndList glPopMatrixEnd SubSub DisplayGrid() glPushAttrib GL_LIGHTING '压入光照的属性堆栈 glDisable GL_LIGHTING '关闭光照 glPushMatrix glColor3ub 0, 255, 0 '设置当前颜色 'Bottom glCallList m_Grid '执行显示列表(索引为m_Grid) '/*Back*/ glPushMatrix glTra

15、nslatef 0#, 50#, -50# glPushMatrix glRotatef 90#, 1#, 0#, 0# '旋转 glCallList m_Grid '执行显示列表(索引为m_Grid) glPopMatrix glPopMatrix '/*Front*/ glPushMatrix glTranslatef 0#, 50#, 50# glPushMatrix glRotatef 90#, 1#, 0#, 0# glCallList m_Grid glPopMatrix glPopMatrix '/*Left Side*/ glPushMatrix

16、 glTranslatef -50#, 50#, 0# glPushMatrix glRotatef 90, 0#, 0#, 1# glCallList m_Grid glPopMatrix glPopMatrix '/*Right Side*/ glPushMatrix glTranslatef 50#, 50#, 0# glPushMatrix glRotatef 90, 0#, 0#, 1# glCallList m_Grid glPopMatrix glPopMatrix glPopMatrix glPopAttrib glEnable GL_LIGHTING '开启光

17、照End SubSub MoveCamera(dStep As Double) '移动照相机（即移动视点） Dim xChange As Double Dim zChange As Double xChange = dStep * Cos(m_camera_radsFromEast) zChange = -dStep * Sin(m_camera_radsFromEast) If (m_Translate_X < 40 + xChange) And (m_Translate_X + xChange) > -40) Then m_Translate_X = m_Transla

18、te_X + xChange Else m_Translate_X = m_Translate_X - xChange End If If (m_Translate_Z + zChange) < 40 And (m_Translate_Z + zChange) > -40) Then m_Translate_Z = m_Translate_Z + zChange Else m_Translate_Z = m_Translate_Z - zChange End If End SubPrivate Sub CameraLeft() m_camera_radsFromEast = m_c

19、amera_radsFromEast + (10# / 180# * 3.142) If (m_camera_radsFromEast > (6.28) Then m_camera_radsFromEast = 0# End If Form_PaintEnd Sub Private Sub CameraRight() m_camera_radsFromEast = m_camera_radsFromEast - (10# / 180# * 3.142) If (m_camera_radsFromEast < 0#) Then m_camera_radsFromEast = 6.28

20、 End If Form_Paint '重画End SubPrivate Sub CameraForward() Call MoveCamera(m_translationUnit) Form_PaintEnd SubPrivate Sub CameraBack() Call MoveCamera(-1# * m_translationUnit) Form_Paint '重画End SubPrivate Sub Tilt_Camera_Up() m_camera_direction_y = m_camera_direction_y + 10 Form_PaintEnd SubS

21、ub Tilt_Camera_Down() m_camera_direction_y = m_camera_direction_y - 10 Form_Paint '重画End SubPrivate Sub ScrollPitch_Change() xAngle = ScrollPitch.Value Form_PaintEnd SubPrivate Sub ScrollPitch_Scroll() xAngle = ScrollPitch.Value Form_PaintEnd SubPrivate Sub ScrollYaw_Change() yAngle = ScrollYaw.

22、Value Form_PaintEnd SubPrivate Sub ScrollYaw_Scroll() yAngle = ScrollYaw.Value Form_PaintEnd SubOption ExplicitPrivate Type PALETTEENTRY peRed As Byte peGreen As Byte peBlue As Byte peFlags As ByteEnd TypePrivate Type LOGPALETTE palVersion As Integer palNumEntries As Integer palPalEntry(0 To 255) As

23、 PALETTEENTRYEnd TypePrivate Type PIXELFORMATDESCRIPTOR nSize As Integer nVersion As Integer dwFlags As Long iPixelType As Byte cColorBits As Byte cRedBits As Byte cRedShift As Byte cGreenBits As Byte cGreenShift As Byte cBlueBits As Byte cBlueShift As Byte cAlphaBits As Byte cAlphaShift As Byte cAc

24、cumBits As Byte cAccumRedBits As Byte cAccumGreenBits As Byte cAccumBlueBits As Byte cAccumAlpgaBits As Byte cDepthBits As Byte cStencilBits As Byte cAuxBuffers As Byte iLayerType As Byte bReserved As Byte dwLayerMask As Long dwVisibleMask As Long dwDamageMask As LongEnd TypeConst PFD_TYPE_RGBA = 0C

25、onst PFD_TYPE_COLORINDEX = 1Const PFD_MAIN_PLANE = 0Const PFD_DOUBLEBUFFER = 1Const PFD_DRAW_TO_WINDOW = &H4Const PFD_SUPPORT_OPENGL = &H20Const PFD_NEED_PALETTE = &H80Private Declare Function ChoosePixelFormat Lib "gdi32" (ByVal hDC As Long, pfd As PIXELFORMATDESCRIPTOR) As Lo

26、ngPrivate Declare Function CreatePalette Lib "gdi32" (pPal As LOGPALETTE) As LongPrivate Declare Sub DeleteObject Lib "gdi32" (hObject As Long)Private Declare Sub DescribePixelFormat Lib "gdi32" (ByVal hDC As Long, ByVal PixelFormat As Long, ByVal nBytes As Long, pfd As

27、 PIXELFORMATDESCRIPTOR)Private Declare Function GetDC Lib "gdi32" (ByVal hWnd As Long) As LongPrivate Declare Function GetPixelFormat Lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Sub GetSystemPaletteEntries Lib "gdi32" (ByVal hDC As Long, ByVal start As Long,

28、ByVal entries As Long, ByVal ptrEntries As Long)Private Declare Sub RealizePalette Lib "gdi32" (ByVal hPalette As Long)Private Declare Sub SelectPalette Lib "gdi32" (ByVal hDC As Long, ByVal hPalette As Long, ByVal bln As Long)Private Declare Function SetPixelFormat Lib "gdi

29、32" (ByVal hDC As Long, ByVal i As Long, pfd As PIXELFORMATDESCRIPTOR) As BooleanPrivate Declare Sub SwapBuffers Lib "gdi32" (ByVal hDC As Long)Private Declare Function wglCreateContext Lib "OpenGL32" (ByVal hDC As Long) As LongPrivate Declare Sub wglDeleteContext Lib "

30、OpenGL32" (ByVal hContext As Long)Private Declare Sub wglMakeCurrent Lib "OpenGL32" (ByVal l1 As Long, ByVal l2 As Long)Public hPalette As LongPublic hGLRC As LongPublic LightPos(3) As GLfloat '光源位置Public SpecRef(3) As GLfloatPublic Diffuse(3) As GLfloatPublic Const TRIANGLE_COUNT

31、 = 12Public vdata(23, 2) As GLfloatPublic vcolor(23, 2) As GLfloatPublic index(TRIANGLE_COUNT, 3) As GLfloatPublic m_Grid As IntegerPublic m_Cube As IntegerPublic m_Translate_X As IntegerPublic m_Translate_Y As IntegerPublic m_Translate_Z As IntegerPublic m_camera_radsFromEast As GLfloatPublic m_tra

32、nslationUnit As DoublePublic m_camera_direction_y As IntegerPublic m_triangle As Integer'发生错误时，可调用此函数参数为错误信息Sub FatalError(ByVal strMessage As String) MsgBox "Fatal Error: " & strMessage, vbCritical + vbApplicationModal + vbOKOnly + vbDefaultButton1, "Fatal Error In " &am

33、p; App.Title Unload frmMain Set frmMain = Nothing EndEnd Sub'设置像素格式PIXELFORMATDESCRIPTOR为一个结构体作为API参数设置Opengl绘图所需的像素格式Sub SetupPixelFormat(ByVal hDC As Long) Dim pfd As PIXELFORMATDESCRIPTOR Dim PixelFormat As Integer pfd.nSize = Len(pfd) pfd.nVersion = 1 pfd.dwFlags = PFD_SUPPORT_OPENGL Or PFD_

34、DRAW_TO_WINDOW Or PFD_DOUBLEBUFFER Or PFD_TYPE_RGBA pfd.iPixelType = PFD_TYPE_RGBA pfd.cColorBits = 24 pfd.cDepthBits = 24 pfd.iLayerType = PFD_MAIN_PLANE PixelFormat = ChoosePixelFormat(hDC, pfd) If PixelFormat = 0 Then FatalError "Could not retrieve pixel format!" SetPixelFormat hDC, Pix

35、elFormat, pfdEnd Sub'创建调色板Sub SetupPalette(ByVal lhDC As Long) Dim PixelFormat As Long Dim pfd As PIXELFORMATDESCRIPTOR Dim pPal As LOGPALETTE Dim PaletteSize As Long PixelFormat = GetPixelFormat(lhDC) DescribePixelFormat lhDC, PixelFormat, Len(pfd), pfd If (pfd.dwFlags And PFD_NEED_PALETTE) <

36、;> 0 Then PaletteSize = 2 pfd.cColorBits Else Exit Sub End If pPal.palVersion = &H300 pPal.palNumEntries = PaletteSize Dim redMask As Long Dim GreenMask As Long Dim BlueMask As Long Dim i As Long redMask = 2 pfd.cRedBits - 1 GreenMask = 2 pfd.cGreenBits - 1 BlueMask = 2 pfd.cBlueBits - 1 For

37、i = 0 To PaletteSize - 1 With pPal.palPalEntry(i) .peRed = i .peGreen = i .peBlue = i .peFlags = 0 End With Next GetSystemPaletteEntries frmMain.hDC, 0, 256, VarPtr(pPal.palPalEntry(0) hPalette = CreatePalette(pPal) If hPalette <> 0 Then SelectPalette lhDC, hPalette, False RealizePalette lhDC

38、End IfEnd Sub'初始化数组Public Sub InitializeArrays() m_Translate_X = 0 m_Translate_Z = 5 m_translationUnit = 1 m_camera_direction_y = 0 m_camera_radsFromEast = 1.56 LightPos(0) = 0 LightPos(1) = 2 LightPos(2) = 2 LightPos(3) = 1 SpecRef(0) = 1# SpecRef(1) = 0# SpecRef(2) = 0# SpecRef(3) = 1# 'Fr

39、ont (0-3) vdata(0, 0) = 1 vdata(0, 1) = 1 vdata(0, 2) = 1 vdata(1, 0) = 1 vdata(1, 1) = -1 vdata(1, 2) = 1 vdata(2, 0) = -1 vdata(2, 1) = -1 vdata(2, 2) = 1 vdata(3, 0) = -1 vdata(3, 1) = 1 vdata(3, 2) = 1 'back (4-7) vdata(4, 0) = 1# vdata(4, 1) = 1# vdata(4, 2) = -1# vdata(5, 0) = 1# vdata(5,

40、1) = -1# vdata(5, 2) = -1# vdata(6, 0) = -1# vdata(6, 1) = -1# vdata(6, 2) = -1# vdata(7, 0) = -1# vdata(7, 1) = 1# vdata(7, 2) = -1# 'right (8-11) vdata(8, 0) = 1# vdata(8, 1) = 1# vdata(8, 2) = 1# vdata(9, 0) = 1# vdata(9, 1) = 1# vdata(9, 2) = -1# vdata(10, 0) = 1# vdata(10, 1) = -1# vdata(10

41、, 2) = -1# vdata(11, 0) = 1# vdata(11, 1) = -1# vdata(11, 2) = 1# 'left (12-15) vdata(12, 0) = -1# vdata(12, 1) = 1# vdata(12, 2) = 1# vdata(13, 0) = -1# vdata(13, 1) = 1# vdata(13, 2) = -1# vdata(14, 0) = -1# vdata(14, 1) = -1# vdata(14, 2) = -1# vdata(15, 0) = -1# vdata(15, 1) = -1# vdata(15,

42、2) = 1# 'Top (16-20) vdata(16, 0) = 1# vdata(16, 1) = 1# vdata(16, 2) = 1# vdata(17, 0) = 1# vdata(17, 1) = 1# vdata(17, 2) = -1# vdata(18, 0) = -1# vdata(18, 1) = 1# vdata(18, 2) = -1# vdata(19, 0) = -1# vdata(19, 1) = 1# vdata(19, 2) = 1# 'Botton vdata(20, 0) = 1# vdata(20, 1) = -1# vdata(

43、20, 2) = 1# vdata(21, 0) = 1# vdata(21, 1) = -1# vdata(21, 2) = -1# vdata(22, 0) = -1# vdata(22, 1) = -1# vdata(22, 2) = -1# vdata(23, 0) = -1# vdata(23, 1) = -1# vdata(23, 2) = 1# 'Index 'front index(0, 0) = 0 index(0, 1) = 1 index(0, 2) = 2 index(1, 0) = 0 index(1, 1) = 2 index(1, 2) = 3 &

44、#39;Back index(2, 0) = 4 index(2, 1) = 6 index(2, 2) = 5 index(3, 0) = 4 index(3, 1) = 7 index(3, 2) = 6 'Right index(4, 0) = 8 index(4, 1) = 9 index(4, 2) = 10 index(5, 0) = 8 index(5, 1) = 10 index(5, 2) = 11 'Left index(6, 0) = 12 index(6, 1) = 14 index(6, 2) = 13 index(7, 0) = 12 index(7

45、, 1) = 15 index(7, 2) = 14 'Top index(8, 0) = 16 index(8, 1) = 18 index(8, 2) = 17 index(9, 0) = 16 index(9, 1) = 19 index(9, 2) = 18 'Bottom index(10, 0) = 20 index(10, 1) = 21 index(10, 2) = 22 index(11, 0) = 20 index(11, 1) = 22 index(11, 2) = 23 'Color 'front vcolor(0, 0) = 1 vco

46、lor(0, 1) = 1 vcolor(0, 2) = 1 vcolor(1, 0) = 1 vcolor(1, 1) = 0 vcolor(1, 2) = 1 vcolor(2, 0) = 0 vcolor(2, 1) = 0 vcolor(2, 2) = 1 vcolor(3, 0) = 0 vcolor(3, 1) = 1 vcolor(3, 2) = 1 'back vcolor(4, 0) = 1# vcolor(4, 1) = 1# vcolor(4, 2) = 0# vcolor(5, 0) = 1# vcolor(5, 1) = 0# vcolor(5, 2) = 0

47、# vcolor(6, 0) = 0# vcolor(6, 1) = 0# vcolor(6, 2) = 0# vcolor(7, 0) = 0# vcolor(7, 1) = 1# vcolor(7, 2) = 0# 'right vcolor(8, 0) = 1# vcolor(8, 1) = 1# vcolor(8, 2) = 1# vcolor(9, 0) = 1# vcolor(9, 1) = 1# vcolor(9, 2) = 0# vcolor(10, 0) = 1# vcolor(10, 1) = 0# vcolor(10, 2) = 0# vcolor(11, 0) = 1# vcolor(11, 1) = 0# vcolor(11, 2) = 1# 'left vcolor(12, 0) = 0# vcolor(12, 1) = 0.1 vcolor(12, 2) = 1# vcolor(13, 0) = 0# vcolor(13, 1) = 1# vcolor(13, 2) = 0# vcolor(14, 0) = 0# vcolor(14, 1) = 0# vcolor(14, 2) = 0# vcolor(15, 0) = 0# vcolor(