Attribute VB_Name = "Module2"
'*************************************************************
'*         Subroutines in Basic to draw a 3D surface         *
'* --------------------------------------------------------- *
'* From Pascal Unit GRAPH3D.PAS By Robert DONY - MASSON 1990 *
'* "Graphisme dans le plan et dans l'espace en Turbo Pascal  *
'*  4.0" [BIBLI 12].                                         *
'*                                                           * 
'*         Adapted to Visual Basic By J-P Moreau, june 2004. *
'*                         (www.jpmoreau.fr)                 *
'*************************************************************
DefInt I-N

Const blanc = 15  'white
Const noir = 0    'black
Const bleu = 9    'blue
Const jaune = 14  'yellow

Const echelle = 1!

'projection kinds
Public projection As Integer    '1=perspective, 2=parallel

Public rho As Single
Public theta As Single
Public phi As Single
Public de As Single
Public aux1 As Single
Public aux2 As Single
Public aux3 As Single
Public aux4 As Single
Public aux5 As Single
Public aux6 As Single
Public aux7 As Single
Public aux8 As Single
Public xobs As Single
Public yobs As Single
Public zobs As Single
Public xproj As Single
Public yproj As Single
Public xecran As Integer
Public yecran As Integer
Public xgclot As Integer
Public xdclot As Integer
Public ybclot As Integer
Public yhclot As Integer
Public ferme As Integer    '0=open; 1=closed
Public nbrecoul As Integer

Public MaxX As Integer     'max. pixels in screen Ox, Oy
Public MaxY As Integer

Public xcour As Integer    'current screen ccordinates
Public ycour As Integer

'print string s at location X, Y
Sub Display(fp As Integer, x As Integer, y As Integer, s As String)
  If Not fp Then
    Form1.CurrentX = x
    Form1.CurrentY = y
    Form1.Print s
  Else
    Printer.CurrentX = x
    Printer.CurrentY = y
    Printer.Print s
  End If
End Sub

Sub Cloture(ic1, ic2, ic3, ic4)
  xgclot = ic1
  xdclot = ic2
  ybclot = ic3
  yhclot = ic4
End Sub

Sub InitProj()  'calculate auxiliary variables
  PI = 3.1415926535
  th = PI * theta / 180#: ph = PI * phi / 180#
  aux1 = Sin(th): aux2 = Sin(ph): aux3 = Cos(th): aux4 = Cos(ph)
  aux5 = aux3 * aux2: aux6 = aux1 * aux2: aux7 = aux3 * aux4: aux8 = aux1 * aux4
End Sub

Sub Project(x, y, z)
  xobs = -x * aux1 + y * aux3: yobs = -x * aux5 - y * aux6 + z * aux4
  If projection = 1 Then
    zobs = -x * aux7 - y * aux8 - z * aux2 + rho
    xproj = de * xobs / zobs: yproj = de * yobs / zobs
  Else
    xproj = de * xobs: yproj = de * yobs
  End If
End Sub


Sub DrawXYZ(x, y, z)
  Project x, y, z
  xecran = Int(xproj * echelle + (MaxX / 2))
  yecran = Int((MaxY / 2) - yproj)
  Form1.Line (xcour, ycour)-(xecran, yecran)
  xcour = xecran: ycour = yecran
End Sub

Sub MoveXYZ(x, y, z)
  Project x, y, z
  xcour = Int(xproj * echelle + MaxX / 2)
  ycour = Int(MaxY / 2 - yproj)
End Sub

Sub Border(margin)
  Form1.Line (margin, margin)-(MaxX - margin, MaxY - margin), , B
End Sub

Sub Axes(x, y, z)  'draw axes
  MoveXYZ 0, 0, 0: DrawXYZ x, 0, 0
  xecran = xecran + 5: yecran = yecran + 5
  Display 0, xecran, yecran, "X"
  MoveXYZ 0, 0, 0: DrawXYZ 0, y, 0
  xecran = xecran + 5: yecran = yecran + 5
  Display 0, xecran, yecran, "Y"
  MoveXYZ 0, 0, 0: DrawXYZ 0, 0, z
  xecran = xecran + 10: yecran = yecran + 5
  Display 0, xecran, yecran, "Z"
End Sub