Option Explicit
' Defined in Module Complex to Color:
'
'  Functions:
'    IHS
'    GetColor
'    Phase1

Function Phase1(X As Double, y As Double) As Double
  Dim Angle As Double
  Const Pi As Double = 3.14159265358979
  If X = 0 Then
    If y > 0 Then
      Angle = Pi / 2
    Else
      Angle = -Pi / 2
    End If
  Else
    Angle = Atn(y / X)
  End If
  If X < 0 Then
    Angle = Angle + Pi
  End If
  If Angle < 0 Then
    Angle = Angle + 2 * Pi
  End If
'
' Change scale from 0 - 2pi to 0 - 6 to prepare for IHS conversion to RGB
'
  Angle = Angle * 3 / Pi
  If Angle = 6 Then
    Angle = 0
  End If
  Phase1 = Angle
End Function


Function IHS(Inten As Double, Hue As Double, Sat As Double) As Long
  Dim IHue As Integer, I As Integer, K As Integer
  Dim R As Integer, B As Integer, G As Integer
  Dim RHue As Double
  I = Round(255 * Inten)
  K = Round(I * (1# - Sat))
  RHue = Hue
  IHue = Int(RHue)
  RHue = RHue - IHue
  Select Case IHue
    Case 0
      R = I
      G = Round(I * Sat * RHue * RHue * (3 - 2 * RHue)) + K
      B = K
    Case 1
      G = I
      R = Round(I * Sat * (1 + RHue * RHue * (2 * RHue - 3))) + K
      B = K
    Case 2
      G = I
      B = Round(I * Sat * RHue * RHue * (3 - 2 * RHue)) + K
      R = K
    Case 3
      B = I
      G = Round(I * Sat * (1 + RHue * RHue * (2 * RHue - 3))) + K
      R = K
     Case 4
      B = I
      R = Round(I * Sat * RHue * RHue * (3 - 2 * RHue)) + K
      G = K
    Case 5
      R = I
      B = Round(I * Sat * (1 + RHue * RHue * (2 * RHue - 3))) + K
      G = K
  End Select
  IHS = RGB(R, G, B)
End Function
Function GetColor(Zr As Double, Zi As Double) As Long
' GetColor returns Visual Basic long integer packing of R G B
'      corresponding to complex value Z
  Dim D As Double, Inten As Double, Sat As Double
  Dim K As Integer
  Const Int0 = 0.6, Sat0 = 0.3
  D = Sqr(Zr * Zr + Zi * Zi)
  If (D >= 1) Then
    D = Log(D)
  End If
  D = 4 * (D - Int(D))
  K = Int(D)
  D = D - K
  Select Case K
    Case 0
      Inten = 0.99
      Sat = 0.99 - (0.99 - Sat0) * D
    Case 1
      Inten = 0.99 - (0.99 - Int0) * D
      Sat = Sat0
    Case 2
      Inten = Int0
      Sat = 0.99 - (0.99 - Sat0) * (1 - D)
    Case 3
      Inten = 0.99 - (0.99 - Int0) * (1 - D)
      Sat = 0.99
  End Select
  GetColor = IHS(Inten, Phase1(Zr, Zi), Sat)
End Function