Espectro de la luz visible

Espectro de la luz visible

El proposito de este programa es mostrar los colores RGB en función de la longitud de onda para la luz visible (380 a 780 nm). Este código es un converción al VisualBasic de la verción para Delphi que se encuentra en :(www.efg2.com/lab/ScienceAndEngineering/Spectra.htm).

Grafico que muestra la aproximación de los valores de color RGB, en función de la longitud de onda de la luz visible en nm.

El siguiente espectro fue hecho usando espectro.zip (2 Kb) para aproximar los componentes RGB del color.

Código

Function Power(ByVal x As Double, ByVal y As Double) As Double
If (x = 0#) Then
    If (y = 0#) Then
        Power = 1#
    Else
        Power = 0#
    End If
Else
    Power = Exp(Log(x) * y)
End If
End Function

Function Adjust(ByVal color As Double, ByVal factor As Double) As Double
If (color = 0#) Then
    Adjust = 0#
Else
    Adjust = IntensityMax * Power(color * factor, Gamma)
End If
End Function

Sub WavelengthToRGB(ByVal wavelength As Double, R As Double, G As Double, B As Double)
Dim Red, Green, Blue As Double
Dim factor As Double
Select Case Int(wavelength)
    Case 380 To 439
        Red = -(wavelength - 440) / (440 - 380)
        Green = 0#
        Blue = 1#
    Case 440 To 489
        Red = 0#
        Green = (wavelength - 440) / (490 - 440)
        Blue = 1#
    Case 490 To 509
        Red = 0#
        Green = 1#
        Blue = -(wavelength - 510) / (510 - 490)
    Case 510 To 579
        Red = (wavelength - 510) / (580 - 510)
        Green = 1#
        Blue = 0#
    Case 580 To 644
        Red = 1#
        Green = -(wavelength - 645) / (645 - 580)
        Blue = 0#
    Case 645 To 780
        Red = 1#
        Green = 0#
        Blue = 0#
    Case Else
        Red = 0#
        Green = 0#
        Blue = 0#
End Select
Select Case Int(wavelength)
    Case 380 To 419
        factor = 0.3 + 0.7 * (wavelength - 380) / (420 - 380)
    Case 420 To 700
        factor = 1#
    Case 701 To 780
        factor = 0.3 + 0.7 * (780 - wavelength) / (780 - 700)
    Case Else
        factor = 0#
End Select
R = Adjust(Red, factor)
G = Adjust(Green, factor)
B = Adjust(Blue, factor)
End Sub

valcoey@hotmail.com

Ramiro Alcocer, 2001