Cube: Visual Basic Version


'*****************************************************************************
'                                                                            *
'  Cube.frm                                                                  *
'                                                                            *
'  This program draws a cube in 3D world space and allows the user to move   *
'  and rotate the cube through keyboard controls. Each of the six cube faces *
'  is a different color.                                                     *
'                                                                            *
'*****************************************************************************
Const vbWidth = 640
Const vbHeight = 480
Private Type Point3D
   X As Double
   Y As Double
   Z As Double
End Type
Dim hPal As Long
Dim hVB As Long
Dim cxClient As Long, cyClient As Long
Dim AppIsRunning As Boolean
Dim vbDepth As Long
Dim Redraw As Boolean
Dim xAngle As Long, yAngle As Long, zAngle As Long
Dim xWorld As Double, yWorld As Double, zWorld As Double
Option Base 1
Dim Colors(6) As Long
' six faces of a 40x40x40 cube, defined in object coordinates
Dim Faces(4, 6) As Point3D
Private Sub Form_Activate()
   Call fg_realize(hPal)
   Refresh
End Sub
Private Sub Form_Load()
   ScaleMode = 3
   Call fg_setdc(hDC)
   hPal = fg_defpal()
   Call fg_realize(hPal)
   Call fg_vbinit
   vbDepth = fg_colors()
   Call fg_vbdepth(vbDepth)
   hVB = fg_vballoc(vbWidth, vbHeight)
   Call fg_vbopen(hVB)
   Call fg_vbcolors
   Call fg_setcolor(-1)
   Call fg_fillpage
   Call fg_3Dviewport(0, vbWidth - 1, 0, vbHeight - 1, 0.5)
   Call fg_3Drenderstate(FG_ZCLIP)
   xAngle = 0
   yAngle = 0
   zAngle = 0
   xWorld = 0#
   yWorld = 0#
   zWorld = 100#
   Redraw = True
   Call InitGlobals
   Visible = True
   AppIsRunning = True
   While AppIsRunning
      Call CheckForMovement
      DoEvents
   Wend
End Sub
Private Sub Form_Paint()
   Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
End Sub
Private Sub Form_Resize()
   cxClient = ScaleWidth
   cyClient = ScaleHeight
   Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
   AppIsRunning = False
   Call fg_vbclose
   Call fg_vbfree(hVB)
   Call fg_vbfin
End Sub
'*****************************************************************************
'                                                                            *
'  CheckForMovement()                                                        *
'                                                                            *
'  The CheckForMovement() function checks for key presses that control the   *
'  cube's movement, and if required redraws the cube at its new position and *
'  orientation. It is called from the message loop in Form_Load().           *
'                                                                            *
'*****************************************************************************
Private Sub CheckForMovement()
   Dim ShiftKey As Boolean
   ' check if either shift key is pressed
   ShiftKey = (fg_kbtest(42) = 1) Or (fg_kbtest(54) = 1)
   ' + and - move cube along the z axis (+ is toward viewer, - is
   ' away from viewer)
   If fg_kbtest(74) = 1 Then
      zWorld = zWorld + 3#
      Redraw = True
   ElseIf fg_kbtest(78) = 1 Then
      zWorld = zWorld - 3#
      Redraw = True
   ' left and right arrow keys move cube along x axis
   ElseIf fg_kbtest(75) = 1 Then
      xWorld = xWorld - 3#
      Redraw = True
   ElseIf fg_kbtest(77) = 1 Then
      xWorld = xWorld + 3#
      Redraw = True
   ' up and down arrow keys move cube along y axis
   ElseIf fg_kbtest(72) = 1 Then
      yWorld = yWorld + 3#
      Redraw = True
   ElseIf fg_kbtest(80) = 1 Then
      yWorld = yWorld - 3#
      Redraw = True
   ' x rotates counterclockwise around x axis, X rotates clockwise
   ElseIf fg_kbtest(45) = 1 Then
      If ShiftKey Then
         xAngle = xAngle + 6
         If xAngle >= 360 Then xAngle = xAngle - 360
      Else
         xAngle = xAngle - 6
         If xAngle < 0 Then xAngle = xAngle + 360
      End If
      Redraw = True
   ' y rotates counterclockwise around y axis, Y rotates clockwise
   ElseIf fg_kbtest(21) = 1 Then
      If ShiftKey Then
         yAngle = yAngle + 6
         If yAngle >= 360 Then yAngle = yAngle - 360
      Else
         yAngle = yAngle - 6
         If yAngle < 0 Then yAngle = yAngle + 360
      End If
      Redraw = True
   ' z rotates counterclockwise around z axis, Z rotates clockwise
   ElseIf fg_kbtest(44) = 1 Then
      If ShiftKey Then
         zAngle = zAngle + 6
         If zAngle >= 360 Then zAngle = zAngle - 360
      Else
         zAngle = zAngle - 6
         If zAngle < 0 Then zAngle = zAngle + 360
      End If
      Redraw = True
   End If
   ' if the cube's position or orientation changed, redraw the cube
   If Redraw Then
      ' erase the previous frame from the virtual buffer
      Call fg_setcolor(-1)
      Call fg_fillpage
      ' define the cube's new position and rotation in 3D world space
      Call fg_3Dsetobject(xWorld, yWorld, zWorld, xAngle * 10, yAngle * 10, zAngle * 10)
      ' draw the cube
      Call DrawCube
      ' display what we just drew
      Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
      Redraw = False
   End If
