VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00000000&
   Caption         =   "Form1"
   ClientHeight    =   6510
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8865
   ClipControls    =   0   'False
   FillStyle       =   0  'Solid
   BeginProperty Font 
      Name            =   "Arial"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H0000FF00&
   Icon            =   "RNDemoMC.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   434
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   591
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer Timer1 
      Interval        =   25
      Left            =   8280
      Top             =   120
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 0

#Const AlwaysRenderText = True

Private xHasLS As Boolean
Private xLSData(359) As Single

Private TotalMul As Single

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
  End Type

Private xBack As RECT
Private xCol(360 * 4) As Long
Private xRct(360 * 4 * 2) As RECT
Private xCnt As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const MyText As String = "LineSpec VB6 example"
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Any) As Long
Private Declare Function TextOutA Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

Private Function SplitCol(ByVal Saturation As Single, ByVal Phase As Long) As Long
  Dim BeamR As Long
  Dim BeamG As Long
  Dim BeamB As Long
  Dim BeamS As Long
  
  
  'TotalMul = 1
  'BeamS = 64& * TotalMul

  
  If Saturation > TotalMul Then Saturation = TotalMul
  BeamS = Sqr(1 - Saturation) * 80 * TotalMul
  'Saturation = Saturation + 0.4

'If Saturation > 0.3 Then Stop
  Select Case Phase
    Case 0& To 255&
      BeamR = BeamR
      BeamG = Saturation * Phase + BeamS
      If BeamG > 255& Then BeamG = 255&
      BeamB = Saturation * (255& - Phase) + BeamS
      If BeamB > 255& Then BeamB = 255&
    Case 256& To 510&
      BeamR = Saturation * (Phase - 255&) + BeamS
      If BeamR > 255& Then BeamR = 255&
      BeamG = Saturation * (511& - Phase) + BeamS
      If BeamG > 255& Then BeamG = 255&
      BeamB = BeamS
    Case 511& To 765&
      BeamR = Saturation * (766& - Phase) + BeamS
      If BeamR > 255& Then BeamR = 255&
      BeamG = BeamS
      BeamB = Saturation * (Phase - 510&) + BeamS
      If BeamB > 255& Then BeamB = 255&
    End Select

  SplitCol = BeamB * &H10000 + BeamG * &H100& + BeamR
  'Stop
  End Function

Private Sub RenderAdd(ByVal PosX As Long, ByVal PosY As Long, ByVal Saturation As Single, ByVal Phase As Long)
  Dim xSize As Long
  Dim Col As Long

  Saturation = Saturation * 100 * TotalMul
  xSize = Saturation
  If xSize > 7 Then xSize = 7
  If xSize < 1 Then xSize = 1
  If xSize > 1 Then Saturation = Saturation / (xSize - 1&)
  Col = SplitCol(Saturation, Phase)

  If Not Col = 0& Then
    With xRct(xCnt)
      .Left = PosX - xSize / 2
      .Top = PosY - xSize / 2
      .Right = .Left + xSize
      .Bottom = .Top + xSize
      End With
    xCol(xCnt) = Col
    xCnt = xCnt + 1&
    End If
  End Sub

Private Sub RenderNow(ByVal TextColor As Long, ByVal TextSize As Long)
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xPosX As Long
  Dim xPosY As Long
  Dim hBrush As Long
  Dim xType1 As RECT
  
  If Not TextColor = 0& Then
    'Me.ForeColor = TextColor * &H10101
    Me.Font.Size = TextSize ' 90 * xWZ / xW
    Call GetTextExtentPoint32(Me.hdc, MyText, Len(MyText), xType1)
    xPosX = (Me.ScaleWidth - xType1.Left) / 2
    xPosY = (Me.ScaleHeight - xType1.Top) / 2
    End If




  Me.Cls
  If Not TextColor = 0& Then
    Me.ForeColor = TextColor * &H10101
    Call TextOutA(Me.hdc, xPosX, xPosY, MyText, Len(MyText))
    End If
    
  
  
  For xLong1 = 0& To xCnt - 1&
    'Stop
    hBrush = CreateSolidBrush(xCol(xLong1))
    If Not hBrush = 0& Then
      Call FillRect(Me.hdc, xRct(xLong1), hBrush)
      Call DeleteObject(hBrush)
      End If
    Next
  
  If Not TextColor = 0& Then
    Call TextOutA(Me.hdc, xPosX, xPosY, MyText, Len(MyText))
    End If
  xCnt = 0&
  End Sub


