VERSION 5.00
Begin VB.Form Form1
Caption = "OpenGL Simple Example"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
PaletteMode = 2 'Custom
ScaleHeight = 213
ScaleMode = 3 'Pixel
ScaleWidth = 312
StartUpPosition = 3 'Windows Default
Begin VB.Timer Timer1
Interval = 1
Left = 120
Top = 120
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Win32 stuff
Private Type PALETTEENTRY
peRed As Byte
peGreen As Byte
peBlue As Byte
peFlags As Byte
End Type
Private Type LOGPALETTE
palVersion As Integer
palNumEntries As Integer
palPalEntry(0 To 255) As PALETTEENTRY
End Type
Private 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
cAccumBits 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 Long
End Type
Const PFD_TYPE_RGBA = 0
Const PFD_TYPE_COLORINDEX = 1
Const PFD_MAIN_PLANE = 0
Const PFD_DOUBLEBUFFER = 1
Const PFD_DRAW_TO_WINDOW = &H4
Const PFD_SUPPORT_OPENGL = &H20
Const PFD_NEED_PALETTE = &H80
Private Declare Function ChoosePixelFormat Lib "gdi32" (ByVal hDC As Long, pfd As PIXELFORMATDESCRIPTOR) As Long
Private Declare Function CreatePalette Lib "gdi32" (pPal As LOGPALETTE) As Long
Private 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 PIXELFORMATDESCRIPTOR)
Private Declare Function GetDC Lib "gdi32" (ByVal hWnd As Long) As Long
Private Declare Function GetPixelFormat Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Sub GetSystemPaletteEntries Lib "gdi32" (ByVal hDC As Long, ByVal start As Long, 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 "gdi32" (ByVal hDC As Long, ByVal i As Long, pfd As PIXELFORMATDESCRIPTOR) As Boolean
Private Declare Sub SwapBuffers Lib "gdi32" (ByVal hDC As Long)
Private Declare Function wglCreateContext Lib "OpenGL32" (ByVal hDC As Long) As Long
Private Declare Sub wglDeleteContext Lib "OpenGL32" (ByVal hContext As Long)
Private Declare Sub wglMakeCurrent Lib "OpenGL32" (ByVal l1 As Long, ByVal l2 As Long)
Dim hPalette As Long
Dim hGLRC As Long
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_DRAW_TO_WINDOW Or PFD_DOUBLEBUFFER Or PFD_TYPE_RGBA
pfd.iPixelType = PFD_TYPE_RGBA
pfd.cColorBits = 16
pfd.cDepthBits = 16
pfd.iLayerType = PFD_MAIN_PLANE
PixelFormat = ChoosePixelFormat(hDC, pfd)
If PixelFormat = 0 Then
MsgBox "ChoosePixelFormat failed"
End
End If
SetPixelFormat hDC, PixelFormat, pfd
End 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) <> 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 i = 0 To PaletteSize - 1
With pPal.palPalEntry(i)
.peRed = i
.peGreen = i
.peBlue = i
.peFlags = 0
End With
Next
GetSystemPaletteEntries hDC, 0, 256, VarPtr(pPal.palPalEntry(0))
hPalette = CreatePalette(pPal)
If hPalette <> 0 Then
SelectPalette lhDC, hPalette, False
RealizePalette lhDC
End If
End Sub
Private Sub Form_Initialize()
Dim hGLRC As Long
SetupPixelFormat hDC
'SetupPalette hDC
hGLRC = wglCreateContext(hDC)
wglMakeCurrent hDC, hGLRC
glMatrixMode GL_PROJECTION
glFrustum -0.5, 0.5, -0.5, 0.5, 1, 3
glMatrixMode GL_MODELVIEW
glTranslatef 0, 0, -2
glRotatef 30, 1, 0, 0
glRotatef 30, 0, 1, 0
glEnable GL_DEPTH_TEST
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glEnable GL_DITHER
End Sub
Private Sub Form_Paint()
glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
glBegin GL_QUADS
glNormal3f 0, 0, 1
glVertex3f 0.5, 0.5, 0.5: glVertex3f -0.5, 0.5, 0.5
glVertex3f 0.5, 0.5, 0.5: glVertex3f -0.5, 0.5, 0.5
glNormal3f 0, 0, -1
glVertex3f -0.5, -0.5, -0.5: glVertex3f -0.5, 0.5, -0.5
glVertex3f 0.5, 0.5, -0.5: glVertex3f 0.5, -0.5, -0.5
glNormal3f 0, 1, 0
glVertex3f 0.5, 0.5, 0.5: glVertex3f 0.5, 0.5, -0.5
glVertex3f -0.5, 0.5, -0.5: glVertex3f -0.5, 0.5, 0.5
glNormal3f 0, -1, 0
glVertex3f -0.5, -0.5, -0.5: glVertex3f 0.5, -0.5, -0.5
glVertex3f 0.5, -0.5, 0.5: glVertex3f -0.5, -0.5, 0.5
glNormal3f 1, 0, 0
glVertex3f 0.5, 0.5, 0.5: glVertex3f 0.5, -0.5, 0.5
glVertex3f 0.5, -0.5, -0.5: glVertex3f 0.5, 0.5, -0.5
glNormal3f -1, 0, 0
glVertex3f -0.5, -0.5, -0.5: glVertex3f -0.5, -0.5, 0.5
glVertex3f -0.5, 0.5, 0.5: glVertex3f -0.5, 0.5, -0.5
glEnd
SwapBuffers hDC
End Sub
Private Sub Form_Resize()
glViewport 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub
Private Sub Form_Unload(Cancel As Integer)
If hGLRC <> 0 Then
wglMakeCurrent 0, 0
wglDeleteContext hGLRC
End If
If hPalette <> 0 Then
DeleteObject hPalette
End If
End Sub
Private Sub Timer1_Timer()
' Addition to the original source
glRotatef 5, 1, 0, 0
glRotatef 5, 0, 1, 0
Form_Paint
End Sub
