Attribute VB_Name = "Module1"
'******************************************************
'*    Module to draw a 2D-curve with manual scaling   *
'* -------------------------------------------------- *
'* REFERENCE:                                         *
'*  From Pascal unit GRAPH2D By Robert DONY,          *
'* "Graphisme dans le plan et dans l'espace en Turbo  *
'*  Pascal 4.0, MASSON 1990" [BIBLI 12].              *
'*                                                    *
'*     Visual Basic 4.0 release by J-P Moreau, Paris  *
'*                    (www.jpmoreau.fr)               *
'******************************************************
Public MaxX As Integer, MaxY As Integer
Public xgfen As Double, xdfen As Double
Public ybfen As Double, yhfen As Double
Public xgclot As Integer, xdclot As Integer
Public ybclot As Integer, yhclot As Integer
Public xrapport As Double, yrapport As Double
Public xorig As Double, yorig As Double, corx As Double, cory As Double
Public xp1 As Double, xp2 As Double, yp1 As Double, yp2 As Double


'Draw axes Ox, Oy
Sub Axes()
  If xgfen * xdfen < 0# Then xorig = 0# Else xorig = xgfen
  If ybfen * yhfen < 0# Then yorig = 0# Else yorig = ybfen
  MoveXY xgfen, yorig
  LineXY xdfen, yorig
  MoveXY xorig, ybfen
  LineXY xorig, yhfen
End Sub

'Draw a frame around client zone
Sub Bordure()
  MoveXY xgfen, ybfen
  LineXY xdfen, ybfen
  LineXY xdfen, yhfen
  LineXY xgfen, yhfen
  LineXY xgfen, ybfen
End Sub

'define a drawing zone in pixels inside main window.
Sub Cloture(ByVal c1 As Integer, ByVal c2 As Integer, ByVal c3 As Integer, ByVal c4 As Integer)
  xgclot = c1
  xdclot = c2
  ybclot = c3
  yhclot = c4
  xrapport = (xdclot - xgclot) / (xdfen - xgfen)
  yrapport = (yhclot - ybclot) / (yhfen - ybfen)
End Sub


'clipping utility function
Function Codebin(ByVal x As Double, ByVal y As Double) As Integer
Dim c As Integer
  c = 0                      'if point (x,y) is:
  If x < xgfen Then          ' visible, return 0
    c = 1                    ' upwards, return 1000
  ElseIf x > xdfen Then      ' right upper, 1010
    c = 10                   ' to the right, 10
  End If                     ' right lower, 110
  If y < ybfen Then          ' downwards, 100
    c = c + 100              ' left lower, 101
  ElseIf y > yhfen Then      ' to the left, 1
    c = c + 1000             ' left upper, 1001
  End If
  Codebin = c
End Function

'Used by Graduate()
Sub correctX(xorig As Double, xgfen As Double, unitx As Double)
Dim ntir As Double
  If xorig = 0 Then
    ntir = (xorig - xgfen) / unitx
    corx = (ntir - Int(ntir)) * unitx
  ElseIf xorig > 0 Then
    corx = (xorig / unitx + 1) * unitx - xorig
  Else
    corx = Abs(xorig) + (xorig / unitx) * unitx
  End If
End Sub

'Used by Graduate()
Sub correctY(yorig As Double, ybfen As Double, unity As Double)
Dim ntir As Double
  If yorig = 0 Then
    ntir = (yorig - ybfen) / unity
    cory = (ntir - Int(ntir)) * unity
  ElseIf yorig > 0 Then
    cory = Int(yorig / unity + 1) * unity - yorig
  Else
    cory = Abs(yorig) + Int(yorig / unity) * unity
  End If
End Sub

'main clipping subroutine
Sub Decoupage(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double)
Dim x As Double, y As Double
Dim xx1 As Integer, xx2 As Integer, yy1 As Integer, yy2 As Integer
Dim c As Integer, c1 As Integer, c2 As Integer

    c1 = Codebin(x1, y1)
    c2 = Codebin(x2, y2)
    Do While (c1 <> 0) Or (c2 <> 0)       'a segment is visible
      If c1 <> 0 And c2 <> 0 Then GoTo 10 'nothing visible
      If c1 = 0 Then c = c2 Else c = c1
      If (c = 1) Or (c = 101) Or (c = 1001) Then
        x = xgfen
        y = y1 + (y2 - y1) * (xgfen - x1) / (x2 - x1)
      ElseIf (c = 10) Or (c = 110) Or (c = 1010) Then
        x = xdfen
        y = y1 + (y2 - y1) * (xdfen - x1) / (x2 - x1)
      ElseIf (c = 100) Or (c = 101) Or (c = 110) Then
        y = ybfen
        x = x1 + (x2 - x1) * (ybfen - y1) / (y2 - y1)
      ElseIf (c = 1000) Or (c = 1001) Or (c = 1010) Then
        y = yhfen
        x = x1 + (x2 - x1) * (yhfen - y1) / (y2 - y1)
      End If
      If c = c1 Then
        x1 = x: y1 = y
        c1 = Codebin(x, y)
      Else
        x2 = x: y2 = y
        c2 = Codebin(x, y)
      End If
    Loop
    xx1 = Int(0.5 + (x1 - xgfen) * xrapport)
    yy1 = Int(0.5 + (yhfen - y1) * yrapport)
    xx2 = Int(0.5 + (x2 - xgfen) * xrapport)
    yy2 = Int(0.5 + (yhfen - y2) * yrapport)
    'draw the visible part of line (x1,y1,x2,y2)
    Form1.Line (xgclot + xx1, MaxY - yhclot + yy1)-(xgclot + xx2, MaxY - yhclot + yy2)
    