Private Sub Form_DblClick()
  Unload Me
  End Sub

Private Sub Form_Load()
  'Dim xLong1 As Long

  On Error Resume Next
  xHasLS = LineSpec_Startup(0&)
  On Error GoTo 0
  'If Not xHasLS Then
    'For xLong1 = 0& To 359&
    '  xLSData(xLong1) = 0.05
    '  Next
    'End If
  End Sub

Private Sub Form_Unload(Cancel As Integer)
  If xHasLS Then
    Call LineSpec_Shutdown
    End If
  End Sub

Private Function xMOD360(ByVal xSng1 As Single) As Single
  'Stop
  xMOD360 = Fix(xSng1 / 360) * 360
  xMOD360 = xSng1 - xMOD360
End Function

Private Sub Timer1_Timer()
  Dim xLong1 As Single
  Dim Index As Long
  Dim xLong2 As Long
  Dim xLong3 As Long
  Dim xLong2b As Long
  Dim xLong3b As Long
  Dim xW As Long
  Dim xWZ As Long
  Dim xH As Long
  Dim xHZ As Long
  Dim xS1 As Single
  Dim xS2 As Single
  Dim xRX As Single
  Dim xRY As Single
  Dim xStep2 As Long
  Dim xCol As Single
  Dim PreStep As Single
  Static xStep As Long
  'Static xRep As Long
  Static xProg As Long
  Const PI As Single = 3.1415926536
  Dim xLSDataS As Single
  'Dim xType1 As RECT
  #If Not AlwaysRenderText Then
    Dim FontColor As Long
    #End If
  Static xFirst As Boolean
  
'Static xBool1 As Boolean
'If Not xBool1 Then xProg = 3: xBool1 = True
  
  If xHasLS Then
    Call LineSpec_GetSpectrum(xLSData(0), 360, 0&, 2&, 1&)
    Call LineSpec_GetSpectrum(xLSDataS, 1, 0&, 3&, 1&)
    End If
  
  
  xStep = (xStep + 1&) Mod 360&
  If xStep = 0 Then
'Stop
    xFirst = True
    TotalMul = 1
    xStep = 0&
    xProg = (xProg + 1&) Mod 8&
    'xProg = xProg + 1
    'If xProg = 5 Then xProg = 3
    'xpro
    End If
  
  'Me.Caption = Str(xStep) + " / " + Str(xRep) + " / " + Str(xProg)
  'Me.Caption = Str(xStep) + " / " + Str(xProg)
  
  
  xW = Me.ScaleWidth / 2
  xH = Me.ScaleHeight / 2
  xWZ = xW * (Fix(xLSDataS * 10 * TotalMul) / 3 + 0.5) / 1.5
  xHZ = xH * (Fix(xLSDataS * 10 * TotalMul) / 3 + 0.5) / 1.5
  PreStep = (xLSDataS * 120 * TotalMul + 0.25)
  #If Not AlwaysRenderText Then
    FontColor = 0&
    #End If
  
  'xProg = (xProg Mod 2) + 2
  'xStep = 350
'If xProg < 5 Then xProg = 6
'xProg = 6 - (xProg Mod 2)
'xProg = 6 + (xProg Mod 2)
'If xProg < 4 Or xProg > 6 Then
'  xProg = 4
'  End If
'TotalMul = 1
'xStep = (xStep Mod 120) + 240
'xStep = xStep + 4
'xStep = 359
'xProg = 5
'TotalMul = 1

  Select Case xProg
    Case 0
      For xLong1 = 0& To 359.75 Step 0.25
        xStep2 = xMOD360(xLong1 + xStep + PreStep)
        xS1 = 8 * xLong1 / 360 / (xStep2 / 4 + 1)
        'xS1 = 8 / (xStep2 / 4 + 1)
        xS2 = 2
        xS1 = (xStep / 360) * xS2 + (1 - (xStep / 360)) * xS1
'        xS = 20 / (xStep2 / 4 + 1)
        If xStep2 > 180 Then xStep2 = 360 - xStep2
        xRX = Sin(xStep2 / 180 * PI)
        xRY = Cos(xLong1 * 2 / 180 * PI)
        xLong2 = xW + xWZ * Cos(xStep2 / 180 * PI) * xRX - xS1 / 2
        xLong3 = xH + xHZ * Sin(xLong1 / 180 * PI) * xRY - xS1 / 2
