Type Color
R As Double
G As Double
B As Double
End Type
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
Type POINTAPI
x As Long
y As Long
End Type
Type Pos
x As Double
y As Double
Z As Double
End Type
Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Declare Function ChoosePixelFormat Lib "gdi32" (ByVal hDC As Long, pfd As PIXELFORMATDESCRIPTOR) As Long
Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare Function SetPixelFormat Lib "gdi32" (ByVal hDC As Long, ByVal i As Long, pfd As PIXELFORMATDESCRIPTOR) As Boolean
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Declare Sub SwapBuffers Lib "gdi32" (ByVal hDC As Long)
Declare Function wglCreateContext Lib "OpenGL32" (ByVal hDC As Long) As Long
Declare Sub wglDeleteContext Lib "OpenGL32" (ByVal hContext As Long)
Declare Sub wglMakeCurrent Lib "OpenGL32" (ByVal l1 As Long, ByVal l2 As Long)
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
Const PI = 3.14159265358979
Global Center As POINTAPI
Global hGLRC As Long
Global Is_Quiting As Byte
Global KD(256) As Byte
Global Mouse As POINTAPI
Global ScreenMatrics As POINTAPI
Dim CameraAngle As Pos
Dim CameraPosition As Pos
Dim CameraRollDirection As Integer
Dim Texture As Long
Dim TickCount, OldTickCount As Long
Const KeyLookDown = 74
Const KeyLookUp = 75
Const KeyLookLeft = 72
Const KeyLookRight = 76
Const KeyMoveBackward = 40
Const KeyMoveForward = 38
Const KeyMoveLeft = 37
Const KeyMoveRight = 39
Const KeyRollLeft = 188
Const KeyRollRight = 190
Const KeyShoot = 32
Sub Draw_Scene()
Dim x, y, Z As Double
glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
glLoadIdentity
x = Sin(CameraAngle.y * PI / 180)
y = Sin(CameraAngle.x * PI / 180)
Z = Cos(CameraAngle.y * PI / 180)
With CameraPosition
gluLookAt .x, .y, .Z, .x + x, .y + y, .Z + Z, Sin(CameraAngle.Z * PI / 180) * Z, Cos(CameraAngle.Z * PI / 180), Sin((360 - CameraAngle.Z) * PI / 180) * x
End With
glBegin GL_QUADS
'paved street
glNormal3f 0, 1, 0
glColor3f 1, 1, 1
glTexCoord2d 0, 0
glVertex3f 0, 0, -12
glTexCoord2d 0, 1
glVertex3f 0, 0, -33
glTexCoord2d 1, 1
glVertex3f 12, 0, -33
glTexCoord2d 1, 0
glVertex3f 12, 0, -12
glColor3f 1, 0, 0
glVertex3f 12, 0, -12
glVertex3f 33, 0, -12
glVertex3f 33, 0, 0
glVertex3f 12, 0, 0
glVertex3f 0, 0, 0
glVertex3f 0, 0, -12
glVertex3f 12, 0, -12
glVertex3f 12, 0, 0
glEnable GL_TEXTURE_2D
glNormal3f 0, 1, 0
glColor3f 1, 1, 1
glTexCoord2d 0, 0
glVertex3f 0, 0, -12
glTexCoord2d 0, 1
glVertex3f 0, 0, -33
glTexCoord2d 1, 1
glVertex3f 12, 0, -33
glTexCoord2d 1, 0
glVertex3f 12, 0, -12
glDisable GL_TEXTURE_2D
'curb
glNormal3f -1, 0, 0
glColor3f 0, 0, 1
glVertex3f 12, 0, -31
glVertex3f 12, 0.5, -31
glVertex3f 12, 0.5, -14
glVertex3f 12, 0, -14
glNormal3f 0, 0, 1
glVertex3f 14, 0, -12
glVertex3f 14, 0.5, -12
glVertex3f 31, 0.5, -12
glVertex3f 31, 0, -12
'sidewalk
glNormal3f 0, 1, 0
glColor3f 0, 1, 0
glVertex3f 12, 0.5, -14
glVertex3f 12, 0.5, -31
glVertex3f 14, 0.5, -31
glVertex3f 14, 0.5, -14
glVertex3f 14, 0.5, -12
glVertex3f 14, 0.5, -14
glVertex3f 31, 0.5, -14
glVertex3f 31, 0.5, -12
glVertex3f 12, 0, -12
glVertex3f 12, 0.5, -14
glVertex3f 14, 0.5, -14
glVertex3f 14, 0.5, -12
glVertex3f 31, 0.5, -12
glVertex3f 31, 0.5, -14
glVertex3f 33, 0.5, -14
glVertex3f 33, 0, -12
glVertex3f 12, 0.5, -31
glVertex3f 12, 0, -33
glVertex3f 14, 0.5, -33
glVertex3f 14, 0.5, -31
glVertex3f 33, 0.5, -14
glVertex3f 39, 0.5, -14
glVertex3f 39, 0, -12
glVertex3f 33, 0, -12
glVertex3f 12, 0, -33
glVertex3f 12, 0, -39
glVertex3f 14, 0.5, -39
glVertex3f 14, 0.5, -33
glEnd
glBegin GL_TRIANGLES
'curb
glColor3f 0, 0, 1
glNormal3f -1, 0, 0
glVertex3f 12, 0, -12
glVertex3f 12, 0, -14
glVertex3f 12, 0.5, -14
glVertex3f 12, 0, -31
glVertex3f 12, 0, -33
glVertex3f 12, 0.5, -31
glNormal3f 0, 0, 1
glVertex3f 12, 0, -12
glVertex3f 14, 0.5, -12
glVertex3f 14, 0, -12
glVertex3f 31, 0, -12
glVertex3f 31, 0.5, -12
glVertex3f 33, 0, -12
glEnd
glFlush
SwapBuffers frmMain.hDC
End Sub
Sub Initialize(hDC As Long, Width, Height)
Dim lcv As Double
Dim test(3) As GLfloat
Randomize Timer
SetupPixelFormat hDC
hGLRC = wglCreateContext(hDC)
wglMakeCurrent hDC, hGLRC
glShadeModel GL_SMOOTH
glEnable GL_NORMALIZE
glEnable GL_CULL_FACE
glFrontFace GL_CW
glEnable GL_LIGHTING
glEnable GL_COLOR_MATERIAL
'glEnable GL_TEXTURE_2D
glGenTextures 1, Texture
glBindTexture GL_TEXTURE_2D, Texture
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST
LoadImage "\checker.bmp"
For lcv = 0 To 3
test(lcv) = 1
Next
glLightfv GL_LIGHT0, GL_POSITION, test(0)
glLightfv GL_LIGHT0, GL_DIFFUSE, test(0)
glEnable GL_LIGHT0
test(1) = 0.5
test(2) = 0.2
test(3) = 0
glMaterialfv GL_FRONT, GL_AMBIENT_AND_DIFFUSE, test(0)
glFogi GL_FOG_MODE, GL_LINEAR
glFogi GL_FOG_START, -100
glFogi GL_FOG_END, 100
glViewport 0, 0, Width, Height
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 54, Width / Height, 0.0001, 1000
glMatrixMode GL_MODELVIEW
glLoadIdentity
ScreenMatrics.x = Screen.Width / 15 - 1
ScreenMatrics.y = Screen.Height / 15 - 1
GetCursorPos Mouse
Center.x = Mouse.x
Center.y = Mouse.y
CameraPosition.y = 5.5
CameraAngle.y = 180
Main_Loop
End Sub
Sub Keyboard_Input()
Dim lcv As Integer
If KD(27) Then End
If KD(KeyRollLeft) Or (CameraRollDirection > 0) Then
CameraRollDirection = 1
CameraAngle.Z = CameraAngle.Z + 10
If CameraAngle.Z = 360 Then CameraAngle.Z = 0: CameraRollDirection = 0
CameraPosition.x = CameraPosition.x + 0.027 * Cos(CameraAngle.y * PI / 180)
CameraPosition.Z = CameraPosition.Z - 0.027 * Sin(CameraAngle.y * PI / 180)
End If
If KD(KeyRollRight) Or (CameraRollDirection < 0) Then
CameraRollDirection = -1
CameraAngle.Z = CameraAngle.Z - 10
If CameraAngle.Z = -360 Then CameraAngle.Z = 0: CameraRollDirection = 0
CameraPosition.x = CameraPosition.x - 0.027 * Cos(CameraAngle.y * PI / 180)
CameraPosition.Z = CameraPosition.Z + 0.027 * Sin(CameraAngle.y * PI / 180)
End If
If KD(KeyLookLeft) Then CameraAngle.y = CameraAngle.y + 1
If KD(KeyLookDown) Then CameraAngle.x = CameraAngle.x + 1
If KD(KeyLookRight) Then CameraAngle.y = CameraAngle.y - 1
If KD(KeyLookUp) Then CameraAngle.x = CameraAngle.x - 1
If KD(KeyMoveForward) Then
CameraPosition.x = CameraPosition.x + Sin(CameraAngle.y * PI / 180)
CameraPosition.Z = CameraPosition.Z + Cos(CameraAngle.y * PI / 180)
End If
If KD(KeyMoveBackward) Then
CameraPosition.x = CameraPosition.x - Sin(CameraAngle.y * PI / 180)
CameraPosition.Z = CameraPosition.Z - Cos(CameraAngle.y * PI / 180)
End If
If KD(90) Then CameraPosition.y = CameraPosition.y - 0.1
If KD(65) Then CameraPosition.y = CameraPosition.y + 0.1
If KD(KeyMoveLeft) Then
CameraPosition.x = CameraPosition.x + Cos(CameraAngle.y * PI / 180)
CameraPosition.Z = CameraPosition.Z - Sin(CameraAngle.y * PI / 180)
End If
If KD(KeyMoveRight) Then
CameraPosition.x = CameraPosition.x - Cos(CameraAngle.y * PI / 180)
CameraPosition.Z = CameraPosition.Z + Sin(CameraAngle.y * PI / 180)
End If
If CameraAngle.x > 90 Then CameraAngle.x = 90
If CameraAngle.x < -90 Then CameraAngle.x = -90
If CameraAngle.y < 0 Then CameraAngle.y = 360
If CameraAngle.y > 360 Then CameraAngle.y = 0
End Sub
Sub LoadImage(FileName)
Dim ImageData() As GLbyte
Dim BitInfo As BITMAPINFO
Dim w, h As Long
With frmMain.Pict
.Picture = LoadPicture(App.Path & "\checker.bmp")
.Refresh
w = .ScaleWidth
h = .ScaleHeight
ReDim ImageData(2, w - 1, h - 1)
End With
With BitInfo.bmiHeader
.biBitCount = 24
.biCompression = 0
.biPlanes = 1
.biSize = Len(BitInfo)
.biWidth = w
.biHeight = h
End With
GetDIBits frmMain.Pict.hDC, frmMain.Pict.Image, 0, h, ImageData(0, 0, 0), BitInfo, 0
glTexImage2D GL_TEXTURE_2D, 0, 3, w, h, 0, GL_RGB, GL_UNSIGNED_BYTE, ImageData(0, 0, 0)
End Sub
Private Sub Main_Loop()
GetCursorPos Mouse
Center.x = Mouse.x
Center.y = Mouse.y
Do Until Is_Quiting
TickCount = GetTickCount
If TickCount > OldTickCount + 1000 / 32 Then
OldTickCount = GetTickCount
Mouse_Input
Keyboard_Input
Draw_Scene
End If
DoEvents
Loop
End Sub
Private Sub Mouse_Input()
GetCursorPos Mouse
If Mouse.x = Center.x And Mouse.y = Center.y Then Exit Sub
If Mouse.x <> Center.x Then
CameraAngle.y = CameraAngle.y + 0.5 * (Center.x - Mouse.x)
Center.x = Mouse.x
End If
If Mouse.y <> Center.y Then
CameraAngle.x = CameraAngle.x + 0.5 * (Center.y - Mouse.y)
Center.y = Mouse.y
End If
If Mouse.x = 0 Then
Mouse.x = ScreenMatrics.x - 1
Center.x = Mouse.x
SetCursorPos Mouse.x, Mouse.y
End If
If Mouse.y = 0 Then
Mouse.y = ScreenMatrics.y - 1
Center.y = Mouse.y
SetCursorPos Mouse.x, Mouse.y
End If
If Mouse.x = ScreenMatrics.x Then
Mouse.x = 1
Center.x = 1
SetCursorPos 1, Mouse.y
End If
If Mouse.y = ScreenMatrics.y Then
Mouse.y = 1
Center.y = 1
SetCursorPos Mouse.x, 1
End If
End Sub
Private 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 = 32
pfd.cDepthBits = 32
pfd.iLayerType = PFD_MAIN_PLANE
PixelFormat = ChoosePixelFormat(frmMain.hDC, pfd)
If PixelFormat = 0 Then MsgBox ("Could not retrieve pixel format!")
SetPixelFormat frmMain.hDC, PixelFormat, pfd
End Sub
http://homeotwn.aol.com/bloodycyborge/all.bmp before enabling textures
http://hometown.aol.com/bloodycyborge/textured.bmp after enabling textures