Attribute VB_Name = "Module2"
 '*************************************************************************
 '*                          DRAW  2D CURVES                              *
 '* --------------------------------------------------------------------- *
 '* This program can draw 2D curves that can be defined as:               *
 '*              1)  Y = F(X)                                             *
 '*              2)  Rho = F(T)                                           *
 '*              3)  X = F(T) and Y = G(T)                                *
 '* --------------------------------------------------------------------- *
 '* Reference:                                                            *
 '*  From "Graphisme dans le plan et dans l'espace avec Turbo Pascal 4.0  *
 '*        de R. Dony - MASSON 1990 page 113" [BIBLI 12].                 *
 '*                                                                       *
 '*                       Visual Basic 4.0 Release By J-P Moreau, Paris.  *
 '*                                     (www.jpmoreau.fr)                 *
 '*************************************************************************
 'Program MULTIFUNC
 DefInt I-N

 Public a, b, pas
 Public valdep, valarr
 Public incr As Single
 Public periode, rmax
 Public kind
 Public choix As Integer
 
 Private ux, uy, X, y
 Private fmin, fmax
 Private c1 As Integer
 Private c2 As Integer
 Private c3 As Integer
 Private c4 As Integer
 Private dx, dy
 Private xdep, ydep, xcour, ycour
 Private theta
 
 Const pi = 3.1415926535


 Sub SeekPeriod()
 'Seek period of a polar or parametric curve
 Dim max As Single
   max = 200 * pi
   periode = 0
   Select Case kind
     Case 2
       xdep = AFunction(periode)  'xdep=Rho(periode)
       ydep = 0
     Case 3
       xdep = AFunction(periode)  'xdep=FX(periode)
       ydep = AFunction1(periode) 'ydep=FY(periode)
   End Select
10 periode = periode + 2 * pi
     Select Case kind
       Case 2
         r = AFunction(periode)      'r=Rho(periode)
         xcour = r * Cos(periode)
         ycour = r * Sin(periode)
       Case 3
         xcour = AFunction(periode)  'xcour=FX(periode)
         ycour = AFunction1(periode) 'ycour=FY(periode)
     End Select
     diff1 = Abs(xcour - xdep)
     diff2 = Abs(ycour - ydep)
     'conditions to exit loop
     If ((diff1 < 0.000001) And (diff2 < 0.000001)) Or (periode > max) Then Exit Sub
     GoTo 10
 End Sub

 Sub MaxRadius()
 'Seek maximum radius of a polar or parametric curve
   rmax = 0
   t = valdep
   While t <= valarr
     Select Case kind
       Case 2
         r = AFunction(periode) 'r=Rho(periode)
         xcour = r * Cos(periode)
         ycour = r * Sin(periode)
       Case 3
         xcour = AFunction(t)   'xcour=FX(t)
         ycour = AFunction1(t)  'ycour=FY(t)
     End Select
     If Abs(xcour) > rmax Then rmax = Abs(xcour)
     If Abs(ycour) > rmax Then rmax = Abs(ycour)
     t = t + incr
   Wend
   rmax = 1.1 * rmax
 End Sub

 Sub Data()
   '3 kinds available (angles in radians):
   '  1 : Y = F(X)
   '  2 : Rho = F(T)
   '  3 : X = FX(T) and Y = FY(T)
   'See Form2 Dialog Box
   Select Case kind
     Case 1    'y=F(x)
       vrbl(0) = "X": Formule(0) = "0": num = 1
     Case 2, 3 'Polar (2) or parametric (3)
       vrbl(0) = "T": Formule(0) = "0": num = 1
       If choix = 1 Then  'Periodic
         If periode = 0 Then SeekPeriod
         valdep = 0: valarr = periode
         incr = periode / 511  '512 pts
       End If
       If rmax = 0 Then MaxRadius
   End Select
 End Sub

 Sub DrawCurveXY()
 'Draw a curve Y = F(X)
   X = a: y = AFunction(X) 'See module 3
   MoveXY X, y             'See module 1
   While X <= b
     y = AFunction(X)
     LineXY 0, X, y
     X = X + pas
   Wend
 End Sub
 
 Sub DrawParamCurve()
 'Draw a polar or parametric curve
   iround = 1
   t = valdep
   Select Case kind
     Case 2
       r = AFunction(t)
       x1 = r * Cos(t)
       y1 = iround * r * Sin(t)
     Case 3
       x1 = AFunction(t)
       y1 = iround * AFunction1(t)
   End Select
   MoveXY x1, y1
   While t <= valarr
     t = t + incr
     Select Case kind
       Case 2
         r = AFunction(t)
         x2 = r * Cos(t)
         y2 = iround * r * Sin(t)
       Case 3
         x2 = AFunction(t)
         y2 = iround * AFunction1(t)
     End Select
     LineXY 0, x2, y2
   Wend
   'Display Period and Rmax (optional)
   Display 0, Int(0.9 * MaxX), Int(0.1 * MaxY), "Period: " + Str$(periode)
   Display 0, Int(0.9 * MaxX), Int(0.15 * MaxY), "Rmax: " + Str$(rmax)
 End Sub


 Sub Exec_2DCurve()
 'Main subroutine
   Form1.AutoRedraw = True
   Form2.Show 1  'open data dialog box
   Data
   EchAuto = 1        'Automatic scales in Ox, Oy
   Select Case kind
     Case 1           'Cartesian
       Form1.Cls
       fmin = 1E+16: fmax = -1E+16: dx = (b - a) / 10
       ReDim V(1024)
       X = a: y = AFunction(X): i = 0: V(0) = y: ndata = 1
       While X <= b
         y = AFunction(X)
         i = i + 1
         If i < 1025 Then
           V(i) = y: ndata = i
         End If
         If y < fmin Then fmin = y
         If y > fmax Then fmax = y
         X = X + pas
       Wend
       InitWindow 0, 10, a, b, fmin, fmax 'See module 1
       DrawCurveXY
       Legends 0, 10, Formule(2), "X", "Y"
       'Optional: Store curve F(X) to disk (format *.SGN)
       Form1.Dialogue.Filter = "Courbes F(t) ( *.SGN ) | *.sgn"
       Form1.Dialogue.Flags = cdlOFNCreatePrompt Or cdlOFNShowHelp
       Form1.Dialogue.ShowSave
       nom1$ = Form1.Dialogue.filename
       If Mid$(nom1$, Len(nom1$) - 3, 1) <> "." Then nom1$ = nom1$ + ".SGN"
       DiskWriteData nom1$, ndata, a, b, Formule(2), " X", " Y" 'See module 3
     Case 2, 3
       Form1.Cls
       InitWindow 0, 10, -rmax, rmax, -rmax, rmax
       DrawParamCurve
       If kind = 2 Then  'Polar
         Legends 0, 10, "Rho=" + Formule(2), "X", "Y"
       Else              'Parametric
         Legends 0, 10, "X=" + Formule(2) + " Y=" + Formule(3), "X", "Y"
       End If
   End Select

 End Sub