Apagada docs

Aprendiendo a programar el pasado

Herramientas de usuario

Herramientas del sitio

Estás aquí: start » es » basic » wavelenght2rgb
es:basic:wavelenght2rgb

Tabla de Contenidos

wavelenght2rgb

En el diccionario de la Real Academia describe algunos colores utilizando su longitud de onda. Sin embargo, si queremos visualizarlos en un ordenador necesitamos simular esa longitud de onda como una mezcla de luces rojas, verdes y azules (correspondientes a los receptores lumínicos del 95% de los seres humanos).

Estas dos macros, una para word y otra para CorelDraw!, generan colores RGB a partir de longitudes de onda.

'Adaptado de un programa de Dan Bruton (astro[{@}]tamu.edu) 'que se puede encontrar en http://www.physics.sfasu.edu/astro/color.html

Wavelenght2RGB (Word)

Attribute VB_Name = "Wavelenght2RGB"
'Valores RGB para el espectro visible.
'Adaptado de un programa de Dan Bruton (astro{[@]}tamu.edu)
'que se puede encontrar en http://www.physics.sfasu.edu/astro/color.html
Sub EspectroVisible()
    Dim J As Double, I As Double, R As Double, G As Double, sss As Double
 
    Dim CV(500, 500, 3) As Double
    Dim M As Single: M = 400
    Dim N As Single: N = 50
    Dim Max As Single: Max = 255
    Dim Gamma As Double: Gamma = 0.8
    Dim WL As Double: WL = 0 'WaveLenght
    For J = 1 To M
        For I = 1 To M
            WL = 380# + (I * 400# / M)
            If ((WL >= 380) And (WL <= 440)) Then
              R = -1# * (WL - 440#) / (440# - 380#)
              G = 0#
              b = 1#
            End If
            If ((WL >= 440) And (WL <= 490)) Then
              R = 0#
              G = (WL - 440#) / (490# - 440#)
              b = 1#
            End If
            If ((WL >= 490) And (WL <= 510)) Then
              R = 0#
              G = 1#
              b = -1# * (WL - 510#) / (510# - 490#)
            End If
            If ((WL >= 510) And (WL <= 580)) Then
              R = (WL - 510#) / (580# - 510#)
              G = 1#
              b = 0#
            End If
            If ((WL >= 580) And (WL <= 645)) Then
              R = 1#
              G = -1# * (WL - 645#) / (645# - 580#)
              b = 0#
            End If
            If ((WL >= 645#) And (WL <= 780#)) Then
              R = 1#
              G = 0#
              b = 0#
            End If
'
'   Hagamos que la intensidad SSS caiga más allá de los límites de la visión.
 
         If (WL >= 700) Then
            sss = 0.3 + 0.7 * (780# - WL) / (780# - 700#)
         ElseIf (WL < 420) Then
            sss = 0.3 + 0.7 * (WL - 380#) / (420# - 380#)
         Else
            sss = 1#
         End If
'
'   Ajuste gamma y escitura de la imagen a una matriz
'
         CV(I, J, 1) = (sss * R) ^ Gamma
         CV(I, J, 2) = (sss * G) ^ Gamma
         CV(I, J, 3) = (sss * b) ^ Gamma
        Next
    Next
 
End Sub
'Basado en EspectroVisible
Sub WL2RGB(WL As Double, ByRef Rojo As Double, Verde As Double, Azul As Double)
    Dim R As Double, G As Double, sss As Double
    Dim Max As Single: Max = 255
    Dim Gamma As Double: Gamma = 0.8
    If ((WL >= 380) And (WL <= 440)) Then
      R = -1# * (WL - 440#) / (440# - 380#)
      G = 0#
      b = 1#
    End If
    If ((WL >= 440) And (WL <= 490)) Then
      R = 0#
      G = (WL - 440#) / (490# - 440#)
      b = 1#
    End If
    If ((WL >= 490) And (WL <= 510)) Then
      R = 0#
      G = 1#
      b = -1# * (WL - 510#) / (510# - 490#)
    End If
    If ((WL >= 510) And (WL <= 580)) Then
      R = (WL - 510#) / (580# - 510#)
      G = 1#
      b = 0#
    End If
    If ((WL >= 580) And (WL <= 645)) Then
      R = 1#
      G = -1# * (WL - 645#) / (645# - 580#)
      b = 0#
    End If
    If ((WL >= 645#) And (WL <= 780#)) Then
      R = 1#
      G = 0#
      b = 0#
    End If
'
'   Hagamos que la intensidad SSS caiga más allá de los límites de la visión.
 
         If (WL >= 700) Then
            sss = 0.3 + 0.7 * (780# - WL) / (780# - 700#)
         ElseIf (WL < 420) Then
            sss = 0.3 + 0.7 * (WL - 380#) / (420# - 380#)
         Else
            sss = 1#
         End If
'
'   Ajuste gamma y escitura de la imagen a una matriz
'
         Rojo = (sss * R) ^ Gamma
         Verde = (sss * G) ^ Gamma
         Azul = (sss * b) ^ Gamma
 
        Rojo = 255 * Rojo
        Verde = 255 * Verde
        Azul = 255 * Azul
End Sub
 
Sub DisplayWL()
Dim Text As String
Dim Rojo As Double, Verde As Double, Azul As Double
Dim WL As Double
 
Text = "" & Selection.Text
If Right(Text, 2) = "nm" Then Text = Left(Text, Len(Text) - 2)
If Val(Text) > 0 Then
WL = Val(Text)
Debug.Print WL
    WL2RGB WL, Rojo, Verde, Azul
    Debug.Print Rojo, Verde, Azul
    Selection.InsertAfter ("[" + Chr(219) + "]") '("[ ]")
    Selection.MoveStartUntil ("[" + Chr(219) + "]")  '("[ ]")
    Selection.Font.Color = _
        Val("&h00" + _
            Right("00" + Hex$(Rojo), 2) + _
            Right("00" + Hex$(Verde), 2) + _
            Right("00" + Hex$(Azul), 2) _
        )
    'Selection.Borders.InsideColor = _
        Val("&h" + "8f" + _
            Right("00" + Hex$(Rojo), 2) + _
            Right("00" + Hex$(Verde), 2) + _
            Right("00" + Hex$(Azul), 2) _
        )
    'Selection.Borders.InsideColor = _
        Val("&h" + _
            Right("00" + Hex$(Rojo), 2) + _
            Right("00" + Hex$(Verde), 2) + _
            Right("00" + Hex$(Azul), 2) _
        )
End If
 
 
End Sub

WaveLenght2RGBCorel (Corel Draw!)

Attribute VB_Name = "WaveLenght2RGBCorel"
Public Type WLColor
    Name As String
    WL As Double
    R As Double
    G As Double
    B As Double
End Type
 
'Valores RGB para el espectro visible.
'Adaptado de un programa de Dan Bruton (astro([@])tamu.edu)
'que se puede encontrar en http://www.physics.sfasu.edu/astro/color.html
Sub EspectroVisible()
    Dim J As Double, I As Double, R As Double, G As Double, sss As Double
 
    Dim CV(500, 500, 3) As Double
    Dim M As Single: M = 400
    Dim N As Single: N = 50
    Dim Max As Single: Max = 255
    Dim Gamma As Double: Gamma = 0.8
    Dim WL As Double: WL = 0 'WaveLenght
    For J = 1 To M
        For I = 1 To M
            WL = 380# + (I * 400# / M)
            If ((WL >= 380) And (WL <= 440)) Then
              R = -1# * (WL - 440#) / (440# - 380#)
              G = 0#
              B = 1#
            End If
            If ((WL >= 440) And (WL <= 490)) Then
              R = 0#
              G = (WL - 440#) / (490# - 440#)
              B = 1#
            End If
            If ((WL >= 490) And (WL <= 510)) Then
              R = 0#
              G = 1#
              B = -1# * (WL - 510#) / (510# - 490#)
            End If
            If ((WL >= 510) And (WL <= 580)) Then
              R = (WL - 510#) / (580# - 510#)
              G = 1#
              B = 0#
            End If
            If ((WL >= 580) And (WL <= 645)) Then
              R = 1#
              G = -1# * (WL - 645#) / (645# - 580#)
              B = 0#
            End If
            If ((WL >= 645#) And (WL <= 780#)) Then
              R = 1#
              G = 0#
              B = 0#
            End If
'
'   Hagamos que la intensidad SSS caiga más allá de los límites de la visión.
 
         If (WL >= 700) Then
            sss = 0.3 + 0.7 * (780# - WL) / (780# - 700#)
         ElseIf (WL < 420) Then
            sss = 0.3 + 0.7 * (WL - 380#) / (420# - 380#)
         Else
            sss = 1#
         End If
'
'   Ajuste gamma y escitura de la imagen a una matriz
'
         CV(I, J, 1) = (sss * R) ^ Gamma
         CV(I, J, 2) = (sss * G) ^ Gamma
         CV(I, J, 3) = (sss * B) ^ Gamma
        Next
    Next
 
End Sub
'Basado en EspectroVisible
Sub WL2RGB(WL As Double, ByRef Rojo As Double, ByRef Verde As Double, ByRef Azul As Double)
    Dim R As Double, G As Double, sss As Double
    Dim Max As Single: Max = 255
    Dim Gamma As Double: Gamma = 0.8
    If ((WL >= 380) And (WL <= 440)) Then
      R = -1# * (WL - 440#) / (440# - 380#)
      G = 0#
      B = 1#
    End If
    If ((WL >= 440) And (WL <= 490)) Then
      R = 0#
      G = (WL - 440#) / (490# - 440#)
      B = 1#
    End If
    If ((WL >= 490) And (WL <= 510)) Then
      R = 0#
      G = 1#
      B = -1# * (WL - 510#) / (510# - 490#)
    End If
    If ((WL >= 510) And (WL <= 580)) Then
      R = (WL - 510#) / (580# - 510#)
      G = 1#
      B = 0#
    End If
    If ((WL >= 580) And (WL <= 645)) Then
      R = 1#
      G = -1# * (WL - 645#) / (645# - 580#)
      B = 0#
    End If
    If ((WL >= 645#) And (WL <= 780#)) Then
      R = 1#
      G = 0#
      B = 0#
    End If
'
'   Hagamos que la intensidad SSS caiga más allá de los límites de la visión.
 
         If (WL >= 700) Then
            sss = 0.3 + 0.7 * (780# - WL) / (780# - 700#)
         ElseIf (WL < 420) Then
            sss = 0.3 + 0.7 * (WL - 380#) / (420# - 380#)
         Else
            sss = 1#
         End If
'
'   Ajuste gamma y escitura de la imagen a una matriz
'
         Rojo = (sss * R) ^ Gamma
         Verde = (sss * G) ^ Gamma
         Azul = (sss * B) ^ Gamma
 
        Rojo = 255 * Rojo
        Verde = 255 * Verde
        Azul = 255 * Azul
End Sub
 
Sub DisplayWL()
Dim Text As String
Dim Rojo As Double, Verde As Double, Azul As Double
Dim WL As Double
Dim Lay As Layer, Box As Shape, TextBox As Shape
Dim Clr As Color
Dim X As Double, y As Double
Set Lay = ActiveLayer
 
Set Clr = New Color
 
Dim Listacolores(7) As WLColor
    Listacolores(0).Name = "Rojo"
    Listacolores(0).WL = 640
    Listacolores(1).Name = "Naranja"
    Listacolores(1).WL = 600
    Listacolores(2).Name = "Amarillo"
    Listacolores(2).WL = 575
    Listacolores(3).Name = "Verde"
    Listacolores(3).WL = 520
    Listacolores(4).Name = "Azul"
    Listacolores(4).WL = 475
    Listacolores(5).Name = "Añil"
    Listacolores(5).WL = 450
    Listacolores(6).Name = "Violeta"
    Listacolores(6).WL = 440
 
    X = ActivePage.LeftX + 1
    y = ActivePage.TopY - 1
 
    For f = 0 To 6
        WL2RGB Listacolores(f).WL, _
            Listacolores(f).R, _
            Listacolores(f).G, _
            Listacolores(f).B
 
        Set Box = Lay.CreateRectangle(X, y, X + 1, y - 1)
        Set TextBox = Lay.CreateParagraphText( _
            X, _
            y - (1 + 0.2), _
            X + 1, _
            y - (1 + 0.2 + 1), _
            Listacolores(f).Name & vbCrLf & _
                    Listacolores(f).WL & " nm" & vbCrLf & _
                    Format(Listacolores(f).R / 255, "000%") & "Rojo " & vbCrLf & _
                    Format(Listacolores(f).G / 255, "000%") & "Verde " & vbCrLf & _
                    Format(Listacolores(f).B / 255, "000%") & "Azul " & vbCrLf _
            )
 
            Debug.Print Listacolores(f).WL
            Debug.Print Listacolores(f).R
            Debug.Print Listacolores(f).G
            Debug.Print Listacolores(f).B
 
        X = X + 1 + 0.2
        'If (X + 1 + 0.2) > ActivePage.RightX Then
        '    X = ActivePage.LeftX + 1
        '    y = y - (1 + 0.2 + 1 + 0.2)
        '
        'End If
        Clr.RGBAssign Listacolores(f).R, Listacolores(f).G, Listacolores(f).B
        Box.Fill.ApplyUniformFill Clr
    Next
End Sub
Este sitio web utiliza cookies. Al utilizar el sitio web, usted acepta almacenar cookies en su computadora. También reconoce que ha leído y entendido nuestra Política de privacidad. Si no está de acuerdo abandone el sitio web.Más información
es/basic/wavelenght2rgb.txt · Última modificación: 2016/01/14 10:38 por nepenthes

Herramientas de la página

Excepto donde se indique lo contrario, el contenido de este wiki esta bajo la siguiente licencia: CC Attribution-Noncommercial-Share Alike 4.0 International
CC Attribution-Noncommercial-Share Alike 4.0 International Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki