Geometry: Visual Basic Version

'*****************************************************************************
'                                                                            *
'  Geometry.frm                                                              *
'                                                                            *
'  This program shows how to display 3D objects in object space and 3D world *
'  space.                                                                    *
'                                                                            *
'*****************************************************************************
Const vbWidth = 300
Const vbHeight = 300
Dim hPal As Long
Dim hVB As Long
Dim hZB As Long
Dim cxClient As Long, cyClient As Long
Option Base 1
Dim Colors(6) As Long
' six faces of a 2x2x2 cube, defined in object coordinates
Dim CubeFaces(12, 6) As Double
Private Sub Form_Activate()
   Call fg_realize(hPal)
   Refresh
End Sub
Private Sub Form_Load()
   ScaleMode = 3
   Call InitGlobals
   ' create the device context and logical palette
   Call fg_setdc(hDC)
   hPal = fg_defpal()
   Call fg_realize(hPal)
   ' create and open the virtual buffer
   Call fg_vbinit
   hVB = fg_vballoc(vbWidth, vbHeight)
   Call fg_vbopen(hVB)
   Call fg_vbcolors
   ' fill the virtual buffer with white pixels
   Call fg_setcolor(-1)
   Call fg_fillpage
   ' create and open the z-buffer
   hZB = fg_zballoc(vbWidth, vbHeight)
   Call fg_zbopen(hZB)
   ' define 3D viewport and render state
   Call fg_3Dviewport(0, vbWidth - 1, 0, vbHeight - 1, 1#)
   Call fg_3Drenderstate(FG_ZBUFFER)
   ' draw the cubes and coordinate axes
   Call DrawCubes
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)
   Call fg_vbclose
   Call fg_zbfree(hZB)
   Call fg_vbfree(hVB)
   Call fg_vbfin
End Sub
'*****************************************************************************
'                                                                            *
'  DrawCubes()                                                               *
'                                                                            *
'  Draws two cubes, one in 3D world space and the other in object space,     *
'  along with 3D coordinate axes.                                            *
'                                                                            *
'*****************************************************************************
Private Sub DrawCubes()
   Dim I As Long
   ' set the point of view (POV)
   Call fg_3Dmove(4#, 4#, -15#)
   ' position a cube at z=20.0 with no rotation
   Call fg_3Dmoveobject(0#, 0#, 20#)
   ' draw the 3D coordinate axes in world space
   Call fg_setcolor(0)
   Call fg_3Dline(0#, 0#, 0#, 10#, 0#, 0#)
   Call fg_3Dline(0#, 0#, 0#, 0#, 10#, 0#)
   Call fg_3Dline(0#, 0#, 0#, 0#, 0#, 500#)
   ' draw all six faces in both cubes
   For I = 1 To 6
      Call fg_setcolor(Colors(I))
      Call fg_3Dpolygon(CubeFaces(1, I), 4)
      Call fg_3Dpolygonobject(CubeFaces(1, I), 4)
   Next
End Sub
'*****************************************************************************
'                                                                            *
'  InitGlobals()                                                             *
'                                                                            *
'  Initialize global variables and arrays. Called from Form_Load().          *
'                                                                            *
'*****************************************************************************
Private Sub InitGlobals()
   Colors(1) = 19: Colors(2) = 20: Colors(3) = 21:
   Colors(4) = 22: Colors(5) = 23: Colors(6) = 24:
   ' top
   CubeFaces(1, 1) = -1#: CubeFaces(2, 1) = 1#: CubeFaces(3, 1) = 1#
   CubeFaces(4, 1) = 1#: CubeFaces(5, 1) = 1#: CubeFaces(6, 1) = 1#
   CubeFaces(7, 1) = 1#: CubeFaces(8, 1) = 1#: CubeFaces(9, 1) = -1#
   CubeFaces(10, 1) = -1#: CubeFaces(11, 1) = 1#: CubeFaces(12, 1) = -1#
   ' front
   CubeFaces(1, 2) = -1#: CubeFaces(2, 2) = 1#: CubeFaces(3, 2) = -1#
   CubeFaces(4, 2) = 1#: CubeFaces(5, 2) = 1#: CubeFaces(6, 2) = -1#
   CubeFaces(7, 2) = 1#: CubeFaces(8, 2) = -1#: CubeFaces(9, 2) = -1#
   CubeFaces(10, 2) = -1#: CubeFaces(11, 2) = -1#: CubeFaces(12, 2) = -1#
   ' left
   CubeFaces(1, 3) = -1#: CubeFaces(2, 3) = 1#: CubeFaces(3, 3) = 1#
   CubeFaces(4, 3) = -1#: CubeFaces(5, 3) = 1#: CubeFaces(6, 3) = -1#
   CubeFaces(7, 3) = -1#: CubeFaces(8, 3) = -1#: CubeFaces(9, 3) = -1#
   CubeFaces(10, 3) = -1#: CubeFaces(11, 3) = -1#: CubeFaces(12, 3) = 1#
   ' right
   CubeFaces(1, 4) = 1#: CubeFaces(2, 4) = 1#: CubeFaces(3, 4) = -1#
   CubeFaces(4, 4) = 1#: CubeFaces(5, 4) = 1#: CubeFaces(6, 4) = 1#
   CubeFaces(7, 4) = 1#: CubeFaces(8, 4) = -1#: CubeFaces(9, 4) = 1#
   CubeFaces(10, 4) = 1#: CubeFaces(11, 4) = -1#: CubeFaces(12, 4) = -1#
   ' bottom
   CubeFaces(1, 5) = -1#: CubeFaces(2, 5) = -1#: CubeFaces(3, 5) = -1#
   CubeFaces(4, 5) = 1#: CubeFaces(5, 5) = -1#: CubeFaces(6, 5) = -1#
   CubeFaces(7, 5) = 1#: CubeFaces(8, 5) = -1#: CubeFaces(9, 5) = 1#
   CubeFaces(10, 5) = -1#: CubeFaces(11, 5) = -1#: CubeFaces(12, 5) = 1#
   ' back
   CubeFaces(1, 6) = 1#: CubeFaces(2, 6) = 1#: CubeFaces(3, 6) = 1#
   CubeFaces(4, 6) = -1#: CubeFaces(5, 6) = 1#: CubeFaces(6, 6) = 1#
   CubeFaces(7, 6) = -1#: CubeFaces(8, 6) = -1#: CubeFaces(9, 6) = 1#
   CubeFaces(10, 6) = 1#: CubeFaces(11, 6) = -1#: CubeFaces(12, 6) = 1#
End Sub