vbAccelerator - Contents of code file: HLSRGB_HLSRGBVB_HLSRGB.vb

Imports System.Drawing

Namespace vbAccelerator.Components.VB.Drawing

    Public Class HLSRGB
        Private m_red As Byte = 0
        Private m_green As Byte = 0
        Private m_blue As Byte = 0

        Private m_hue As Double = 0
        Private m_luminance As Double = 0
        Private m_saturation As Double = 0

        Public Property Red() As Byte
            Get
                Return m_red
            End Get
            Set(ByVal Value As Byte)
                m_red = Value
                ToHLS()
            End Set
        End Property

        Public Property Green() As Byte
            Get
                Return m_green
            End Get
            Set(ByVal Value As Byte)
                m_green = Value
                ToHLS()
            End Set
        End Property

        Public Property Blue() As Byte
            Get
                Return m_blue
            End Get
            Set(ByVal Value As Byte)
                m_blue = Value
                ToHLS()
            End Set
        End Property

        Public Property Luminance() As Double
            Get
                Return m_luminance
            End Get
            Set(ByVal Value As Double)
                If ((Value < 0.0F) Or (Value > 1.0F)) Then
                    Throw New ArgumentOutOfRangeException("Luminance",
                     "Luminance must be between 0.0 and 1.0")
                End If
                m_luminance = Value
                ToRGB()
            End Set
        End Property

        Public Property Hue() As Double
            Get
                Return m_hue
            End Get
            Set(ByVal Value As Double)
                If ((Value < 0.0F) Or (Value > 360.0F)) Then
                    Throw New ArgumentOutOfRangeException("Hue", "Hue must be
                     between 0.0 and 360.0")
                End If
                m_hue = Value
                ToRGB()
            End Set
        End Property

        Public Property Saturation() As Double
            Get
                Return m_saturation
            End Get
            Set(ByVal Value As Double)
                If ((Value < 0.0F) Or (Value > 1.0F)) Then
                    Throw New ArgumentOutOfRangeException("Saturation",
                     "Saturation must be between 0.0 and 1.0")
                End If
                m_saturation = Value
                ToRGB()
            End Set
        End Property

        Public Property Color() As Color
            Get
                Dim c As Color = Color.FromArgb(m_red, m_green, m_blue)
                Return c
            End Get
            Set(ByVal Value As Color)
                m_red = Value.R
                m_green = Value.G
                m_blue = Value.B
                ToHLS()
            End Set
        End Property

        Public Sub LightenColor(ByVal lightenBy As Double)
            m_luminance *= (1.0F + lightenBy)
            If (m_luminance > 1.0F) Then
                m_luminance = 1.0F
            End If
            ToRGB()
        End Sub

        Public Sub DarkenColor(ByVal darkenBy As Double)
            m_luminance *= darkenBy
            ToRGB()
        End Sub


        Public Sub New(ByVal c As Color)
            m_red = c.R
            m_green = c.G
            m_blue = c.B
            ToHLS()
        End Sub

        Public Sub New(ByVal hue As Double, ByVal luminance As Double, ByVal
         saturation As Double)
            If ((saturation < 0.0F) Or (saturation > 1.0F)) Then
                Throw New ArgumentOutOfRangeException("Saturation", "Saturation
                 must be between 0.0 and 1.0")
            End If
            If ((hue < 0.0F) Or (hue > 360.0F)) Then
                Throw New ArgumentOutOfRangeException("Hue", "Hue must be
                 between 0.0 and 360.0")
            End If
            If ((luminance < 0.0F) Or (luminance > 1.0F)) Then
                Throw New ArgumentOutOfRangeException("Luminance", "Luminance
                 must be between 0.0 and 1.0")
            End If
            m_hue = hue
            m_luminance = luminance
            m_saturation = saturation
            ToRGB()
        End Sub

        Public Sub New(ByVal red As Byte, ByVal green As Byte, ByVal blue As
         Byte)
            m_red = red
            m_green = green
            m_blue = blue
        End Sub

        Public Sub New(ByVal hlsrgb As HLSRGB)
            m_red = hlsrgb.Red
            m_blue = hlsrgb.Blue
            m_green = hlsrgb.Green
            m_luminance = hlsrgb.Luminance
            m_hue = hlsrgb.Hue
            m_saturation = hlsrgb.Saturation
        End Sub

        Public Sub New()

        End Sub

        Private Sub ToHLS()
            Dim minval As Byte = Math.Min(m_red, Math.Min(m_green, m_blue))
            Dim maxval As Byte = Math.Max(m_red, Math.Max(m_green, m_blue))

            Dim mdiff As Double = (maxval * 1.0 - minval * 1.0)
            Dim msum As Double = (maxval * 1.0 + minval * 1.0)

            m_luminance = msum / 510.0F

            If (maxval = minval) Then
                m_saturation = 0.0F
                m_hue = 0.0F
            Else
                Dim rnorm As Double = (maxval - m_red) / mdiff
                Dim gnorm As Double = (maxval - m_green) / mdiff
                Dim bnorm As Double = (maxval - m_blue) / mdiff

                If (m_luminance <= 0.5F) Then
                    m_saturation = (mdiff / msum)
                Else
                    m_saturation = (mdiff / (510.0F - msum))
                End If

                If (m_red = maxval) Then
                    m_hue = 60.0F * (6.0F + bnorm - gnorm)
                End If
                If (m_green = maxval) Then
                    m_hue = 60.0F * (2.0F + rnorm - bnorm)
                End If
                If (m_blue = maxval) Then
                    m_hue = 60.0F * (4.0F + gnorm - rnorm)
                End If
                If (m_hue > 360.0F) Then
                    m_hue = m_hue - 360.0F
                End If
            End If
        End Sub

        Private Sub ToRGB()
            If (m_saturation = 0.0) Then
                m_red = CByte(m_luminance * 255.0F)
                m_green = m_red
                m_blue = m_red
            Else
                Dim rm1 As Double
                Dim rm2 As Double

                If (m_luminance <= 0.5F) Then
                    rm2 = m_luminance + m_luminance * m_saturation
                Else
                    rm2 = m_luminance + m_saturation - m_luminance *
                     m_saturation
                End If
                rm1 = 2.0F * m_luminance - rm2
                m_red = ToRGB1(rm1, rm2, m_hue + 120.0F)
                m_green = ToRGB1(rm1, rm2, m_hue)
                m_blue = ToRGB1(rm1, rm2, m_hue - 120.0F)
            End If
        End Sub

        Private Function ToRGB1(ByVal rm1 As Double, ByVal rm2 As Double, ByVal
         rh As Double) As Byte
            If (rh > 360.0F) Then
                rh -= 360.0F
            ElseIf (rh < 0.0F) Then
                rh += 360.0F
            End If

            If (rh < 60.0F) Then
                rm1 = rm1 + (rm2 - rm1) * rh / 60.0F
            ElseIf (rh < 180.0F) Then
                rm1 = rm2
            ElseIf (rh < 240.0F) Then
                rm1 = rm1 + (rm2 - rm1) * (240.0F - rh) / 60.0F
            End If

            ToRGB1 = CByte(rm1 * 255)
        End Function


    End Class

End Namespace