home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / geodem / csc5.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  23.9 KB  |  696 lines
  1. '3D CyberSpace viewer from...
  2.  
  3. 'Ivory Tower Software
  4. 'Richard Wagner
  5. 'CIS 76427,2611
  6.  
  7. 'Copyright 1992, all rights reserved.
  8.  
  9. 'You may use this VB source code in your programs if you include attribution in your
  10. 'startup and "about" screens in the form: "Portions of this program copyright by
  11. 'Ivory Tower Software, used with permission."
  12.  
  13.  
  14.  
  15. Sub BorderBoxRaised (Source1 As Control, Source2 As Form)
  16.  
  17.   Source2.drawwidth = 1
  18.   Bleft% = Source1.Left - 15
  19.   BTop% = Source1.top - 15
  20.   BWide% = Source1.width + 15
  21.   BHigh% = Source1.height + 15
  22.   Source2.Line (Bleft%, BTop%)-Step(BWide%, 0), &HFFFFFF
  23.   Source2.Line -Step(0, BHigh%), 0
  24.   Source2.Line -Step(-BWide%, 0), 0
  25.   Source2.Line -Step(0, -BHigh%), &HFFFFFF
  26.  
  27. End Sub
  28.  
  29. Sub BorderBoxRecessed (Source1 As Control, Source2 As Form)
  30.  
  31.   Source2.drawwidth = 1
  32.   Bleft% = Source1.Left - 20
  33.   BTop% = Source1.top - 20
  34.   BWide% = Source1.width + 15
  35.   BHigh% = Source1.height + 15
  36.   Source2.Line (Bleft%, BTop%)-Step(BWide%, 0), 0
  37.   Source2.Line -Step(0, BHigh%), &HFFFFFF
  38.   Source2.Line -Step(-BWide%, 0), &HFFFFFF
  39.   Source2.Line -Step(0, -BHigh%), 0
  40.  
  41. End Sub
  42.  
  43. Sub MapToWindow (ByVal PointNum As Integer, ByVal X, ByVal Y, ByVal Z)
  44.  
  45.     'Transform object point in World Space to View Space.
  46.     'Call GEO.DLL subroutine:
  47.     ThreeDXForm 1000, 1000, X, Y, Z, sfViewPointX, sfViewPointY, sfViewPointZ, sfWinPointX, sfWinPointY, sfWinPointZ, sfRPointX, sfRPointY, sfRPointZ, sfSPointX, sfSPointY, sfSPointZ, PxStar, PyStar, PzStar
  48.     
  49.     'Transform object point in View 3Space to Window 2Space:
  50.     If PzStar <> 0 Then
  51.       PxStar = -PxStar * 1000 / PzStar
  52.       PyStar = -PyStar * 1000 / PzStar
  53.     Else
  54.       PxStar = -PxStar * 1000 * 30000    'Can't divide by zero so
  55.       PyStar = -PyStar * 1000 * 30000    'do the next best thing
  56.     End If
  57.  
  58.     'Convert mapped points to integers for drawing:
  59.     If PxStar <= 30000 And PxStar >= -30000 Then
  60.       iPx(PointNum) = CInt(PxStar)
  61.     Else
  62.       iPx(PointNum) = 30000 * Sgn(PxStar)
  63.     End If
  64.  
  65.     If PyStar <= 30000 And PyStar >= -30000 Then
  66.       iPy(PointNum) = CInt(PyStar)
  67.     Else
  68.       iPy(PointNum) = 30000 * Sgn(PyStar)
  69.     End If
  70.  
  71.     If PzStar <= 30000 And PzStar >= -30000 Then
  72.       iPz(PointNum) = CInt(PzStar)
  73.     Else
  74.       iPz(PointNum) = 30000 * Sgn(PzStar)
  75.     End If
  76.  
  77. End Sub
  78.  
  79. Sub PicBorderBoxRecessed (Source1 As Control, Source2 As Control)
  80.  
  81.   Source2.drawwidth = 1
  82.   Bleft% = Source1.Left - 15
  83.   BTop% = Source1.top - 15
  84.   BWide% = Source1.width + 15
  85.   BHigh% = Source1.height + 15
  86.   Source2.Line (Bleft%, BTop%)-Step(BWide%, 0), 0
  87.   Source2.Line -Step(0, BHigh%), &HFFFFFF
  88.   Source2.Line -Step(-BWide%, 0), &HFFFFFF
  89.   Source2.Line -Step(0, -BHigh%), 0
  90.  
  91. End Sub
  92.  
  93. Sub PlaceAllObjects ()
  94.   
  95.   'All the defined objects get placed in cyberspace, with more distant objects
  96.   'getting placed first.
  97.   
  98.   XView.mousepointer = 11
  99.  
  100.   For i% = 1 To iNumObjects
  101.    'Find distances squared of objects' centers from ViewPoint:
  102.    'There is no need to take the square root, because it's the distance order we want.
  103.     
  104.     sfDSquared(i%) = (iLocationX(i%) - sfViewPointX) ^ 2 + (iLocationY(i%) - sfViewPointY) ^ 2 + (iLocationZ(i%) - sfViewPointZ) ^ 2
  105.     
  106.     'Initialize object order array:
  107.     iObjOrder(i%) = i%
  108.   Next i%
  109.  
  110.   'Sort objects by their distances squared:
  111.   'Bubble sort
  112.   For i% = 1 To iNumObjects - 1
  113.     For j% = i% + 1 To iNumObjects
  114.       If sfDSquared(i%) < sfDSquared(j%) Then
  115.         
  116.         Temp1! = sfDSquared(i%)
  117.         sfDSquared(i%) = sfDSquared(j%)
  118.         sfDSquared(j%) = Temp1!
  119.  
  120.         Temp2! = iObjOrder(i%)
  121.         iObjOrder(i%) = iObjOrder(j%)
  122.         iObjOrder(j%) = Temp2!
  123.   
  124.       End If
  125.     Next j%
  126.   Next i%
  127.  
  128.   For i% = 1 To iNumObjects
  129.     'See if center of object is outside view pyramid by 500 CLUs:
  130.     'Objects completely out of view don't get drawn.
  131.     'This means that the biggest object in cyberspace cannot be bigger than
  132.     '1000 CLUs in any dimension.
  133.     NewX! = iLocationX(i%) - sfViewPointX
  134.     NewY! = iLocationY(i%) - sfViewPointY
  135.     NewZ! = iLocationZ(i%) - sfViewPointZ
  136.     CenterXstar& = (sfRPointX - sfWinPointX) * NewX! / 500 + (sfRPointY - sfWinPointY) * NewY! / 500 + (sfRPointZ - sfWinPointZ) * NewZ! / 500
  137.     CenterYstar& = (sfSPointX - sfWinPointX) * NewX! / 500 + (sfSPointY - sfWinPointY) * NewY! / 500 + (sfSPointZ - sfWinPointZ) * NewZ! / 500
  138.     CenterZstar& = (sfViewPointX - sfWinPointX) * NewX! / 1000 + (sfViewPointY - sfWinPointY) * NewY! / 1000 + (sfViewPointZ - sfWinPointZ) * NewZ! / 1000
  139.     iInView(i%) = -1
  140.     If CenterXstar& > (1000 - CenterZstar&) / 2 Then
  141.       iInView(i%) = 0
  142.     End If
  143.     If CenterXstar& < (CenterZstar& - 1000) / 2 Then
  144.       iInView(i%) = 0
  145.     End If
  146.     If CenterYstar& > (1000 - CenterZstar&) / 2 Then
  147.       iInView(i%) = 0
  148.     End If
  149.     If CenterYstar& < (CenterZstar& - 1000) / 2 Then
  150.        iInView(i%) = 0
  151.     End If
  152.  
  153.   Next i%
  154.  
  155.   For i% = 1 To iNumObjects
  156.  
  157.     'Erase
  158.     'Objects are explicitly erased for smooth drawing.
  159.     If iInViewPrev(iObjOrder(i%)) Then PlaceObject iObjOrder(i%), -1
  160.   
  161.   Next i%
  162.  
  163.   For i% = 1 To iNumObjects
  164.     
  165.     'Place
  166.     If iInView(iObjOrder(i%)) Then PlaceObject iObjOrder(i%), 0
  167.     iInViewPrev(i%) = iInView(i%)
  168.  
  169.   Next i%
  170.   XView.mousepointer = 0
  171.  
  172. End Sub
  173.  
  174. Sub PlaceObject (ObjNum As Integer, iErase As Integer)
  175.  
  176.   'Each object is placed separately after erasing its old placement.
  177.   'Cls is not used because that makes a flickering view port.
  178.  
  179.   On Error GoTo PlaceObjectHandler
  180.   
  181. If Not iErase Then                      'Placing objects, so calculate transformations:
  182.  
  183.   For i% = 1 To iNumPoints(iObjectType(ObjNum))      'Do it for each point in the object:
  184.     
  185.     'Point is referenced to iLocationX, Y, Z of object center relative to the viewpoint:
  186.     NewX! = iObjectX(iObjectType(ObjNum), i%) * sfSize(ObjNum) + iLocationX(ObjNum) - sfViewPointX
  187.     NewY! = iObjectY(iObjectType(ObjNum), i%) * sfSize(ObjNum) + iLocationY(ObjNum) - sfViewPointY
  188.     NewZ! = iObjectZ(iObjectType(ObjNum), i%) * sfSize(ObjNum) + iLocationZ(ObjNum) - sfViewPointZ
  189.     
  190.     MapToWindow i%, NewX!, NewY!, NewZ!
  191.  
  192.   Next i%
  193.  
  194. End If
  195.  
  196. 'Each object is drawn depending on its type:
  197. Select Case iObjectType(ObjNum)
  198.  
  199. Case 1, 44                     'Wireframe Cube
  200.  
  201. If iErase Then              'Erase previous rendering of the object:
  202.                             '(doing CLS makes a jumpy flickering picture)
  203.     
  204.     If PzOld(ObjNum, 1) < 0 Or PzOld(ObjNum, 2) < 0 Then
  205.       If (Abs(PxOld(ObjNum, 1)) < 500 And Abs(PyOld(ObjNum, 1)) < 500) Or (Abs(PxOld(ObjNum, 2)) < 500 And Abs(PyOld(ObjNum, 2)) < 500) Then
  206.         XView.ViewPic.Line (PxOld(ObjNum, 1), PyOld(ObjNum, 1))-(PxOld(ObjNum, 2), PyOld(ObjNum, 2)), QBColor(7)
  207.       End If
  208.     End If
  209.     If PzOld(ObjNum, 2) < 0 Or PzOld(ObjNum, 3) < 0 Then
  210.       If (Abs(PxOld(ObjNum, 2)) < 500 And Abs(PyOld(ObjNum, 2)) < 500) Or (Abs(PxOld(ObjNum, 3)) < 500 And Abs(PyOld(ObjNum, 3)) < 500) Then
  211.         XView.ViewPic.Line (PxOld(ObjNum, 2), PyOld(ObjNum, 2))-(PxOld(ObjNum, 3), PyOld(ObjNum, 3)), QBColor(7)
  212.       End If
  213.     End If
  214.     If PzOld(ObjNum, 3) < 0 Or PzOld(ObjNum, 4) < 0 Then
  215.       If (Abs(PxOld(ObjNum, 3)) < 500 And Abs(PyOld(ObjNum, 3)) < 500) Or (Abs(PxOld(ObjNum, 4)) < 500 And Abs(PyOld(ObjNum, 4)) < 500) Then
  216.         XView.ViewPic.Line (PxOld(ObjNum, 3), PyOld(ObjNum, 3))-(PxOld(ObjNum, 4), PyOld(ObjNum, 4)), QBColor(7)
  217.       End If
  218.     End If
  219.     If PzOld(ObjNum, 4) < 0 Or PzOld(ObjNum, 1) < 0 Then
  220.       If (Abs(PxOld(ObjNum, 4)) < 500 And Abs(PyOld(ObjNum, 4)) < 500) Or (Abs(PxOld(ObjNum, 1)) < 500 And Abs(PyOld(ObjNum, 1)) < 500) Then
  221.         XView.ViewPic.Line (PxOld(ObjNum, 4), PyOld(ObjNum, 4))-(PxOld(ObjNum, 1), PyOld(ObjNum, 1)), QBColor(7)
  222.       End If
  223.     End If
  224.     If PzOld(ObjNum, 5) < 0 Or PzOld(ObjNum, 6) < 0 Then
  225.       If (Abs(PxOld(ObjNum, 5)) < 500 And Abs(PyOld(ObjNum, 5)) < 500) Or (Abs(PxOld(ObjNum, 6)) < 500 And Abs(PyOld(ObjNum, 6)) < 500) Then
  226.         XView.ViewPic.Line (PxOld(ObjNum, 5), PyOld(ObjNum, 5))-(PxOld(ObjNum, 6), PyOld(ObjNum, 6)), QBColor(7)
  227.       End If
  228.     End If
  229.     If PzOld(ObjNum, 6) < 0 Or PzOld(ObjNum, 7) < 0 Then
  230.       If (Abs(PxOld(ObjNum, 6)) < 500 And Abs(PyOld(ObjNum, 6)) < 500) Or (Abs(PxOld(ObjNum, 7)) < 500 And Abs(PyOld(ObjNum, 7)) < 500) Then
  231.         XView.ViewPic.Line (PxOld(ObjNum, 6), PyOld(ObjNum, 6))-(PxOld(ObjNum, 7), PyOld(ObjNum, 7)), QBColor(7)
  232.       End If
  233.     End If
  234.     If PzOld(ObjNum, 7) < 0 Or PzOld(ObjNum, 8) < 0 Then
  235.       If (Abs(PxOld(ObjNum, 7)) < 500 And Abs(PyOld(ObjNum, 7)) < 500) Or (Abs(PxOld(ObjNum, 8)) < 500 And Abs(PyOld(ObjNum, 8)) < 500) Then
  236.         XView.ViewPic.Line (PxOld(ObjNum, 7), PyOld(ObjNum, 7))-(PxOld(ObjNum, 8), PyOld(ObjNum, 8)), QBColor(7)
  237.       End If
  238.     End If
  239.     If PzOld(ObjNum, 8) < 0 Or PzOld(ObjNum, 5) < 0 Then
  240.       If (Abs(PxOld(ObjNum, 8)) < 500 And Abs(PyOld(ObjNum, 8)) < 500) Or (Abs(PxOld(ObjNum, 5)) < 500 And Abs(PyOld(ObjNum, 5)) < 500) Then
  241.         XView.ViewPic.Line (PxOld(ObjNum, 8), PyOld(ObjNum, 8))-(PxOld(ObjNum, 5), PyOld(ObjNum, 5)), QBColor(7)
  242.       End If
  243.     End If
  244.     If PzOld(ObjNum, 1) < 0 Or PzOld(ObjNum, 5) < 0 Then
  245.       If (Abs(PxOld(ObjNum, 1)) < 500 And Abs(PyOld(ObjNum, 1)) < 500) Or (Abs(PxOld(ObjNum, 5)) < 500 And Abs(PyOld(ObjNum, 5)) < 500) Then
  246.         XView.ViewPic.Line (PxOld(ObjNum, 1), PyOld(ObjNum, 1))-(PxOld(ObjNum, 5), PyOld(ObjNum, 5)), QBColor(7)
  247.       End If
  248.     End If
  249.     If PzOld(ObjNum, 2) < 0 Or PzOld(ObjNum, 6) < 0 Then
  250.       If (Abs(PxOld(ObjNum, 2)) < 500 And Abs(PyOld(ObjNum, 2)) < 500) Or (Abs(PxOld(ObjNum, 6)) < 500 And Abs(PyOld(ObjNum, 6)) < 500) Then
  251.         XView.ViewPic.Line (PxOld(ObjNum, 2), PyOld(ObjNum, 2))-(PxOld(ObjNum, 6), PyOld(ObjNum, 6)), QBColor(7)
  252.       End If
  253.     End If
  254.     If PzOld(ObjNum, 3) < 0 Or PzOld(ObjNum, 7) < 0 Then
  255.       If (Abs(PxOld(ObjNum, 3)) < 500 And Abs(PyOld(ObjNum, 3)) < 500) Or (Abs(PxOld(ObjNum, 7)) < 500 And Abs(PyOld(ObjNum, 7)) < 500) Then
  256.         XView.ViewPic.Line (PxOld(ObjNum, 3), PyOld(ObjNum, 3))-(PxOld(ObjNum, 7), PyOld(ObjNum, 7)), QBColor(7)
  257.       End If
  258.     End If
  259.     If PzOld(ObjNum, 4) < 0 Or PzOld(ObjNum, 8) < 0 Then
  260.       If (Abs(PxOld(ObjNum, 4)) < 500 And Abs(PyOld(ObjNum, 4)) < 500) Or (Abs(PxOld(ObjNum, 8)) < 500 And Abs(PyOld(ObjNum, 8)) < 500) Then
  261.         XView.ViewPic.Line (PxOld(ObjNum, 4), PyOld(ObjNum, 4))-(PxOld(ObjNum, 8), PyOld(ObjNum, 8)), QBColor(7)
  262.       End If
  263.     End If
  264.   
  265.   Else
  266.     'Draw object:
  267.     If iPz(1) < 0 Or iPz(2) < 0 Then
  268.       If (Abs(iPx(1)) < 500 And Abs(iPy(1)) < 500) Or (Abs(iPx(2)) < 500 And Abs(iPy(2)) < 500) Then
  269.         XView.ViewPic.Line (iPx(1), iPy(1))-(iPx(2), iPy(2)), QBColor(iColor(ObjNum))
  270.       End If
  271.     End If
  272.     If iPz(2) < 0 Or iPz(3) < 0 Then
  273.       If (Abs(iPx(2)) < 500 And Abs(iPy(2)) < 500) Or (Abs(iPx(3)) < 500 And Abs(iPy(3)) < 500) Then
  274.         XView.ViewPic.Line (iPx(2), iPy(2))-(iPx(3), iPy(3)), QBColor(iColor(ObjNum))
  275.       End If
  276.     End If
  277.     If iPz(3) < 0 Or iPz(4) < 0 Then
  278.       If (Abs(iPx(3)) < 500 And Abs(iPy(3)) < 500) Or (Abs(iPx(4)) < 500 And Abs(iPy(4)) < 500) Then
  279.         XView.ViewPic.Line (iPx(3), iPy(3))-(iPx(4), iPy(4)), QBColor(iColor(ObjNum))
  280.       End If
  281.     End If
  282.     If iPz(4) < 0 Or iPz(1) < 0 Then
  283.       If (Abs(iPx(4)) < 500 And Abs(iPy(4)) < 500) Or (Abs(iPx(1)) < 500 And Abs(iPy(1)) < 500) Then
  284.         XView.ViewPic.Line (iPx(4), iPy(4))-(iPx(1), iPy(1)), QBColor(iColor(ObjNum))
  285.       End If
  286.     End If
  287.     If iPz(5) < 0 Or iPz(6) < 0 Then
  288.       If (Abs(iPx(5)) < 500 And Abs(iPy(5)) < 500) Or (Abs(iPx(6)) < 500 And Abs(iPy(6)) < 500) Then
  289.         XView.ViewPic.Line (iPx(5), iPy(5))-(iPx(6), iPy(6)), QBColor(iColor(ObjNum))
  290.       End If
  291.     End If
  292.     If iPz(6) < 0 Or iPz(7) < 0 Then
  293.       If (Abs(iPx(6)) < 500 And Abs(iPy(6)) < 500) Or (Abs(iPx(7)) < 500 And Abs(iPy(7)) < 500) Then
  294.         XView.ViewPic.Line (iPx(6), iPy(6))-(iPx(7), iPy(7)), QBColor(iColor(ObjNum))
  295.       End If
  296.     End If
  297.     If iPz(7) < 0 Or iPz(8) < 0 Then
  298.       If (Abs(iPx(7)) < 500 And Abs(iPy(7)) < 500) Or (Abs(iPx(8)) < 500 And Abs(iPy(8)) < 500) Then
  299.         XView.ViewPic.Line (iPx(7), iPy(7))-(iPx(8), iPy(8)), QBColor(iColor(ObjNum))
  300.       End If
  301.     End If
  302.     If iPz(8) < 0 Or iPz(5) < 0 Then
  303.       If (Abs(iPx(8)) < 500 And Abs(iPy(8)) < 500) Or (Abs(iPx(5)) < 500 And Abs(iPy(5)) < 500) Then
  304.         XView.ViewPic.Line (iPx(8), iPy(8))-(iPx(5), iPy(5)), QBColor(iColor(ObjNum))
  305.       End If
  306.     End If
  307.     If iPz(1) < 0 Or iPz(5) < 0 Then
  308.       If (Abs(iPx(1)) < 500 And Abs(iPy(1)) < 500) Or (Abs(iPx(5)) < 500 And Abs(iPy(5)) < 500) Then
  309.         XView.ViewPic.Line (iPx(1), iPy(1))-(iPx(5), iPy(5)), QBColor(iColor(ObjNum))
  310.       End If
  311.     End If
  312.     If iPz(2) < 0 Or iPz(6) < 0 Then
  313.       If (Abs(iPx(2)) < 500 And Abs(iPy(2)) < 500) Or (Abs(iPx(6)) < 500 And Abs(iPy(6)) < 500) Then
  314.         XView.ViewPic.Line (iPx(2), iPy(2))-(iPx(6), iPy(6)), QBColor(iColor(ObjNum))
  315.       End If
  316.     End If
  317.     If iPz(3) < 0 Or iPz(7) < 0 Then
  318.       If (Abs(iPx(3)) < 500 And Abs(iPy(3)) < 500) Or (Abs(iPx(7)) < 500 And Abs(iPy(7)) < 500) Then
  319.         XView.ViewPic.Line (iPx(3), iPy(3))-(iPx(7), iPy(7)), QBColor(iColor(ObjNum))
  320.       End If
  321.     End If
  322.     If iPz(4) < 0 Or iPz(8) < 0 Then
  323.       If (Abs(iPx(4)) < 500 And Abs(iPy(4)) < 500) Or (Abs(iPx(8)) < 500 And Abs(iPy(8)) < 500) Then
  324.         XView.ViewPic.Line (iPx(4), iPy(4))-(iPx(8), iPy(8)), QBColor(iColor(ObjNum))
  325.       End If
  326.     End If
  327.  
  328.     For i% = 1 To 8
  329.       PxOld(ObjNum, i%) = iPx(i%)
  330.       PyOld(ObjNum, i%) = iPy(i%)
  331.       PzOld(ObjNum, i%) = iPz(i%)
  332.     Next i%
  333.  
  334.   End If
  335.  
  336. Case 13 To 21, 26               'Filled Quadrilateral
  337.  
  338.   If iErase Then
  339.  
  340.     Z1% = PzOld(ObjNum, 1)
  341.     Z2% = PzOld(ObjNum, 2)
  342.     Z3% = PzOld(ObjNum, 3)
  343.     Z4% = PzOld(ObjNum, 4)
  344.  
  345.     If Z1% < 0 And Z2% < 0 And Z3% < 0 And Z4% < 0 Then
  346.  
  347.       x1% = Abs(PxOld(ObjNum, 1))
  348.       y1% = Abs(PyOld(ObjNum, 1))
  349.       x2% = Abs(PxOld(ObjNum, 2))
  350.       y2% = Abs(PyOld(ObjNum, 2))
  351.       x3% = Abs(PxOld(ObjNum, 3))
  352.       y3% = Abs(PyOld(ObjNum, 3))
  353.       x4% = Abs(PxOld(ObjNum, 4))
  354.       y4% = Abs(PyOld(ObjNum, 4))
  355.  
  356.       If x1% < 500 Or x2% < 500 Or x3% < 500 Or x4% < 500 Or y1% < 500 Or y2% < 500 Or y3% < 500 Or y4% < 500 Then
  357.       
  358.         ReDim Points(4) As PointAPI
  359.         XView.ViewPic.FillColor = QBColor(7)
  360.         XView.ViewPic.ForeColor = QBColor(7)
  361.  
  362.         XView.ViewPic.currentx = PxOld(ObjNum, 1)
  363.         XView.ViewPic.currenty = PyOld(ObjNum, 1)
  364.         XView.ViewPic.ScaleMode = 3
  365.         Points(1).X = XView.ViewPic.currentx
  366.         Points(1).Y = XView.ViewPic.currenty
  367.  
  368.         XView.ViewPic.ScaleWidth = 1000
  369.         XView.ViewPic.ScaleHeight = -1000
  370.         XView.ViewPic.ScaleTop = 500
  371.         XView.ViewPic.scaleleft = -500
  372.         XView.ViewPic.currentx = PxOld(ObjNum, 2)
  373.         XView.ViewPic.currenty = PyOld(ObjNum, 2)
  374.         XView.ViewPic.ScaleMode = 3
  375.         Points(2).X = XView.ViewPic.currentx
  376.         Points(2).Y = XView.ViewPic.currenty
  377.  
  378.         XView.ViewPic.ScaleWidth = 1000
  379.         XView.ViewPic.ScaleHeight = -1000
  380.         XView.ViewPic.ScaleTop = 500
  381.         XView.ViewPic.scaleleft = -500
  382.         XView.ViewPic.currentx = PxOld(ObjNum, 3)
  383.         XView.ViewPic.currenty = PyOld(ObjNum, 3)
  384.         XView.ViewPic.ScaleMode = 3
  385.         Points(3).X = XView.ViewPic.currentx
  386.         Points(3).Y = XView.ViewPic.currenty
  387.  
  388.         XView.ViewPic.ScaleWidth = 1000
  389.         XView.ViewPic.ScaleHeight = -1000
  390.         XView.ViewPic.ScaleTop = 500
  391.         XView.ViewPic.scaleleft = -500
  392.         XView.ViewPic.currentx = PxOld(ObjNum, 4)
  393.         XView.ViewPic.currenty = PyOld(ObjNum, 4)
  394.         XView.ViewPic.ScaleMode = 3
  395.         Points(4).X = XView.ViewPic.currentx
  396.         Points(4).Y = XView.ViewPic.currenty
  397.  
  398.         XView.ViewPic.PSet (501, 501)
  399.         Result% = Polygon(XView.ViewPic.hDC, Points(1), 4)
  400.  
  401.         XView.ViewPic.ScaleWidth = 1000
  402.         XView.ViewPic.ScaleHeight = -1000
  403.         XView.ViewPic.ScaleTop = 500
  404.         XView.ViewPic.scaleleft = -500
  405.  
  406.       End If
  407.  
  408.     End If
  409.  
  410.   Else
  411.  
  412.     Z1% = iPz(1)
  413.     Z2% = iPz(2)
  414.     Z3% = iPz(3)
  415.     Z4% = iPz(4)
  416.  
  417.     If Z1% < 0 And Z2% < 0 And Z3% < 0 And Z4% < 0 Then
  418.  
  419.       x1% = Abs(iPx(1))
  420.       y1% = Abs(iPy(1))
  421.       x2% = Abs(iPx(2))
  422.       y2% = Abs(iPy(2))
  423.       x3% = Abs(iPx(3))
  424.       y3% = Abs(iPy(3))
  425.       x4% = Abs(iPx(4))
  426.       y4% = Abs(iPy(4))
  427.  
  428.       If x1% < 500 Or x2% < 500 Or x3% < 500 Or x4% < 500 Or y1% < 500 Or y2% < 500 Or y3% < 500 Or y4% < 500 Then
  429.       
  430.         ReDim Points(4) As PointAPI
  431.         XView.ViewPic.FillColor = QBColor(iColor(ObjNum))
  432.         XView.ViewPic.ForeColor = QBColor(0)
  433.  
  434.         XView.ViewPic.currentx = iPx(1)
  435.         XView.ViewPic.currenty = iPy(1)
  436.         XView.ViewPic.ScaleMode = 3
  437.         Points(1).X = XView.ViewPic.currentx
  438.         Points(1).Y = XView.ViewPic.currenty
  439.  
  440.         XView.ViewPic.ScaleWidth = 1000
  441.         XView.ViewPic.ScaleHeight = -1000
  442.         XView.ViewPic.ScaleTop = 500
  443.         XView.ViewPic.scaleleft = -500
  444.         XView.ViewPic.currentx = iPx(2)
  445.         XView.ViewPic.currenty = iPy(2)
  446.         XView.ViewPic.ScaleMode = 3
  447.         Points(2).X = XView.ViewPic.currentx
  448.         Points(2).Y = XView.ViewPic.currenty
  449.  
  450.         XView.ViewPic.ScaleWidth = 1000
  451.         XView.ViewPic.ScaleHeight = -1000
  452.         XView.ViewPic.ScaleTop = 500
  453.         XView.ViewPic.scaleleft = -500
  454.         XView.ViewPic.currentx = iPx(3)
  455.         XView.ViewPic.currenty = iPy(3)
  456.         XView.ViewPic.ScaleMode = 3
  457.         Points(3).X = XView.ViewPic.currentx
  458.         Points(3).Y = XView.ViewPic.currenty
  459.  
  460.         XView.ViewPic.ScaleWidth = 1000
  461.         XView.ViewPic.ScaleHeight = -1000
  462.         XView.ViewPic.ScaleTop = 500
  463.         XView.ViewPic.scaleleft = -500
  464.         XView.ViewPic.currentx = iPx(4)
  465.         XView.ViewPic.currenty = iPy(4)
  466.         XView.ViewPic.ScaleMode = 3
  467.         Points(4).X = XView.ViewPic.currentx
  468.         Points(4).Y = XView.ViewPic.currenty
  469.  
  470.         XView.ViewPic.PSet (501, 501)
  471.         Result% = Polygon(XView.ViewPic.hDC, Points(1), 4)
  472.  
  473.         XView.ViewPic.ScaleWidth = 1000
  474.         XView.ViewPic.ScaleHeight = -1000
  475.         XView.ViewPic.ScaleTop = 500
  476.         XView.ViewPic.scaleleft = -500
  477.  
  478.         For i% = 1 To 4
  479.           PxOld(ObjNum, i%) = iPx(i%)
  480.           PyOld(ObjNum, i%) = iPy(i%)
  481.           PzOld(ObjNum, i%) = iPz(i%)
  482.         Next i%
  483.  
  484.       End If
  485.  
  486.     End If
  487.     
  488.   End If
  489.  
  490. Case 22 To 25               'Filled Triangle
  491.  
  492.   If iErase Then
  493.  
  494.     Z1% = PzOld(ObjNum, 1)
  495.     Z2% = PzOld(ObjNum, 2)
  496.     Z3% = PzOld(ObjNum, 3)
  497.  
  498.     If Z1% < 0 And Z2% < 0 And Z3% < 0 Then
  499.  
  500.       x1% = Abs(PxOld(ObjNum, 1))
  501.       y1% = Abs(PyOld(ObjNum, 1))
  502.       x2% = Abs(PxOld(ObjNum, 2))
  503.       y2% = Abs(PyOld(ObjNum, 2))
  504.       x3% = Abs(PxOld(ObjNum, 3))
  505.       y3% = Abs(PyOld(ObjNum, 3))
  506.  
  507.       If x1% < 500 Or x2% < 500 Or x3% < 500 Or y1% < 500 Or y2% < 500 Or y3% < 500 Then
  508.       
  509.         ReDim Points(3) As PointAPI
  510.         XView.ViewPic.FillColor = QBColor(7)
  511.         XView.ViewPic.ForeColor = QBColor(7)
  512.  
  513.         XView.ViewPic.currentx = PxOld(ObjNum, 1)
  514.         XView.ViewPic.currenty = PyOld(ObjNum, 1)
  515.         XView.ViewPic.ScaleMode = 3
  516.         Points(1).X = XView.ViewPic.currentx
  517.         Points(1).Y = XView.ViewPic.currenty
  518.  
  519.         XView.ViewPic.ScaleWidth = 1000
  520.         XView.ViewPic.ScaleHeight = -1000
  521.         XView.ViewPic.ScaleTop = 500
  522.         XView.ViewPic.scaleleft = -500
  523.         XView.ViewPic.currentx = PxOld(ObjNum, 2)
  524.         XView.ViewPic.currenty = PyOld(ObjNum, 2)
  525.         XView.ViewPic.ScaleMode = 3
  526.         Points(2).X = XView.ViewPic.currentx
  527.         Points(2).Y = XView.ViewPic.currenty
  528.  
  529.         XView.ViewPic.ScaleWidth = 1000
  530.         XView.ViewPic.ScaleHeight = -1000
  531.         XView.ViewPic.ScaleTop = 500
  532.         XView.ViewPic.scaleleft = -500
  533.         XView.ViewPic.currentx = PxOld(ObjNum, 3)
  534.         XView.ViewPic.currenty = PyOld(ObjNum, 3)
  535.         XView.ViewPic.ScaleMode = 3
  536.         Points(3).X = XView.ViewPic.currentx
  537.         Points(3).Y = XView.ViewPic.currenty
  538.  
  539.         XView.ViewPic.PSet (501, 501)
  540.         Result% = Polygon(XView.ViewPic.hDC, Points(1), 3)
  541.  
  542.         XView.ViewPic.ScaleWidth = 1000
  543.         XView.ViewPic.ScaleHeight = -1000
  544.         XView.ViewPic.ScaleTop = 500
  545.         XView.ViewPic.scaleleft = -500
  546.  
  547.       End If
  548.  
  549.     End If
  550.  
  551.   Else
  552.  
  553.     Z1% = iPz(1)
  554.     Z2% = iPz(2)
  555.     Z3% = iPz(3)
  556.  
  557.     If Z1% < 0 And Z2% < 0 And Z3% < 0 Then
  558.  
  559.       x1% = Abs(iPx(1))
  560.       y1% = Abs(iPy(1))
  561.       x2% = Abs(iPx(2))
  562.       y2% = Abs(iPy(2))
  563.       x3% = Abs(iPx(3))
  564.       y3% = Abs(iPy(3))
  565.  
  566.       If x1% < 500 Or x2% < 500 Or x3% < 500 Or y1% < 500 Or y2% < 500 Or y3% < 500 Then
  567.       
  568.         ReDim Points(3) As PointAPI
  569.         XView.ViewPic.FillColor = QBColor(iColor(ObjNum))
  570.         XView.ViewPic.ForeColor = QBColor(0)
  571.  
  572.         XView.ViewPic.currentx = iPx(1)
  573.         XView.ViewPic.currenty = iPy(1)
  574.         XView.ViewPic.ScaleMode = 3
  575.         Points(1).X = XView.ViewPic.currentx
  576.         Points(1).Y = XView.ViewPic.currenty
  577.  
  578.         XView.ViewPic.ScaleWidth = 1000
  579.         XView.ViewPic.ScaleHeight = -1000
  580.         XView.ViewPic.ScaleTop = 500
  581.         XView.ViewPic.scaleleft = -500
  582.         XView.ViewPic.currentx = iPx(2)
  583.         XView.ViewPic.currenty = iPy(2)
  584.         XView.ViewPic.ScaleMode = 3
  585.         Points(2).X = XView.ViewPic.currentx
  586.         Points(2).Y = XView.ViewPic.currenty
  587.  
  588.         XView.ViewPic.ScaleWidth = 1000
  589.         XView.ViewPic.ScaleHeight = -1000
  590.         XView.ViewPic.ScaleTop = 500
  591.         XView.ViewPic.scaleleft = -500
  592.         XView.ViewPic.currentx = iPx(3)
  593.         XView.ViewPic.currenty = iPy(3)
  594.         XView.ViewPic.ScaleMode = 3
  595.         Points(3).X = XView.ViewPic.currentx
  596.         Points(3).Y = XView.ViewPic.currenty
  597.  
  598.         XView.ViewPic.PSet (501, 501)
  599.         Result% = Polygon(XView.ViewPic.hDC, Points(1), 3)
  600.  
  601.         XView.ViewPic.ScaleWidth = 1000
  602.         XView.ViewPic.ScaleHeight = -1000
  603.         XView.ViewPic.ScaleTop = 500
  604.         XView.ViewPic.scaleleft = -500
  605.  
  606.         For i% = 1 To 3
  607.           PxOld(ObjNum, i%) = iPx(i%)
  608.           PyOld(ObjNum, i%) = iPy(i%)
  609.           PzOld(ObjNum, i%) = iPz(i%)
  610.         Next i%
  611.  
  612.       End If
  613.  
  614.     End If
  615.     
  616.   End If
  617.  
  618. Case 41, 42, 43                           'Pointalist objects
  619.  
  620.   If iErase Then
  621.     For i% = 1 To iNumPoints(iObjectType(ObjNum))
  622.       If PzOld(ObjNum, i%) < 0 Then
  623.         XView.ViewPic.PSet (PxOld(ObjNum, i%), PyOld(ObjNum, i%)), QBColor(7)
  624.       End If
  625.     Next i%
  626.  
  627.   Else
  628.     For i% = 1 To iNumPoints(iObjectType(ObjNum))
  629.       If iPz(i%) < 0 Then
  630.         XView.ViewPic.PSet (iPx(i%), iPy(i%)), QBColor(iColor(ObjNum))
  631.       End If
  632.       PxOld(ObjNum, i%) = iPx(i%)
  633.       PyOld(ObjNum, i%) = iPy(i%)
  634.       PzOld(ObjNum, i%) = iPz(i%)
  635.     Next i%
  636.   End If
  637.  
  638. End Select
  639.  
  640. PlaceObjectResume:
  641.  
  642. Exit Sub
  643.  
  644. PlaceObjectHandler:
  645.  
  646.   Resume PlaceObjectResume
  647.  
  648. End Sub
  649.  
  650. Sub SpinCube ()
  651.  
  652.   'There is a blue rotating wireframe cube orbiting in cyberspace.
  653.   'The cube's angle of rotation is its SpinAngle.
  654.   'The cube orbits around the cyberspace origin (0, 0, 0) at a radius of 3000 CLUs.
  655.   'The cube's position in its orbit is its OrbitAngle.
  656.   
  657.   Static OrbitAngle As Integer
  658.   Static SpinAngle As Integer
  659.   
  660.   'Spin and orbit the cube:
  661.   Do While XView.SCCheck.value = 1
  662.  
  663.     OrbitAngle = OrbitAngle + 1
  664.     SpinAngle = SpinAngle + 5
  665.  
  666.     If OrbitAngle = 360 Then OrbitAngle = 0
  667.     If SpinAngle = 360 Then SpinAngle = 0
  668.  
  669.     Temp1# = (SpinAngle - 180) * sfPi / 180
  670.     Temp2! = (OrbitAngle - 180) * sfPi / 180
  671.  
  672.     For i% = 1 To 8
  673.  
  674.       X# = iObjectX(1, i%)
  675.       Y# = iObjectY(1, i%)
  676.       Z# = iObjectZ(1, i%)
  677.  
  678.       SolidRotate 0, 0, 0, 0, 1, 0, X#, Y#, Z#, Temp1#
  679.     
  680.       iObjectX(44, i%) = CInt(X#)
  681.       iObjectY(44, i%) = CInt(Y#)
  682.       iObjectZ(44, i%) = CInt(Z#)
  683.  
  684.       iLocationX(iSCNum) = 3000 * Cos(Temp2!)
  685.       iLocationZ(iSCNum) = 3000 * Sin(Temp2!)
  686.  
  687.     Next i%
  688.     
  689.     PlaceAllObjects
  690.     np% = DoEvents()
  691.  
  692.   Loop
  693.  
  694. End Sub
  695.  
  696.