'        Stop
        If Not xFirst Then
'          Stop
          TotalMul = xStep / 360
          End If
        Call RenderAdd(xLong2, xLong3, xLSData(Fix(xLong1)), Fix(xLong1 / 360 * 766))
        Next
    Case 1
      xS1 = 2
      For xLong1 = 0& To 359.75 Step 0.25
        xStep2 = xMOD360(xLong1 + xStep + PreStep)
        If xStep2 > 180 Then xStep2 = 360 - xStep2
        
        xRX = Cos(xStep2 / 180 * PI)
        xRY = Sin(xLong1 * 2 / 180 * PI)
        xLong2b = (xW - xWZ) + xWZ * 2 * Cos(xStep2 / 180 * PI) * xRX - xS1 / 2
        xLong3b = xH + xHZ * Sin(xLong1 / 180 * PI) * xRY - xS1 / 2
        
        xRX = Sin(xStep2 / 180 * PI)
        xRY = Cos(xLong1 * 2 / 180 * PI)
        xLong2 = xW + xWZ * Cos(xStep2 / 180 * PI) * xRX - xS1 / 2
        xLong3 = xH + xHZ * Sin(xLong1 / 180 * PI) * xRY - xS1 / 2
        
        xLong2 = (xStep / 360) * xLong2b + (1 - (xStep / 360)) * xLong2
        xLong3 = (xStep / 360) * xLong3b + (1 - (xStep / 360)) * xLong3
        
        Call RenderAdd(xLong2, xLong3, xLSData(Fix(xLong1)), Fix(xLong1 / 360 * 766))
        Next
    Case 2
      xS1 = 2
      For xLong1 = 0& To 359.75 Step 0.25
        xStep2 = xMOD360(xLong1 + xStep + PreStep)
        If xStep2 > 180 Then xStep2 = 360 - xStep2
        
        xRX = Cos(xStep2 / 180 * PI)
        xRY = Sin(xLong1 * 2 / 180 * PI)
        xLong2b = (xW - xWZ) + xWZ * 2 * Cos(xStep2 / 180 * PI) * xRX - xS1 / 2
        xLong3b = xH + xHZ * Sin(xLong1 / 180 * PI) * xRY - xS1 / 2
        
        xRX = Cos(xStep2 * (xStep) / 60 / 180 * PI)
        xRY = Atn(xStep2 / 180 * PI)
        xLong2 = xW + xWZ * xRX * Cos(xStep2 * 2 / 180 * PI) * xRX - xS1 / 2
        xLong3 = xH + xHZ * xRY * Sin(xLong1 * 2 / 180 * PI) * xRY - xS1 / 2
       
        
        xLong2 = (xStep / 360) * xLong2 + (1 - (xStep / 360)) * xLong2b
        xLong3 = (xStep / 360) * xLong3 + (1 - (xStep / 360)) * xLong3b
        
        Call RenderAdd(xLong2, xLong3, xLSData(Fix(xLong1)), Fix(xLong1 / 360 * 766))
        Next
    Case 3
      xS1 = 2
      For xLong1 = 0& To 359.75 Step 0.25
        xStep2 = xMOD360(xLong1 + xStep + PreStep)
        If xStep2 > 180 Then xStep2 = 360 - xStep2
        
        xRX = Cos(xStep2 * (360 - xStep) / 60 / 180 * PI)
        xRY = Atn(xStep2 / 180 * PI)
        xLong2 = xW + xWZ * xRX * Cos(xStep2 * 2 / 180 * PI) * xRX - xS1 / 2
        xLong3 = xH + xHZ * xRY * Sin(xLong1 * 2 / 180 * PI) * xRY - xS1 / 2
        