10 End Sub

'move cursor to physical point (x,y)
Sub MoveXY(ByVal x As Double, ByVal y As Double)
  xp1 = x: yp1 = y
End Sub


Sub Cercle(xc As Double, yc As Double, r As Double, trait As Boolean)
'algorithm to draw a circle in physical coordinates
'(dotted line or normal line}
'xc,yc: center - r:radius
'trait = true: solid line
'trait = false: dotted line
Dim dx As Double, s As Double, c As Double
Dim x As Double, y As Double, aux As Double
Dim pi As Double
Dim n As Integer
  pi = 3.1415926535
  s = Sin(pi / 36): c = Cos(pi / 36): dx = r / 50
  x = xc + r: y = yc
  MoveXY x, y
  For n = 2 To 74
    aux = xc + (x - xc) * c - (y - yc) * s
    y = yc + (y - yc) * c + (x - xc) * s
    x = aux
    If Not trait Then    'dotted line
      MoveXY x, y
      LineXY x + dx, y
    Else                 'normal line
      LineXY x, y
    End If
  Next n
End Sub

Sub Circle1(ByVal xc#, ByVal yc#, ByVal R#, ByVal trait As Boolean)
' Faster algorithm to draw a circle in
' physical coordinates in dotted line
' or normal line; read the values of
' cos(kpi/30) and sin(kpi/30) in T1 table
Dim T1(120) As Double
Dim X As Double, Y As Double
  'initialize table T1
  pi = 3.1415926535
  dt = pi / 30#: T = 0#
  For i = 1 To 60
    T = T + dt
    T1(i) = Cos(T)
    T1(i + 60) = Sin(T)
  Next i
  dx = R / 30#
  C = 1#
  X = xc + R: Y = yc
  MoveXY X, Y
  For i = 1 To 60
    X = xc + R * T1(i)
    Y = yc + C * R * T1(i + 60)
    If trait = False Then    'dotted line
      MoveXY X, Y
      LineXY X + dx, Y
    Else                     'normal line
      LineXY X, Y
    End If
  Next i
End Sub

'print string S at location (x,y)
Sub Display(x As Integer, y As Integer, s As String)
  Form1.CurrentX = x
  Form1.CurrentY = y
  Form1.Print s
End Sub

'define drawing zone in physical coordinates
Sub Fenetre(ByVal x1 As Double, ByVal x2 As Double, ByVal y1 As Double, ByVal y2 As Double)
  xgfen = x1: xdfen = x2: ybfen = y1: yhfen = y2
End Sub

' graduation of axes with steps unitx and unity
Sub Graduate(unitx As Double, unity As Double)
Dim x As Double, y As Double
Dim tiretx As Double, tirety As Double
Dim xx As Integer, yy As Integer
Dim mot As String
    tiretx = (xdfen - xgfen) / 200
    tirety = (yhfen - ybfen) / 200

    If unitx > 0 Then
      correctX xorig, xgfen, unitx
      x = xgfen + corx
      Do
        MoveXY x, yorig + tirety
        LineXY x, yorig - 2 * tirety
        mot = Str$(x)
        xx = xgclot + Int((x - xgfen) * xrapport)
        Display xx - 75, MaxY - ybclot + 50, mot
        x = x + unitx
      Loop Until x > 1.05 * xdfen
    End If

    If unity > 0 Then
      correctY yorig, ybfen, unity
      y = ybfen
      Do
        MoveXY xorig - tiretx, y
        LineXY xorig + 2 * tiretx, y
        mot = Str$(y)
        yy = MaxY - yhclot + Int((yhfen - y) * yrapport)
        Display 250, yy - 75, mot
        y = y + unity
      Loop Until y > yhfen
    End If
End Sub

'draw a grid with steps unitx and unity
Sub Grid(unitx As Double, unity As Double)
Dim i As Double
    Form1.DrawStyle = 2
    Form1.ForeColor = RGB(255, 0, 0)  ' red
    i = xgfen                         ' vertical grid
    Do
      MoveXY i, ybfen
      LineXY i, yhfen
      i = i + unitx
    Loop While i <= xdfen

    i = ybfen                         ' horizontal grid
    Do
      MoveXY xgfen, i
      LineXY xdfen, i
      i = i + unity
    Loop While i <= yhfen
    Form1.DrawStyle = 0
    Form1.ForeColor = RGB(0, 0, 255)  ' blue
End Sub

'draw a line from current cursor to physical point
''x,y) with clipping.
Sub LineXY(ByVal x As Double, ByVal y As Double)
  xp2 = x: yp2 = y
  Decoupage xp1, yp1, xp2, yp2
  xp1 = xp2: yp1 = yp2
End Sub