End Sub
'*****************************************************************************
'                                                                            *
'  DrawCube()                                                                *
'                                                                            *
'  Draws each of the six cube faces in 3D world space.                       *
'                                                                            *
'*****************************************************************************
Private Sub DrawCube()
   Dim I As Long
   Dim R As Long, G As Long, B As Long
   For I = 1 To 6
      If vbDepth > 8 Then
         Call fg_getrgb(Colors(I), R, G, B)
         Call fg_setcolorrgb(R, G, B)
      Else
         Call fg_setcolor(Colors(I))
      End If
      Call fg_3Dpolygonobject(Faces(1, I).X, 4)
   Next
End Sub
'*****************************************************************************
'                                                                            *
'  InitGlobals()                                                             *
'                                                                            *
'  Initialize global variables and arrays. Called from Form_Load().          *
'                                                                            *
'*****************************************************************************
Private Sub InitGlobals()
   Colors(1) = 84: Colors(2) = 88: Colors(3) = 92
   Colors(4) = 96: Colors(5) = 100: Colors(6) = 104
   
   Faces(1, 1).X = 20#: Faces(1, 1).Y = -20#: Faces(1, 1).Z = -20#
   Faces(2, 1).X = -20#: Faces(2, 1).Y = -20#: Faces(2, 1).Z = -20#
   Faces(3, 1).X = -20#: Faces(3, 1).Y = 20#: Faces(3, 1).Z = -20#
   Faces(4, 1).X = 20#: Faces(4, 1).Y = 20#: Faces(4, 1).Z = -20#
   Faces(1, 2).X = -20#: Faces(1, 2).Y = -20#: Faces(1, 2).Z = -20#
   Faces(2, 2).X = -20#: Faces(2, 2).Y = -20#: Faces(2, 2).Z = 20#
   Faces(3, 2).X = -20#: Faces(3, 2).Y = 20#: Faces(3, 2).Z = 20#
   Faces(4, 2).X = -20#: Faces(4, 2).Y = 20#: Faces(4, 2).Z = -20#
   Faces(1, 3).X = 20#: Faces(1, 3).Y = 20#: Faces(1, 3).Z = 20#
   Faces(2, 3).X = -20#: Faces(2, 3).Y = 20#: Faces(2, 3).Z = 20#
   Faces(3, 3).X = -20#: Faces(3, 3).Y = -20#: Faces(3, 3).Z = 20#
   Faces(4, 3).X = 20#: Faces(4, 3).Y = -20#: Faces(4, 3).Z = 20#
   Faces(1, 4).X = 20#: Faces(1, 4).Y = -20#: Faces(1, 4).Z = 20#
   Faces(2, 4).X = 20#: Faces(2, 4).Y = -20#: Faces(2, 4).Z = -20#
   Faces(3, 4).X = 20#: Faces(3, 4).Y = 20#: Faces(3, 4).Z = -20#
   Faces(4, 4).X = 20#: Faces(4, 4).Y = 20#: Faces(4, 4).Z = 20#
   Faces(1, 5).X = 20#: Faces(1, 5).Y = -20#: Faces(1, 5).Z = 20#
   Faces(2, 5).X = -20#: Faces(2, 5).Y = -20#: Faces(2, 5).Z = 20#
   Faces(3, 5).X = -20#: Faces(3, 5).Y = -20#: Faces(3, 5).Z = -20#
   Faces(4, 5).X = 20#: Faces(4, 5).Y = -20#: Faces(4, 5).Z = -20#
   Faces(1, 6).X = 20#: Faces(1, 6).Y = 20#: Faces(1, 6).Z = -20#
   Faces(2, 6).X = -20#: Faces(2, 6).Y = 20#: Faces(2, 6).Z = -20#
   Faces(3, 6).X = -20#: Faces(3, 6).Y = 20#: Faces(3, 6).Z = 20#
   Faces(4, 6).X = 20#: Faces(4, 6).Y = 20#: Faces(4, 6).Z = 20#
End Sub

<< Prev

Next >>

Contents
Fastgraph Home Page

 

copyright 2001 Ted Gruber Software, Inc.