'        xLong2 = (xStep / 360) * xLong2b + (1 - (xStep / 360)) * xLong2
'        xLong3 = (xStep / 360) * xLong3b + (1 - (xStep / 360)) * xLong3
        
        Call RenderAdd(xLong2, xLong3, xLSData(Fix(xLong1)), Fix(xLong1 / 360 * 766))
        Next
    Case 4
      xS1 = 2
      For xLong1 = 0& To 359.75 Step 0.25
        xStep2 = xMOD360(xLong1 + xStep + PreStep)
        If xStep2 > 180 Then xStep2 = 360 - xStep2
        
        xRX = Cos(xStep2 * xStep / 60 / 180 * PI)
        xRY = Atn(xStep2 / 180 * PI)
        
        If xStep < 60 Then
          xS2 = xW * 0.75 * (xStep / 60) + xWZ * ((60 - xStep) / 60)
          Else
          xS2 = xW * 0.74
          End If
        
        xLong2b = xW + xWZ * xRX * Cos(xStep2 * 2 / 180 * PI) * xRX - xS1 / 2
        xLong3b = xH + xHZ * xRY * Sin(xLong1 * 2 / 180 * PI) * xRY - xS1 / 2
        
        xLong2 = xW + xS2 * 1.04 * Atn(Sin(xLong1 + xStep2 / 180 * PI) * PI) - xS1 / 2
        xLong3 = xH + xS2 * Sin(xLong1 * 8 / 180 * PI) - xS1 / 2
        
        xLong2 = (xStep / 360) * xLong2 + (1 - (xStep / 360)) * xLong2b
        xLong3 = (xStep / 360) * xLong3 + (1 - (xStep / 360)) * xLong3b
        
        'xLong2b = Fix(xStep / 360 * 766)
        xLong2b = Fix(((xStep + 165) Mod 360) / 360 * 766)
        If xStep < 60 Then
          xLong3b = Fix(xLong1 / 360 * 766)
          xLong2b = xLong2b * 0.75 * (xStep / 60) + xLong3b * ((60 - xStep) / 60)
          End If
        
        Call RenderAdd(xLong2, xLong3, xLSData(Fix(xLong1)), xLong2b)
        Next
      #If Not AlwaysRenderText Then
        If xStep > 240 Then
          If xStep < 300 Then
            FontColor = ((xStep - 240) / 60 * &HFF) And &HFF&
            Else
            FontColor = &HFF&
            End If
          'GoTo TxtHack
          End If
        #End If
    Case 5
      xS1 = 2
      For xLong1 = 0& To 359.75 Step 0.25
        xStep2 = xMOD360(xLong1 + xStep + PreStep)
        If xStep2 > 180 Then xStep2 = 360 - xStep2
        
'        xRX = Cos(xStep2 * xStep / 60 / 180 * PI)
'        xRY = Atn(xStep2 / 180 * PI)
'        xLong2b = xW + xWZ * xRX * Cos(xStep2 * 2 / 180 * PI) * xRX - xS1 / 2
'        xLong3b = xH + xHZ * xRY * Sin(xLong1 * 2 / 180 * PI) * xRY - xS1 / 2
        
        If xStep > 300 Then
          xS2 = xW * 0.75 * ((360 - xStep) / 60) + xWZ * ((xStep - 300) / 60)
          Else
          xS2 = xW * 0.74
          End If
        
        
        
        xLong2 = xW + xS2 * 1.04 * Atn(Sin(xLong1 + xStep2 / 180 * PI) * PI) - xS1 / 2
        xLong3 = xH + xS2 * Sin(xLong1 * 8 / 180 * PI) - xS1 / 2
        
        xLong2b = xW + xWZ / 3 * (Sin((xLong1 + xStep) * 2 / 180 * PI) * PI) * Atn(xStep2 / 180 * PI) - xS1 / 2
        xLong3b = xH + xHZ * 0.7 * Sin(xLong1 * 8 / 180 * PI) * Cos(xStep2 / 180 * PI) - xS1 / 2
        
        xLong2 = (xStep / 360) * xLong2b + (1 - (xStep / 360)) * xLong2
        xLong3 = (xStep / 360) * xLong3b + (1 - (xStep / 360)) * xLong3
        'xLong2 = xLong2b
        'xLong3 = xLong3b
        
        xLong2b = Fix(((xStep + 165) Mod 360) / 360 * 766)
        If xStep > 210 Then
          xLong3b = Fix(xLong1 / 360 * 766)
          xLong2b = xLong2b * 0.75 * ((360 - xStep) / 150) + xLong3b * ((xStep - 210) / 150)
          'xLong2b = xLong3b
          End If
        
        
        Call RenderAdd(xLong2, xLong3, xLSData(Fix(xLong1)), xLong2b)
        Next
      #If Not AlwaysRenderText Then
        If xStep < 120 Then
          If xStep > 60 Then
            FontColor = ((60 - (xStep - 60)) / 60 * &HFF) And &HFF&
            Else
            FontColor = &HFF&
            End If
          End If
        #End If
'Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Any) As Long
'Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
    Case 6
      For xLong1 = 0& To 359.75 Step 0.25
        xStep2 = xMOD360(xLong1 + xStep + PreStep)
        If xStep2 > 180 Then xStep2 = 360 - xStep2
        
        xLong2 = xW + xWZ / 3 * (Sin((xLong1 + xStep) * 2 / 180 * PI) * PI) * Atn(xStep2 / 180 * PI) - xS1 / 2
        xLong3 = xH + xHZ * 0.7 * Sin(xLong1 * 8 / 180 * PI) * Cos(xStep2 / 180 * PI) - xS1 / 2
        
        xS1 = 2
        xS2 = (4 * xLong1 / 360 / (xStep2 / 4 + 1) + 1) * ((360 - xLong1) / 330)
        xS1 = (xStep / 360) * xS2 + (1 - (xStep / 360)) * xS1
        
        xRX = Atn(xStep2 / 180 * PI)
        xLong2b = xW + xWZ / 3 * (Sin((xLong1 * xRX + xStep) * 2 / 180 * PI) * PI) * Atn(xStep2 / 180 * PI) - xS1 / 2
        xLong3b = xH + xHZ * 0.7 * Sin(xLong1 * 2 * xRX / 180 * PI) * Cos(xStep2 / 180 * PI) - xS1 / 2
        
        xLong2 = (xStep / 360) * xLong2b + (1 - (xStep / 360)) * xLong2
        xLong3 = (xStep / 360) * xLong3b + (1 - (xStep / 360)) * xLong3
        
        Call RenderAdd(xLong2, xLong3, xLSData(Fix(xLong1)), Fix(xLong1 / 360 * 766))
        Next
    Case 7
      For xLong1 = 0& To 359.75 Step 0.25
        xStep2 = xMOD360(xLong1 + xStep + PreStep)
        xS2 = 8 * xLong1 / 360 / (xStep2 / 4 + 1)
        
        If xStep2 > 180 Then xStep2 = 360 - xStep2
        
        xS1 = (4 * xLong1 / 360 / (xStep2 / 4 + 1) + 1) * ((360 - xLong1) / 330)
        xS1 = (xStep / 360) * xS2 + (1 - (xStep / 360)) * xS1
        
        
        xRX = Atn(xStep2 / 180 * PI)
        xLong2b = xW + xWZ / 3 * (Sin((xLong1 * xRX + xStep) * 2 / 180 * PI) * PI) * Atn(xStep2 / 180 * PI) - xS1 / 2
        xLong3b = xH + xHZ * 0.7 * Sin(xLong1 * 2 * xRX / 180 * PI) * Cos(xStep2 / 180 * PI) - xS1 / 2
        
        xRX = Sin(xStep2 / 180 * PI)
        xRY = Cos(xLong1 * 2 / 180 * PI)
        xLong2 = xW + xWZ * Cos(xStep2 / 180 * PI) * xRX - xS1 / 2
        xLong3 = xH + xHZ * Sin(xLong1 / 180 * PI) * xRY - xS1 / 2
        
        xLong2 = (xStep / 360) * xLong2 + (1 - (xStep / 360)) * xLong2b
        xLong3 = (xStep / 360) * xLong3 + (1 - (xStep / 360)) * xLong3b
        
        Call RenderAdd(xLong2, xLong3, xLSData(Fix(xLong1)), Fix(xLong1 / 360 * 766))
        Next
    
    
    
    End Select
  #If AlwaysRenderText Then
    Call RenderNow(TotalMul * &HFF&, 9 * (xWZ + 3 * xW) / xW)
    #Else
    Call RenderNow(FontColor * TotalMul, 9 * (xWZ + 3 * xW) / xW)
    #End If

  #If 0 Then
    Dim xChar1 As String
    'Me.PrintForm CStr(xProg) + "/" + CStr(xStep)
    xChar1 = CStr(xProg) + "/" + CStr(xStep)
    Me.Font.Size = 12
    Me.ForeColor = &HFFFFFF
    Call TextOutA(Me.hdc, 0&, 0&, xChar1, Len(xChar1))
    #End If
  End Sub
