' ========================================================================================================================
' ____,__, __, ____,_, _, ____ ____,__, ,____,____,
' (-/_|(-| (-| (-|_,(-|\ | (-|__|-/_|( |_/(-|_,(-|__)
' _/ |,_|__,_|__,_|__,_| \|, _|__)/ |,_| \,_|__,_| \,
'
' Copyright � 2009 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File: M033_Color
' Originator: Allen Baker (2009.08.23 17:36)
' ------------------------------------------------------------------------------------------------------------------------
' $RCSfile$
' $Revision$
' $Date$
' ========================================================================================================================
Option Explicit
' ========================================================================================================================
' Description
' This module contains routines and functions for manipulating colors. In particular, it provides tools for using the
' RGB, HSL, and HSV color representations and for moving back and forth between them. The RGB color representation is
' used by most applications but the HSL color space is much easier for mathematically manipulating colors.
' ========================================================================================================================
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Constants ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' ==============================================================================================
' This is the default color component max value and it is:
' => old:
' = 7,323,600
' = LCM(255,359,240,100)
' Public Const cDefaultCCMax As Double = 7323600#
' => new:
' = 351,532,800
' Lcm(255,256,359,360,240,100)
' ----------------------------------------------------------------------------------------------
Public Const cDefaultCCMax As Double = 351532800
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Types ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' ==============================================================================================
' This is the color representation used for all the color manipulations in this module. It is
' essentially a color triplet just like VBA's native rgb representation (which from this point
' forward will simply be called "rgb"). However, it stores the 3 color components as Doubles
' instead of as bytes. It also maintains additional information about the valid ranges of the 3
' color components as well as the ratio of each color component to its range maximum.
'
' A ColorVector is a more flexible representation than an rgb because, among other things, it
' supports all the same color representations that rgb supports such as rgb and HSL and then in
' addition, it supports representations like HSV that are not supported by rgb.
'
' rgb: An rgb is stored as a 32-bit COLORREF value. The COLORREF value has the following
' hexadecimal form: 0x00bbggrr
' The low-order byte contains a value for the relative intensity of red; the second
' byte contains a value for green; and the third byte contains a value for blue. The
' high-order byte must be zero. The maximum value for a single byte is 0xFF.
'
' Functions are provided to convert an rgb to ColorVector and visa versa.
'
' Note: All Objects are REFERENCE TYPES in VBA. All the other built-in data types in VBA are
' VALUE TYPES. In addition, *all user defined types declared with the Type keyword*, all
' enums, and all arrays are VALUE TYPES.
'
' Assignment of a VALUE TYPE variable to another variable of the same VALUE TYPE copies
' the value from one variable to the other so that each variable contains its own
' separate instance of the value. Assignment of a REFERENCE TYPE variable to another
' variable of the same REFERENCE TYPE copies the reference from one variable to the other
' so that both variables "point to" the same instance of the value.
'
' Notice that this means that assigning an array *copies* the entire contents of the
' array.
' ----------------------------------------------------------------------------------------------
Public Type ColorVector
x As Double ' A color is represented as a triple, or set of 3 values. The x, y, and z
y As Double ' members of this type are those 3 values.
z As Double
xMax As Double ' the range of possible values for x is >=0 and <=xMax
yMax As Double ' the range of possible values for y is >=0 and <=yMax
zMax As Double ' the range of possible values for z is >=0 and <=zMax
xRatio As Double ' the ratio x / xMax, can be interpreted as the percentage of xMax represented by x
yRatio As Double ' the ratio y / yMax, can be interpreted as the percentage of yMax represented by y
zRatio As Double ' the ratio z / zMax, can be interpreted as the percentage of zMax represented by z
End Type
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Module Variables ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Public Routines ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ cDefaultCCMax Conversions ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ==============================================================================================
' A function to give a worksheet access to the default color component max value
' ----------------------------------------------------------------------------------------------
Public Function defaultCMax() As Double
defaultCMax = cDefaultCCMax
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a value in the range [0..pOldMax] to a proportionaly equivalent value in the
' range [0..cDefaultCCMax].
'
' return
' This function returns a Double in the range [0..cDefaultCCMax].
'
' param
' pValue is the value to convert
' param
' pOldMax is the max value of the range that pValue is in.
' -----------------------------------------------------------------------------------------------------------
Public Function convertToDefaultMax(ByVal pValue As Double, ByVal pOldMax As Double) As Double
convertToDefaultMax = equivalentNumerator(pValue, pOldMax, cDefaultCCMax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a value in the range [0..cDefaultCCMax] to a proportionaly equivalent value in the
' range [0..pNewMax].
'
' return
' This function returns a Double in the range [0..pNewMax].
'
' param
' pValue is the value to convert
' param
' pNewMax is the max value of the range to convert pValue to.
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromDefaultMax(ByVal pValue As Double, ByVal pNewMax As Double) As Double
convertFromDefaultMax = equivalentNumerator(pValue, cDefaultCCMax, pNewMax)
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ ColorVector Creation Functions ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function packages the values passed into it through its parameters as a new ColorVector. The
' ColorVector's color component ratios (which represent scaling factors for each component and are in the
' range of [0..1]) are calculated internally by dividing the color component values by their corresponding
' maximums.
'
' return
' This function returns a new ColorVector.
'
' param
' pX is the rgb red component or an hsl or hsv hue component
' param
' pY is the rgb green component or an hsl or hsv saturation component
' param
' pZ is the rgb blue component or an hsl luminosity component or an hsv value component
' param (optional)
' pXMax is maximum value allowed for the pX component. As an example value: it would be 255 for the rgb
' red component or the hsl hue component used by Windows. If no argument value is passed to this procedure
' through this optional parameter, its value defaults to cDefaultCCMax
' param (optional)
' pYMax is maximum value allowed for the pY component. As an example value: it would be 255 for the rgb
' green component or the hsl saturation component used by Windows. If no argument value is passed to this
' procedure through this optional parameter, its value defaults to cDefaultCCMax.
' param (optional)
' pZMax is maximum value allowed for the pZ component. As an example value: it would be 255 for the rgb
' blue component or the hsl luminosity component used by Windows. If no argument value is passed to this
' procedure through this optional parameter, its value defaults to cDefaultCCMax.
' -----------------------------------------------------------------------------------------------------------
Public Function newColorVector _
( _
ByVal pX As Double, _
ByVal pY As Double, _
ByVal pZ As Double, _
Optional ByVal pXMax As Double = cDefaultCCMax, _
Optional ByVal pYMax As Double = cDefaultCCMax, _
Optional ByVal pZMax As Double = cDefaultCCMax _
) _
As ColorVector
Dim result As ColorVector
Dim xRatioD As Double
Dim yRatioD As Double
Dim zRatioD As Double
Dim xL As Long
Dim yL As Long
Dim zL As Long
Dim xMaxL As Long
Dim yMaxL As Long
Dim zMaxL As Long
'
' ==============================================================================================
' we have to catch Max values of zero here to prevent divide by zero crashes. Might as well
' make sure the maxes are alltogether valid and not just check for zero values.
' ----------------------------------------------------------------------------------------------
If (pXMax < 1#) Then Call raiseException _
( _
"The ColorVector XMax value of: " & pXMax & _
" is not within the valid range for Max values, which is [>=1]", "newColorVectorFromRatios", "M033_Color" _
)
If (pYMax < 1#) Then Call raiseException _
( _
"The ColorVector YMax value of: " & pYMax & _
" is not within the valid range for Max values, which is [>=1]", "newColorVectorFromRatios", "M033_Color" _
)
If (pZMax < 1#) Then Call raiseException _
( _
"The ColorVector ZMax value of: " & pZMax & _
" is not within the valid range for Max values, which is [>=1]", "newColorVectorFromRatios", "M033_Color" _
)
'
' ==============================================================================================
' round to the nearest integer
' ----------------------------------------------------------------------------------------------
xL = normalRoundLng(pX)
yL = normalRoundLng(pY)
zL = normalRoundLng(pZ)
xMaxL = normalRoundLng(pXMax)
yMaxL = normalRoundLng(pYMax)
zMaxL = normalRoundLng(pZMax)
'
' ==============================================================================================
' force into valid range of [0..max-1]
' ----------------------------------------------------------------------------------------------
xL = xL Mod (xMaxL + 1)
yL = yL Mod (yMaxL + 1)
zL = zL Mod (zMaxL + 1)
'
' ==============================================================================================
' ratios are always real numbers in the range [0..1]
' ----------------------------------------------------------------------------------------------
xRatioD = CDbl(xL) / CDbl(xMaxL)
yRatioD = CDbl(yL) / CDbl(yMaxL)
zRatioD = CDbl(zL) / CDbl(zMaxL)
'
' ==============================================================================================
' load up a color vector with the values all as real numbers
' ----------------------------------------------------------------------------------------------
With result
.x = CDbl(xL)
.xMax = CDbl(xMaxL)
.xRatio = xRatioD
.y = CDbl(yL)
.yMax = CDbl(yMaxL)
.yRatio = yRatioD
.z = CDbl(zL)
.zMax = CDbl(zMaxL)
.zRatio = zRatioD
End With
'
' ==============================================================================================
' check the result and return it
' ----------------------------------------------------------------------------------------------
Call validateColorVector(result, "newColorVector")
newColorVector = result '
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function packages the values passed into it through its parameters as a new ColorVector. The
' ColorVector's color component triple values (which are in the range of [0..Max]) are calculated internally
' by multiplying the color component ratios by their corresponding maximums.
'
' param
' pXRatio is the ratio of the rgb red component or an hsl or hsv hue component
' param
' pYRatio is the ratio of the rgb green component or an hsl or hsv saturation component
' param
' pZRatio is the ratio of the rgb blue component or an hsl luminosity component or an hsv value component
' param (optional)
' pXMax is maximum value allowed for the pX component. As an example value: it would be 255 for the rgb
' red component or the hsl hue component used by Windows. If no argument value is passed to this procedure
' through this optional parameter, its value defaults to cDefaultCCMax.
' param (optional)
' pYMax is maximum value allowed for the pY component. As an example value: it would be 255 for the rgb
' green component or the hsl saturation component used by Windows. If no argument value is passed to this
' function through this optional parameter, its value defaults to cDefaultCCMax.
' param (optional)
' pZMax is maximum value allowed for the pZ component. As an example value: it would be 255 for the rgb
' blue component or the hsl luminosity component used by Windows. If no argument value is passed to this
' function through this optional parameter, its value defaults to cDefaultCCMax.
' -----------------------------------------------------------------------------------------------------------
Public Function newColorVectorFromRatios _
( _
ByVal pXRatio As Double, _
ByVal pYRatio As Double, _
ByVal pZRatio As Double, _
Optional ByVal pXMax As Double = cDefaultCCMax, _
Optional ByVal pYMax As Double = cDefaultCCMax, _
Optional ByVal pZMax As Double = cDefaultCCMax _
) _
As ColorVector
Dim result As ColorVector
Dim xL As Long
Dim yL As Long
Dim zL As Long
Dim xMaxL As Long
Dim yMaxL As Long
Dim zMaxL As Long
'
' ==============================================================================================
' we have to catch Max values of zero here to prevent divide by zero crashes. Might as well
' make sure the maxes are altogether valid and not limit the check to one for zero values.
' ----------------------------------------------------------------------------------------------
If (pXMax < 1#) Then Call raiseException _
( _
"The ColorVector XMax value of: " & pXMax & _
" is not within the valid range for Max values, which is [>=1]", "newColorVectorFromRatios", "M033_Color" _
)
If (pYMax < 1#) Then Call raiseException _
( _
"The ColorVector YMax value of: " & pYMax & _
" is not within the valid range for Max values, which is [>=1]", "newColorVectorFromRatios", "M033_Color" _
)
If (pZMax < 1#) Then Call raiseException _
( _
"The ColorVector ZMax value of: " & pZMax & _
" is not within the valid range for Max values, which is [>=1]", "newColorVectorFromRatios", "M033_Color" _
)
'
' ==============================================================================================
' round to the nearest integer
' ----------------------------------------------------------------------------------------------
xMaxL = normalRoundLng(pXMax)
yMaxL = normalRoundLng(pYMax)
zMaxL = normalRoundLng(pZMax)
'
' ==============================================================================================
' compute component values and round to the nearest integer
' ----------------------------------------------------------------------------------------------
xL = normalRoundLng(pXRatio * CDbl(xMaxL))
yL = normalRoundLng(pYRatio * CDbl(yMaxL))
zL = normalRoundLng(pZRatio * CDbl(zMaxL))
'
' ==============================================================================================
' force into valid range of [0..max-1]
' ----------------------------------------------------------------------------------------------
xL = xL Mod (xMaxL + 1)
yL = yL Mod (yMaxL + 1)
zL = zL Mod (zMaxL + 1)
'
' ==============================================================================================
' make sure the ratios are exactly right -- taking into account rounding and Double arithmetic
' error
' ----------------------------------------------------------------------------------------------
pXRatio = CDbl(xL) / CDbl(xMaxL)
pYRatio = CDbl(yL) / CDbl(yMaxL)
pZRatio = CDbl(zL) / CDbl(zMaxL)
'
' ==============================================================================================
' load up a color vector with the values all as real numbers
' ----------------------------------------------------------------------------------------------
With result
.x = CDbl(xL)
.xMax = CDbl(xMaxL)
.xRatio = pXRatio
.y = CDbl(yL)
.yMax = CDbl(yMaxL)
.yRatio = pYRatio
.z = CDbl(zL)
.zMax = CDbl(zMaxL)
.zRatio = pZRatio
End With
'
' ==============================================================================================
' check the result and return it
' ----------------------------------------------------------------------------------------------
Call validateColorVector(result, "newColorVectorFromRatios")
newColorVectorFromRatios = result
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function changes the scale of an existing newColorVector.
'
' return
' This function returnes a new newColorVector, it does not modify the newColorVector passed to it as an
' argument through the pColorVector parameter. The new newColorVector's x, y, and z component values are
' each equal to the original newColorVector's correspopnding component scaled to its new maximums. In
' other words,
' rescaledColorVector.x = pColorVector.x * (rescaledColorVector.xMax / pColorVector.xMax)
'
' param
' pColorVector is the newColorVector to be rescaled
' param
' pXMax is the new scale for x, i.e, the maximum value allowed for the x component.
' param
' pYMax is the new scale for y, i.e, the maximum value allowed for the y component.
' param
' pZMax is the new scale for z, i.e, the maximum value allowed for the z component.
' -----------------------------------------------------------------------------------------------------------
Public Function rescaledColorVector(ByRef pColorVector As ColorVector, ByVal pXMax As Double, ByVal pYMax As Double, ByVal pZMax As Double) As ColorVector
With pColorVector
rescaledColorVector = newColorVectorFromRatios(.xRatio, .yRatio, .zRatio, pXMax, pYMax, pZMax)
End With
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ Conversion Functions Between rgb and ColorVector ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts from a color represented as a Long in VBA's native rgb format to a ColorVector
' containing an RGB representation of the same color
'
' return
' A ColorVector that is initialized with the data from a Long in VBA's native rgb format
'
' param
' pRgb is the Long in VBA's native rgb format that is converted to a ColorVector
' param (optional)
' pXMax is maximum value allowed for the pX component. As an example value: it would be 255 for the rgb
' red component or the hsl hue component used by Windows. If no argument value is passed to this procedure
' through this optional parameter, its value defaults to 255.
' param (optional)
' pYMax is maximum value allowed for the pY component. As an example value: it would be 255 for the rgb
' green component or the hsl saturation component used by Windows. If no argument value is passed to this
' procedure through this optional parameter, its value defaults to 255.
' param (optional)
' pZMax is maximum value allowed for the pZ component. As an example value: it would be 255 for the rgb
' blue component or the hsl luminosity component used by Windows. If no argument value is passed to this
' procedure through this optional parameter, its value defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function RGBvecFromRgb _
( _
ByVal pRgb As Long, _
Optional ByVal pXMax As Double = 255#, _
Optional ByVal pYMax As Double = 255#, _
Optional ByVal pZMax As Double = 255# _
) _
As ColorVector
'
' ==============================================================================================
' pick the RGB components out of the rgb Long
' ----------------------------------------------------------------------------------------------
Dim rgbR As Double
Dim rgbG As Double
Dim rgbB As Double
rgbR = rgbComponent(pRgb, 1)
rgbG = rgbComponent(pRgb, 2)
rgbB = rgbComponent(pRgb, 3)
'
' ==============================================================================================
' The components come into here as 255ths. If that's not what's wanted (rarely if ever the
' case), then convert.
' ----------------------------------------------------------------------------------------------
If (pXMax <> 255#) Then rgbR = equivalentNumerator(rgbR, 255#, pXMax)
If (pYMax <> 255#) Then rgbG = equivalentNumerator(rgbG, 255#, pYMax)
If (pZMax <> 255#) Then rgbB = equivalentNumerator(rgbB, 255#, pZMax)
'
' ==============================================================================================
' make a ColorVector out of it all and return it.
' ----------------------------------------------------------------------------------------------
RGBvecFromRgb = newColorVector(rgbR, rgbG, rgbB, pXMax, pYMax, pZMax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts from a color represented as a Long in VBA's native rgb format to a ColorVector
' containing an HSL representation of the same color
'
' return
' A ColorVector that is initialized with the data from a Long in VBA's native rgb format
'
' param
' pRgb is the Long in VBA's native rgb format that is converted to a ColorVector
' param (optional)
' pXMax is maximum value allowed for the pX component. As an example value: it would be 255 for the rgb
' red component or the hsl hue component used by Windows. If no argument value is passed to this procedure
' through this optional parameter, its value defaults to 359.
' param (optional)
' pYMax is maximum value allowed for the pY component. As an example value: it would be 255 for the rgb
' green component or the hsl saturation component used by Windows. If no argument value is passed to this
' procedure through this optional parameter, its value defaults to 100.
' param (optional)
' pZMax is maximum value allowed for the pZ component. As an example value: it would be 255 for the rgb
' blue component or the hsl luminosity component used by Windows. If no argument value is passed to this
' procedure through this optional parameter, its value defaults to 100.
' -----------------------------------------------------------------------------------------------------------
Public Function HSLvecFromRgb _
( _
ByVal pRgb As Long, _
Optional ByVal pXMax As Double = 359#, _
Optional ByVal pYMax As Double = 100#, _
Optional ByVal pZMax As Double = 100# _
) _
As ColorVector
Dim rgbVector As ColorVector
Dim hslVector As ColorVector
rgbVector = RGBvecFromRgb(pRgb)
hslVector = HSLvecFromRGBvec(rgbVector, pXMax, pYMax, pZMax)
HSLvecFromRgb = hslVector
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts from a color represented as a Long in VBA's native rgb format to a ColorVector
' containing an HSL representation of the same color
'
' return
' A ColorVector that is initialized with the data from a Long in VBA's native rgb format
'
' param
' pRgb is the Long in VBA's native rgb format that is converted to a ColorVector
' param (optional)
' pXMax is maximum value allowed for the pX component. As an example value: it would be 255 for the rgb
' red component or the hsl hue component used by Windows. If no argument value is passed to this procedure
' through this optional parameter, its value defaults to 359.
' param (optional)
' pYMax is maximum value allowed for the pY component. As an example value: it would be 255 for the rgb
' green component or the hsl saturation component used by Windows. If no argument value is passed to this
' procedure through this optional parameter, its value defaults to 100.
' param (optional)
' pZMax is maximum value allowed for the pZ component. As an example value: it would be 255 for the rgb
' blue component or the hsl luminosity component used by Windows. If no argument value is passed to this
' procedure through this optional parameter, its value defaults to 100.
' -----------------------------------------------------------------------------------------------------------
Public Function HSVvecFromRgb _
( _
ByVal pRgb As Long, _
Optional ByVal pXMax As Double = 359#, _
Optional ByVal pYMax As Double = 100#, _
Optional ByVal pZMax As Double = 100# _
) _
As ColorVector
Dim rgbVector As ColorVector
Dim hsvVector As ColorVector
rgbVector = RGBvecFromRgb(pRgb)
hsvVector = HSVvecFromRGBvec(rgbVector, pXMax, pYMax, pZMax)
HSVvecFromRgb = hsvVector
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts from a ColorVector containing an RGB representation of a color to a Long in VBA's
' native rgb format
'
' return
' A long in VBA's rgb format. The value returned from this function is usable anywhere that the value
' returned from VBA's rgb() function is usable
'
' param
' pRGBvec is the ColorVector that is converted to a Long in VBA's native rgb format. This parameter is
' assumed to be a ColorVector containing an RGB color representation.
' -----------------------------------------------------------------------------------------------------------
Public Function rgbFromRGBvec(ByRef pRGBvec As ColorVector) As Long
Dim rgbR As Long
Dim rgbG As Long
Dim rgbB As Long
'
' ==============================================================================================
' the VBA rgb() function expects all three of the values (rgbR, rgbG, and rgbB) to be scaled
' to 255
' ----------------------------------------------------------------------------------------------
With pRGBvec
rgbR = normalRoundLng(equivalentNumerator(.x, .xMax, 255#)) Mod 256&
rgbG = normalRoundLng(equivalentNumerator(.y, .yMax, 255#)) Mod 256&
rgbB = normalRoundLng(equivalentNumerator(.z, .zMax, 255#)) Mod 256&
End With
rgbFromRGBvec = toRgb(rgbR, rgbG, rgbB, 255&, 255&, 255&)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts from a ColorVector containing an HSL representation of a color to a Long in VBA's
' native rgb format
'
' return
' A long in VBA's rgb format. The value returned from this function is usable anywhere that the value
' returned from VBA's rgb() function is usable
'
' param
' pHSLvec is the ColorVector that is converted to a Long in VBA's native rgb format. This parameter is
' assumed to be a ColorVector containing an HSL color representation.
' -----------------------------------------------------------------------------------------------------------
Public Function rgbFromHSLvec(ByRef pHSLvec As ColorVector) As Long
rgbFromHSLvec = rgbFromRGBvec(RGBvecFromHSLvec(pHSLvec, 255#, 255#, 255#))
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts from a ColorVector containing an HSV representation of a color to a Long in VBA's
' native rgb format
'
' return
' A long in VBA's rgb format. The value returned from this function is usable anywhere that the value
' returned from VBA's rgb() function is usable
'
' param
' pHSVvec is the ColorVector that is converted to a Long in VBA's native rgb format. This parameter is
' assumed to be a ColorVector containing an HSV color representation.
' -----------------------------------------------------------------------------------------------------------
Public Function rgbFromHSVvec(ByRef pHSVvec As ColorVector) As Long
rgbFromHSVvec = rgbFromRGBvec(RGBvecFromHSVvec(pHSVvec, 255#, 255#, 255#))
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<[ Conversion Functions Between Color Models: RGB, HSL, HSV, and etc. ]>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts an RGB representation of a color to an HSV representation of the same color.
'
' return
' This function returns an HSV representation, stored as a ColorVector, of the color passed in through the
' pRGBvec parameter
'
' param
' pRGBvec is a ColorVector containing an RGB representation of a color. This color is translated into an
' HSV representation of the same color.
' param (optional)
' pHueMax is maximum value allowed for the hue component of the resulting HSV representation of the color.
' Another way of viewing it is that it is the number of segments or chunks or discrete values that the
' continuous hue space is broken down into. It is usually 359, 1 for each degree of the color circle
' (0..359) of the hue space for HSV, but it doesn't have to be. It can be any value >= 0. This parameter
' is used to compute the HSV components of the output ColorVector that this function creates and is itself
' stored in that output ColorVector. It is not used to describe the input ColorVector. The comparable
' value for the input ColorVector is already stored inside that ColorVector when this function is called.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 359.
' param (optional)
' pSaturationMax is maximum value allowed for the saturation component of the resulting HSV representation
' of the color. Another way of viewing it is that it is the number of segments or chunks or discrete
' values that the continuous saturation space is broken down into. It is usually 100, 1 for each
' percentage point (0..100) of the saturation space for HSV, but it doesn't have to be. It can be any
' value >= 0. This parameter is used to compute the HSV components of the output ColorVector that this
' function creates and is itself stored in that output ColorVector. It is not used to describe the input
' ColorVector. The comparable value for the input ColorVector is already stored inside that ColorVector
' when this function is called. If no argument value is passed to this function through this optional
' parameter, its value defaults to 100.
' param (optional)
' pValueMax is maximum value allowed for the "value" component of the resulting HSV representation of the
' color. Another way of viewing it is that it is the number of segments or chunks or discrete values that
' the continuous "value" space is broken down into. It is usually 100, 1 for each percentage point
' (0..100) of the "value" space for HSV, but it doesn't have to be. It can be any value >= 0. This
' parameter is used to compute the HSV components of the output ColorVector that this function creates and
' is itself stored in that output ColorVector. It is not used to describe the input ColorVector. The
' comparable value for the input ColorVector is already stored inside that ColorVector when this function
' is called. If no argument value is passed to this function through this optional parameter, its value
' defaults to 100.
' -----------------------------------------------------------------------------------------------------------
Public Function HSVvecFromRGBvec _
( _
ByRef pRGBvec As ColorVector, _
Optional ByVal pHueMax As Double = 359#, _
Optional ByVal pSaturationMax As Double = 100#, _
Optional ByVal pValueMax As Double = 100# _
) _
As ColorVector
Dim rRatio As Double
Dim gRatio As Double
Dim bRatio As Double
Dim hRatio As Double
Dim sRatio As Double
Dim vRatio As Double
Dim rgbMin As Double
Dim rgbMax As Double
Dim rgbSpan As Double
Dim rSpan As Double
Dim gSpan As Double
Dim bSpan As Double
'
' ==============================================================================================
' all computations are done in terms of the color component ratios. This makes this function
' independent of whatever the color component values or their allowed maximums are.
' ----------------------------------------------------------------------------------------------
rRatio = pRGBvec.xRatio
gRatio = pRGBvec.yRatio
bRatio = pRGBvec.zRatio
'
' ==============================================================================================
' get the min and max of the RGB color components and the distance between them
' ----------------------------------------------------------------------------------------------
rgbMin = min(rRatio, gRatio, bRatio)
rgbMax = max(rRatio, gRatio, bRatio)
rgbSpan = rgbMax - rgbMin
'
' ==============================================================================================
' the HSV value component is equivalent to the max RGB color component value and is in the
' range [0..1]
' ----------------------------------------------------------------------------------------------
vRatio = rgbMax
'
' ==============================================================================================
' if all the RGB color components are the same, then this is gray -- no chroma
' ----------------------------------------------------------------------------------------------
If (rgbSpan = 0#) Then
hRatio = 0#
sRatio = 0#
Else
'
' ==============================================================================================
' compute HSV saturation component which will be in the range [0..1]
' ----------------------------------------------------------------------------------------------
sRatio = rgbSpan / rgbMax
'
' ==============================================================================================
' ----------------------------------------------------------------------------------------------
rSpan = (((rgbMax - rRatio) / 6#) + (rgbSpan / 2#)) / rgbSpan
gSpan = (((rgbMax - gRatio) / 6#) + (rgbSpan / 2#)) / rgbSpan
bSpan = (((rgbMax - bRatio) / 6#) + (rgbSpan / 2#)) / rgbSpan
If (rRatio = rgbMax) Then
hRatio = bSpan - gSpan
ElseIf (gRatio = rgbMax) Then
hRatio = (1# / 3#) + rSpan - bSpan
ElseIf (bRatio = rgbMax) Then
hRatio = (2# / 3#) + gSpan - rSpan
End If
If (hRatio < 0#) Then hRatio = hRatio + 1#
If (hRatio > 1#) Then hRatio = hRatio - 1#
End If
'
' ==============================================================================================
' create the output ColorVector
' ----------------------------------------------------------------------------------------------
HSVvecFromRGBvec = newColorVectorFromRatios(hRatio, sRatio, vRatio, pHueMax, pSaturationMax, pValueMax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts an HSV representation of a color to an RGB representation of the same color.
'
' return
' This function returns an RGB representation, stored as a ColorVector, of the color passed in through the
' pHSVvec parameter
'
' param
' pHSVvec is a ColorVector containing an HSV representation of a color. This color is translated into an
' RGB representation of the same color.
' param (optional)
' pRedMax is maximum value allowed for the red component of the resulting RGB representation of the color.
' Another way of viewing it is that it is the number of segments or chunks or discrete values that the
' continuous red space is broken down into. It is usually 255, which is a value in the range (0..255) and
' can be stored in a single byte, but it doesn't have to be. It can be any value >= 0. This parameter is
' used to compute the RGB components of the output ColorVector that this function creates and is itself
' stored in that output ColorVector. It is not used to describe the input ColorVector. The comparable
' value for the input ColorVector is already stored inside that ColorVector when this function is called.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' param (optional)
' pGreenMax is maximum value allowed for the green component of the resulting RGB representation of the
' color. Another way of viewing it is that it is the number of segments or chunks or discrete values that
' the continuous green space is broken down into. It is usually 255, which is a value in the range
' (0..255) and can be stored in a single byte, but it doesn't have to be. It can be any value >= 0. This
' parameter is used to compute the RGB components of the output ColorVector that this function creates and
' is itself stored in that output ColorVector. It is not used to describe the input ColorVector. The
' comparable value for the input ColorVector is already stored inside that ColorVector when this function
' is called. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' param (optional)
' pBlueMax is maximum value allowed for the blue component of the resulting RGB representation of the
' color. Another way of viewing it is that it is the number of segments or chunks or discrete values that
' the continuous blue space is broken down into. It is usually 255, which is a value in the range (0..255)
' and can be stored in a single byte, but it doesn't have to be. It can be any value >= 0. This parameter
' is used to compute the RGB components of the output ColorVector that this function creates and is itself
' stored in that output ColorVector. It is not used to describe the input ColorVector. The comparable
' value for the input ColorVector is already stored inside that ColorVector when this function is called.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' -----------------------------------------------------------------------------------------------------------
Public Function RGBvecFromHSVvec _
( _
ByRef pHSVvec As ColorVector, _
Optional ByVal pRedMax As Double = 255#, _
Optional ByVal pGreenMax As Double = 255#, _
Optional ByVal pBlueMax As Double = 255# _
) _
As ColorVector
Dim h As Double
Dim s As Double
Dim v As Double
Dim R As Double
Dim G As Double
Dim B As Double
Dim p As Double
Dim q As Double
Dim t As Double
Dim hsvVec As ColorVector
'
' ==============================================================================================
' this algorithm expects the HSV color representation to be in the traditional 359, 100, 100
' form. Make sure the input color's HSV representation is in that form.
' ----------------------------------------------------------------------------------------------
hsvVec = rescaledColorVector(pHSVvec, 359#, 100#, 100#)
'
' ==============================================================================================
' With the exception of computation involving the hue value, the computations are done in terms
' of the color component ratios. This makes this those parts of this function independent of
' whatever the color component values or their allowed maximums are.
' ----------------------------------------------------------------------------------------------
h = hsvVec.x
s = hsvVec.yRatio
v = hsvVec.zRatio
'
' ==============================================================================================
' if all the saturation is 0 (ome shade of gray between white and black)then all the RGB color
' components are just equal to the value, so we're done
' ----------------------------------------------------------------------------------------------
If (s = 0) Then
R = v
G = v
B = v
RGBvecFromHSVvec = newColorVectorFromRatios(v, v, v, pRedMax, pGreenMax, pBlueMax)
Exit Function
End If
'
' ==============================================================================================
' convert the hue to a number between 0 and 5 and then break it into its integral and fractional
' parts.
' usually HSV colors have hue that is a number >= 0 and <= 359, but it doesnt have to be.
' HSVvec.xMax is our maximum hue value and it will almost always be 359.
' ----------------------------------------------------------------------------------------------
Dim oneSixthOfMax As Double
Dim integralPartOfHue As Integer
Dim fractionalPartOfHue As Double
oneSixthOfMax = hsvVec.xMax / 6
h = h / oneSixthOfMax
integralPartOfHue = Application.Floor(h, 1)
fractionalPartOfHue = h - integralPartOfHue
'
' ==============================================================================================
' compute the RGB components as ratios in the range [0..1]
' ----------------------------------------------------------------------------------------------
p = v * (1# - s)
q = v * (1# - (s * fractionalPartOfHue))
t = v * (1# - (s * (1# - fractionalPartOfHue)))
If (integralPartOfHue = 0) Then
R = v
G = t
B = p
ElseIf (integralPartOfHue = 1) Then
R = q
G = v
B = p
ElseIf (integralPartOfHue = 2) Then
R = p
G = v
B = t
ElseIf (integralPartOfHue = 3) Then
R = p
G = q
B = v
ElseIf (integralPartOfHue = 4) Then
R = t
G = p
B = v
Else ' (integralPartOfHue = 5)
R = v
G = p
B = q
End If
'
' ==============================================================================================
' create the output ColorVector
' ----------------------------------------------------------------------------------------------
RGBvecFromHSVvec = newColorVectorFromRatios(R, G, B, pRedMax, pGreenMax, pBlueMax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts an HSL representation of a color to an RGB representation of the same color.
'
' Note: I found this algorithm on the web and can no longer identify the source. If you know the original
' source of this algorithm please reference the site so that I can give the author due credit.
'
' return
' This function returns an RGB representation, stored as a ColorVector, of the color passed in through the
' pHSLvec parameter
'
' param
' pHSLvec is a ColorVector containing an HSL representation of a color. This color is translated into an
' RGB representation of the same color.
' param (optional)
' pRedMax is maximum value allowed for the red component of the resulting RGB representation of the color.
' Another way of viewing it is that it is the number of segments or chunks or discrete values that the
' continuous red space is broken down into. It is usually 255, which is a value in the range (0..255) and
' can be stored in a single byte, but it doesn't have to be. It can be any value >= 0. This parameter is
' used to compute the RGB components of the output ColorVector that this function creates and is itself
' stored in that output ColorVector. It is not used to describe the input ColorVector. The comparable
' value for the input ColorVector is already stored inside that ColorVector when this function is called.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' param (optional)
' pGreenMax is maximum value allowed for the green component of the resulting RGB representation of the
' color. Another way of viewing it is that it is the number of segments or chunks or discrete values that
' the continuous green space is broken down into. It is usually 255, which is a value in the range
' (0..255) and can be stored in a single byte, but it doesn't have to be. It can be any value >= 0. This
' parameter is used to compute the RGB components of the output ColorVector that this function creates and
' is itself stored in that output ColorVector. It is not used to describe the input ColorVector. The
' comparable value for the input ColorVector is already stored inside that ColorVector when this function
' is called. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' param (optional)
' pBlueMax is maximum value allowed for the blue component of the resulting RGB representation of the
' color. Another way of viewing it is that it is the number of segments or chunks or discrete values that
' the continuous blue space is broken down into. It is usually 255, which is a value in the range (0..255)
' and can be stored in a single byte, but it doesn't have to be. It can be any value >= 0. This parameter
' is used to compute the RGB components of the output ColorVector that this function creates and is itself
' stored in that output ColorVector. It is not used to describe the input ColorVector. The comparable
' value for the input ColorVector is already stored inside that ColorVector when this function is called.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' -----------------------------------------------------------------------------------------------------------
Public Function RGBvecFromHSLvec _
( _
ByRef pHSLvec As ColorVector, _
Optional ByVal pRedMax As Double = 255#, _
Optional ByVal pGreenMax As Double = 255#, _
Optional ByVal pBlueMax As Double = 255# _
) _
As ColorVector
Dim rgbR As Double
Dim rgbG As Double
Dim rgbB As Double
If (pHSLvec.yRatio = 0#) Then ' If saturation is 0 the image is monochrome
rgbR = pHSLvec.zRatio
rgbG = pHSLvec.zRatio
rgbB = pHSLvec.zRatio
Else
Dim q As Double
If (pHSLvec.zRatio < 0.5) Then
q = pHSLvec.zRatio * (1# + pHSLvec.yRatio)
Else
q = pHSLvec.zRatio + pHSLvec.yRatio - (pHSLvec.zRatio * pHSLvec.yRatio)
End If
Dim p As Double
p = (2# * pHSLvec.zRatio) - q
rgbR = hueToRGB(p, q, pHSLvec.xRatio + (1# / 3#))
rgbG = hueToRGB(p, q, pHSLvec.xRatio)
rgbB = hueToRGB(p, q, pHSLvec.xRatio - (1# / 3#))
End If
RGBvecFromHSLvec = newColorVectorFromRatios(rgbR, rgbG, rgbB, pRedMax, pGreenMax, pBlueMax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts an HSV representation of a color to an HSL representation of the same color.
'
' return
' This function returns an HSL representation, stored as a ColorVector, of the color passed in through the
' pHSVvec parameter
'
' param
' pHSVvec is a ColorVector containing an HSV representation of a color. This color is translated into an
' HSL representation of the same color.
' param (optional)
' pHueMax is maximum value allowed for the hue component of the resulting HSL representation of the color.
' Another way of viewing it is that it is the number of segments or chunks or discrete values that the
' continuous hue space is broken down into. It is usually 255, which is a value in the range (0..255) and
' can be stored in a single byte, but it doesn't have to be. It can be any value >= 0. This parameter is
' used to compute the HSL components of the output ColorVector that this function creates and is itself
' stored in that output ColorVector. It is not used to describe the input ColorVector. The comparable
' value for the input ColorVector is already stored inside that ColorVector when this function is called.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' param (optional)
' pSaturationMax is maximum value allowed for the saturation component of the resulting HSL representation
' of the color. Another way of viewing it is that it is the number of segments or chunks or discrete
' values that the continuous saturation space is broken down into. It is usually 255, which is a value in
' the range (0..255) and can be stored in a single byte, but it doesn't have to be. It can be any value >=
' 0. This parameter is used to compute the HSL components of the output ColorVector that this function
' creates and is itself stored in that output ColorVector. It is not used to describe the input
' ColorVector. The comparable value for the input ColorVector is already stored inside that ColorVector
' when this function is called. If no argument value is passed to this function through this optional
' parameter, its value defaults to 255.
' param (optional)
' pLuminosityMax is maximum value allowed for the luminosity component of the resulting HSL representation
' of the color. Another way of viewing it is that it is the number of segments or chunks or discrete
' values that the continuous luminosity space is broken down into. It is usually 255, which is a value in
' the range (0..255) and can be stored in a single byte, but it doesn't have to be. It can be any value >=
' 0. This parameter is used to compute the HSL components of the output ColorVector that this function
' creates and is itself stored in that output ColorVector. It is not used to describe the input
' ColorVector. The comparable value for the input ColorVector is already stored inside that ColorVector
' when this function is called. If no argument value is passed to this function through this optional
' parameter, its value defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function HSLvecFromHSVvec _
( _
ByRef pHSVvec As ColorVector, _
Optional ByVal pHueMax As Double = 359#, _
Optional ByVal pSaturationMax As Double = 100#, _
Optional ByVal pLuminosityMax As Double = 100# _
) _
As ColorVector
Dim hslH As Double
Dim hslS As Double
Dim hslL As Double
hslH = pHSVvec.xRatio
hslL = (2 - pHSVvec.yRatio) * pHSVvec.zRatio
hslS = pHSVvec.yRatio * pHSVvec.zRatio
If (hslL <= 1#) Then
hslS = hslS / hslL
Else
hslS = hslS / (2# - hslL)
End If
hslL = hslL / 2#
HSLvecFromHSVvec = newColorVectorFromRatios(hslH, hslS, hslL, pHueMax, pSaturationMax, pLuminosityMax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts an HSL representation of a color to an HSV representation of the same color.
'
' return
' This function returns an HSV representation, stored as a ColorVector, of the color passed in through the
' pHSLvec parameter
'
' param
' pHSLvec is a ColorVector containing an HSL representation of a color. This color is translated into an
' HSV representation of the same color.
' param (optional)
' pHueMax is maximum value allowed for the hue component of the resulting HSV representation of the color.
' Another way of viewing it is that it is the number of segments or chunks or discrete values that the
' continuous hue space is broken down into. It is usually 359, 1 for each degree of the color circle
' (0..359) of the hue space for HSV, but it doesn't have to be. It can be any value >= 0. This parameter
' is used to compute the HSV components of the output ColorVector that this function creates and is itself
' stored in that output ColorVector. It is not used to describe the input ColorVector. The comparable
' value for the input ColorVector is already stored inside that ColorVector when this function is called.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 359.
' param (optional)
' pSaturationMax is maximum value allowed for the saturation component of the resulting HSV representation
' of the color. Another way of viewing it is that it is the number of segments or chunks or discrete
' values that the continuous saturation space is broken down into. It is usually 100, 1 for each
' percentage point (0..100) of the saturation space for HSV, but it doesn't have to be. It can be any
' value >= 0. This parameter is used to compute the HSV components of the output ColorVector that this
' function creates and is itself stored in that output ColorVector. It is not used to describe the input
' ColorVector. The comparable value for the input ColorVector is already stored inside that ColorVector
' when this function is called. If no argument value is passed to this function through this optional
' parameter, its value defaults to 100.
' param (optional)
' pValueMax is maximum value allowed for the "value" component of the resulting HSV representation of the
' color. Another way of viewing it is that it is the number of segments or chunks or discrete values that
' the continuous "value" space is broken down into. It is usually 100, 1 for each percentage point
' (0..100) of the "value" space for HSV, but it doesn't have to be. It can be any value >= 0. This
' parameter is used to compute the HSV components of the output ColorVector that this function creates and
' is itself stored in that output ColorVector. It is not used to describe the input ColorVector. The
' comparable value for the input ColorVector is already stored inside that ColorVector when this function
' is called. If no argument value is passed to this function through this optional parameter, its value
' defaults to 100.
' -----------------------------------------------------------------------------------------------------------
Public Function HSVvecFromHSLvec _
( _
ByRef pHSLvec As ColorVector, _
Optional ByVal pHueMax As Double = 359#, _
Optional ByVal pSaturationMax As Double = 100#, _
Optional ByVal pValueMax As Double = 100# _
) _
As ColorVector
Dim hslH As Double
Dim hslS As Double
Dim hslL As Double
Dim hsvH As Double
Dim hsvS As Double
Dim hsvV As Double
'
' ==============================================================================================
' all computations are done in terms of the color component ratios. This makes this function
' independent of whatever the color component values or their allowed maximums are.
' ----------------------------------------------------------------------------------------------
hslH = pHSLvec.xRatio
hslS = pHSLvec.yRatio
hslL = pHSLvec.zRatio
hsvH = hslH
hslL = hslL * 2#
If (hslL <= 1#) Then
hslS = hslS * hslL
Else
hslS = hslS * (2# - hslL)
End If
hsvV = (hslL + hslS) / 2#
hsvS = (2# * hslS) / (hslL + hslS)
HSVvecFromHSLvec = newColorVectorFromRatios(hsvH, hsvS, hsvV, pHueMax, pSaturationMax, pValueMax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts an RGB representation of a color to an HSL representation of the same color.
'
' return
' This function returns an HSL representation, stored as a ColorVector, of the color passed in through the
' pRGBvec parameter
'
' param
' pRGBvec is a ColorVector containing an RGB representation of a color. This color is translated into an
' HSL representation of the same color.
' param (optional)
' pHueMax is maximum value allowed for the hue component of the resulting HSL representation of the color.
' Another way of viewing it is that it is the number of segments or chunks or discrete values that the
' continuous hue space is broken down into. It is usually 255, which is a value in the range (0..255) and
' can be stored in a single byte, but it doesn't have to be. It can be any value >= 0. This parameter is
' used to compute the HSL components of the output ColorVector that this function creates and is itself
' stored in that output ColorVector. It is not used to describe the input ColorVector. The comparable
' value for the input ColorVector is already stored inside that ColorVector when this function is called.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 359.
' param (optional)
' pSaturationMax is maximum value allowed for the saturation component of the resulting HSL representation
' of the color. Another way of viewing it is that it is the number of segments or chunks or discrete
' values that the continuous saturation space is broken down into. It is usually 255, which is a value in
' the range (0..255) and can be stored in a single byte, but it doesn't have to be. It can be any value >=
' 0. This parameter is used to compute the HSL components of the output ColorVector that this function
' creates and is itself stored in that output ColorVector. It is not used to describe the input
' ColorVector. The comparable value for the input ColorVector is already stored inside that ColorVector
' when this function is called. If no argument value is passed to this function through this optional
' parameter, its value defaults to 100.
' param (optional)
' pLuminosityMax is maximum value allowed for the luminosity component of the resulting HSL representation
' of the color. Another way of viewing it is that it is the number of segments or chunks or discrete
' values that the continuous luminosity space is broken down into. It is usually 255, which is a value in
' the range (0..255) and can be stored in a single byte, but it doesn't have to be. It can be any value >=
' 0. This parameter is used to compute the HSL components of the output ColorVector that this function
' creates and is itself stored in that output ColorVector. It is not used to describe the input
' ColorVector. The comparable value for the input ColorVector is already stored inside that ColorVector
' when this function is called. If no argument value is passed to this function through this optional
' parameter, its value defaults to 100.
' -----------------------------------------------------------------------------------------------------------
Public Function HSLvecFromRGBvec _
( _
ByRef pRGBvec As ColorVector, _
Optional ByVal pHueMax As Double = 359#, _
Optional ByVal pSaturationMax As Double = 100#, _
Optional ByVal pLuminosityMax As Double = 100# _
) _
As ColorVector
Dim rgbR As Double
Dim rgbG As Double
Dim rgbB As Double
Dim hslH As Double
Dim hslS As Double
Dim hslL As Double
Dim maxRgb As Double
Dim minRgb As Double
Dim minToMaxSpan As Double
'
' ==============================================================================================
' all computations are done in terms of the color component ratios. This makes this function
' independent of whatever the color component values or their allowed maximums are.
' ----------------------------------------------------------------------------------------------
rgbR = pRGBvec.xRatio
rgbG = pRGBvec.yRatio
rgbB = pRGBvec.zRatio
'
' ==============================================================================================
' get the min and max of the RGB color components and the distance between them
' ----------------------------------------------------------------------------------------------
minRgb = min(rgbR, rgbG, rgbB)
maxRgb = max(rgbR, rgbG, rgbB)
minToMaxSpan = maxRgb - minRgb
hslL = (maxRgb + minRgb) / 2#
If (maxRgb = minRgb) Then
hslH = 0#
hslS = 0#
Else
If (hslL > 0.5) Then
hslS = minToMaxSpan / (2# - maxRgb - minRgb)
Else
hslS = minToMaxSpan / (maxRgb + minRgb)
End If
If (maxRgb = rgbR) Then
If (rgbG < rgbB) Then
hslH = (rgbG - rgbB) / minToMaxSpan + 6#
Else
hslH = (rgbG - rgbB) / minToMaxSpan
End If
ElseIf (maxRgb = rgbG) Then
hslH = (rgbB - rgbR) / minToMaxSpan + 2#
Else
hslH = (rgbR - rgbG) / minToMaxSpan + 4#
End If
hslH = hslH / 6#
End If
HSLvecFromRGBvec = newColorVectorFromRatios(hslH, hslS, hslL, pHueMax, pSaturationMax, pLuminosityMax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function builds two ColorVectors with the input color's two split compliment colors. The split
' compliment colors' ColorVectors are scaled to the same scale as pAnchorColor and are set at the same
' saturation and luminosity as pAnchorColor.
'
' return
' This function returns a 1-based array containing the two split compliment colors' ColorVectors
'
' param
' pAnchorColor is a ColorVector containing an HSL representation of the color from which the two split
' compliments are computed.
' param (optional)
' pArcDegree is the angle subtended by the arc defined by the two points on the perimeter of the color
' circle representing the locations of the two split compliment hues. IOW, it's the angle between the
' two split compliment hues. If no argument value is passed to this function through this optional
' parameter, its value defaults to 40 degrees.
' -----------------------------------------------------------------------------------------------------------
Public Function splitComplimentsFromHSLvec _
( _
ByRef pAnchorColor As ColorVector, _
Optional ByVal pArcDegree As Double = 40# _
) _
As ColorVector()
Dim halfArc As Double
Dim convertTo359 As Double
Dim convertToInputScale As Double
Dim anchorHue As Double
Dim firstHueClockwiseFromAnchor As Double
Dim secondHueClockwiseFromAnchor As Double
Dim firstColorClockwiseFromAnchor As ColorVector
Dim secondColorClockwiseFromAnchor As ColorVector
Dim result(1 To 2) As ColorVector
'
' ==============================================================================================
' conversion factors for going between pAnchorColor's hue scale and the 359 degree hue scale
' ----------------------------------------------------------------------------------------------
convertTo359 = (359# / pAnchorColor.xMax)
convertToInputScale = (pAnchorColor.xMax / 359#)
'
' ==============================================================================================
' pAnchorColor's hue converted to the 359 degree hue scale
' ----------------------------------------------------------------------------------------------
anchorHue = pAnchorColor.x * convertTo359
'
' ==============================================================================================
' the two split compliment colors in the 359 degree hue scale
' ----------------------------------------------------------------------------------------------
halfArc = pArcDegree / 2#
firstHueClockwiseFromAnchor = CDbl(normalRoundLng(anchorHue + 180# - halfArc) Mod 360&)
secondHueClockwiseFromAnchor = CDbl(normalRoundLng(anchorHue + 180# + halfArc) Mod 360&)
'
' ==============================================================================================
' the two split compliment colors in pAnchorColor's hue scale
' ----------------------------------------------------------------------------------------------
firstHueClockwiseFromAnchor = firstHueClockwiseFromAnchor * convertToInputScale
secondHueClockwiseFromAnchor = secondHueClockwiseFromAnchor * convertToInputScale
'
' ==============================================================================================
' new color vectors for the two spit compliment colors
' ----------------------------------------------------------------------------------------------
firstColorClockwiseFromAnchor = newColorVector(firstHueClockwiseFromAnchor, pAnchorColor.y, pAnchorColor.z, pAnchorColor.xMax, pAnchorColor.yMax, pAnchorColor.zMax)
secondColorClockwiseFromAnchor = newColorVector(secondHueClockwiseFromAnchor, pAnchorColor.y, pAnchorColor.z, pAnchorColor.xMax, pAnchorColor.yMax, pAnchorColor.zMax)
'
' ==============================================================================================
' an array of ColorVectors containg the two split compliment colors to return
' ----------------------------------------------------------------------------------------------
result(1) = firstColorClockwiseFromAnchor
result(2) = secondColorClockwiseFromAnchor
splitComplimentsFromHSLvec = result
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function builds three ColorVectors with the input color's three rectangular tetrad colors. The
' rectangular tetrad colors' ColorVectors are scaled to the same scale as pAnchorColor and are set at the
' same saturation and luminosity as pAnchorColor.
'
' return
' This function returns a 1-based array containing the three rectangular tetrad colors' ColorVectors
'
' param
' pAnchorColor is a ColorVector containing an HSL representation of the color from which the three
' rectangular tetrad are computed.
' -----------------------------------------------------------------------------------------------------------
Public Function rectangularTetradFromHSLvec(ByRef pAnchorColor As ColorVector) As ColorVector()
Dim convertTo359 As Double
Dim convertToInputScale As Double
Dim anchorHue359 As Double
Dim hueAt180ClockWise As Double
Dim hueAt140ClockWise As Double
Dim hueAt320ClockWise As Double
Dim colorAt180Clockwise As ColorVector
Dim colorAt140Clockwise As ColorVector
Dim colorAt320Clockwise As ColorVector
Dim result(1 To 3) As ColorVector
'
' ==============================================================================================
' conversion factors for going between pAnchorColor's hue scale and the 359 degree hue scale
' ----------------------------------------------------------------------------------------------
convertTo359 = (359# / pAnchorColor.xMax)
convertToInputScale = (pAnchorColor.xMax / 359#)
'
' ==============================================================================================
' pAnchorColor's hue converted to the 359 degree hue scale
' ----------------------------------------------------------------------------------------------
anchorHue359 = pAnchorColor.x * convertTo359
'
' ==============================================================================================
' the two rectangular tetrad colors in the 359 degree hue scale
' ----------------------------------------------------------------------------------------------
hueAt180ClockWise = CDbl(normalRoundLng(anchorHue359 + 180#) Mod 360&)
hueAt140ClockWise = CDbl(normalRoundLng(anchorHue359 + 140#) Mod 360&)
hueAt320ClockWise = CDbl(normalRoundLng(anchorHue359 + 320#) Mod 360&)
'
' ==============================================================================================
' the two rectangular tetrad colors in pAnchorColor's hue scale
' ----------------------------------------------------------------------------------------------
hueAt180ClockWise = hueAt180ClockWise * convertToInputScale
hueAt140ClockWise = hueAt140ClockWise * convertToInputScale
hueAt320ClockWise = hueAt320ClockWise * convertToInputScale
'
' ==============================================================================================
' new color vectors for the two spit compliment colors
' ----------------------------------------------------------------------------------------------
colorAt180Clockwise = newColorVector(hueAt180ClockWise, pAnchorColor.y, pAnchorColor.z, pAnchorColor.xMax, pAnchorColor.yMax, pAnchorColor.zMax)
colorAt140Clockwise = newColorVector(hueAt140ClockWise, pAnchorColor.y, pAnchorColor.z, pAnchorColor.xMax, pAnchorColor.yMax, pAnchorColor.zMax)
colorAt320Clockwise = newColorVector(hueAt320ClockWise, pAnchorColor.y, pAnchorColor.z, pAnchorColor.xMax, pAnchorColor.yMax, pAnchorColor.zMax)
'
' ==============================================================================================
' an array of ColorVectors containg the two rectangular tetrad colors to return
' ----------------------------------------------------------------------------------------------
result(1) = colorAt180Clockwise
result(2) = colorAt140Clockwise
result(3) = colorAt320Clockwise
rectangularTetradFromHSLvec = result
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<[ DEPRECATED Conversion Functions Between Color Models: RGB, HSL, HSV, and etc. ]>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ---------------------------------------------------------------------------------------------------------------------
' The functions in this section that involve HSL representations default to HSL component value maximums of 255, 255,
' 255. This is the old standard, the new standard is 359, 100, 100. All the older code that uses this module was built
' assuming the old standard and would require modification to upgrade to the new standard. Consequently, to avoid that
' significant rework, I've added optional parameters to the functions in this section that involve HSL which default to
' the old standard so that the old code that does not use those parameters will continue to work. New code that uses
' these functions and that use the new HSL standard will need to utilize the new optional parameters to pass in the new
' standard maximums.
'
' Note also that the functions in this section that return a packed Long representation of the 3 color components use
' 255, 255, 255 as the maximums for the HSL and HSV outputs. This is because the value 359 does not fit into a 1 byte
' portion of the packed Long output as required by the standard for packed Longs established by the built-in VBA
' function RGB().
' ---------------------------------------------------------------------------------------------------------------------
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts an HSV representation of a color to an HSL representation
'
' return
' this function returns a Long whole number representing an HSL color value. See the built in VBA
' function RGB() for an explanation of this representation.
'
' param (input)
' pHsvH is where the HSV hue value (H) will be stored when this function exits and it's value is in the
' range [0..359]
' param (input)
' pHsvS is the HSV saturation value (S) will be stored when this function exits and it's value is in the
' range [0..100]
' param (input)
' pHsvL is the HSV luminosity value (L) will be stored when this function exits and it's value is in the
' range [0..100]
' param (output)
' pHslH is where the HSL hue value (H) will be stored when this function exits and it's value is in the
' range [0..255]
' param (output)
' pHslS is the HSL saturation value (S) will be stored when this function exits and it's value is in the
' range [0..255]
' param (output)
' pHslL is the HSL luminosity value (L) will be stored when this function exits and it's value is in the
' range [0..255]
' param (optional)
' pHsvHMax is maximum value allowed for the hue component of the HSV input If no argument value is passed
' to this function through this optional parameter, its value defaults to 359.
' param (optional)
' pHsvSMax is maximum value allowed for the saturation component of the HSV input If no argument value is
' passed to this function through this optional parameter, its value defaults to 100.
' param (optional)
' pHsvVMax is maximum value allowed for the value component of the HSV input If no argument value is
' passed to this function through this optional parameter, its value defaults to 100.
' param (optional)
' pHslHMax is maximum value allowed for the hue component of the resulting HSL representation of the color.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' param (optional)
' pHslSMax is maximum value allowed for the saturation component of the resulting HSL representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' param (optional)
' pHslLMax is maximum value allowed for the luminosity component of the resulting HSL representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function hsvToHsl _
( _
ByVal pHsvH As Long, _
ByVal pHsvS As Long, _
ByVal pHsvV As Long, _
ByRef pHslH As Long, _
ByRef pHslS As Long, _
ByRef pHslL As Long, _
Optional ByVal pHsvHmax As Long = 359&, _
Optional ByVal pHsvSmax As Long = 100&, _
Optional ByVal pHsvVmax As Long = 100&, _
Optional ByVal pHslHmax As Long = 255&, _
Optional ByVal pHslSmax As Long = 255&, _
Optional ByVal pHslLmax As Long = 255& _
) _
As Long
Dim hsvVec As ColorVector
Dim hslVec As ColorVector
hsvVec = newColorVector(CDbl(pHsvH), CDbl(pHsvS), CDbl(pHsvV), CDbl(pHsvHmax), CDbl(pHsvSmax), CDbl(pHsvVmax))
hslVec = HSLvecFromHSVvec(hsvVec, CDbl(pHslHmax), CDbl(pHslSmax), CDbl(pHslLmax))
pHslH = normalRoundLng(hslVec.x)
pHslS = normalRoundLng(hslVec.y)
pHslL = normalRoundLng(hslVec.z)
hsvToHsl = toRgb(pHslH, pHslS, pHslL, pHslHmax, pHslSmax, pHslLmax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' These functions convert an HSV representation of a color to an HSL representation and return one of the HSL
' components
'
' return
' These functions return one ofg the HSL components
'
' param (input)
' pHsvH is where the HSV hue value (H) will be stored when this function exits and it's value is in the
' range [0..359]
' param (input)
' pHsvS is the HSV saturation value (S) will be stored when this function exits and it's value is in the
' range [0..100]
' param (input)
' pHsvL is the HSV luminosity value (L) will be stored when this function exits and it's value is in the
' range [0..100]
' param (optional)
' pHsvHMax is maximum value allowed for the hue component of the HSV input If no argument value is passed
' to this function through this optional parameter, its value defaults to 359.
' param (optional)
' pHsvSMax is maximum value allowed for the saturation component of the HSV input If no argument value is
' passed to this function through this optional parameter, its value defaults to 100.
' param (optional)
' pHsvVMax is maximum value allowed for the value component of the HSV input If no argument value is
' passed to this function through this optional parameter, its value defaults to 100.
' param (optional)
' pHslHMax is maximum value allowed for the hue component of the resulting HSL representation of the color.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' param (optional)
' pHslSMax is maximum value allowed for the saturation component of the resulting HSL representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' param (optional)
' pHslLMax is maximum value allowed for the luminosity component of the resulting HSL representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function hsvToHslHue _
( _
ByVal pHsvH As Long, _
ByVal pHsvS As Long, _
ByVal pHsvV As Long, _
Optional ByVal pHsvHmax As Long = 359&, _
Optional ByVal pHsvSmax As Long = 100&, _
Optional ByVal pHsvVmax As Long = 100&, _
Optional ByVal pHslHmax As Long = 255&, _
Optional ByVal pHslSmax As Long = 255&, _
Optional ByVal pHslLmax As Long = 255& _
) _
As Long
Dim hslH As Long
Dim hslS As Long
Dim hslL As Long
Dim junk As Long
junk = hsvToHsl(pHsvH, pHsvS, pHsvV, hslH, hslS, hslL, pHsvHmax, pHsvSmax, pHsvVmax, pHslHmax, pHslSmax, pHslLmax)
hsvToHslHue = hslH Mod (pHslHmax + 1)
End Function
Public Function hsvToHslSat _
( _
ByVal pHsvH As Long, _
ByVal pHsvS As Long, _
ByVal pHsvV As Long, _
Optional ByVal pHsvHmax As Long = 359&, _
Optional ByVal pHsvSmax As Long = 100&, _
Optional ByVal pHsvVmax As Long = 100&, _
Optional ByVal pHslHmax As Long = 255&, _
Optional ByVal pHslSmax As Long = 255&, _
Optional ByVal pHslLmax As Long = 255& _
) _
As Long
Dim hslH As Long
Dim hslS As Long
Dim hslL As Long
Dim junk As Long
junk = hsvToHsl(pHsvH, pHsvS, pHsvV, hslH, hslS, hslL, pHsvHmax, pHsvSmax, pHsvVmax, pHslHmax, pHslSmax, pHslLmax)
hsvToHslSat = hslS Mod (pHslSmax + 1)
End Function
Public Function hsvToHslLum _
( _
ByVal pHsvH As Long, _
ByVal pHsvS As Long, _
ByVal pHsvV As Long, _
Optional ByVal pHsvHmax As Long = 359&, _
Optional ByVal pHsvSmax As Long = 100&, _
Optional ByVal pHsvVmax As Long = 100&, _
Optional ByVal pHslHmax As Long = 255&, _
Optional ByVal pHslSmax As Long = 255&, _
Optional ByVal pHslLmax As Long = 255& _
) _
As Long
Dim hslH As Long
Dim hslS As Long
Dim hslL As Long
Dim junk As Long
junk = hsvToHsl(pHsvH, pHsvS, pHsvV, hslH, hslS, hslL, pHsvHmax, pHsvSmax, pHsvVmax, pHslHmax, pHslSmax, pHslLmax)
hsvToHslLum = hslL Mod (pHslLmax + 1)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts an RGB color to an HSL color.
'
' return
' this function returns a Long whole number representing an HSL color value. See the built in VBA
' function RGB() for an explanation of this representation.
'
' param
' pRgb is a Long whole number representing an RGB color value. See the built in VBA function RGB() for
' an explanation of this representation.
' param (output)
' pH is where the HSL hue value (H) will be stored when this function exits and it's value is in the
' range [0, 255]
' param (output)
' pS is the HSL saturation value (S) will be stored when this function exits and it's value is in the
' range [0, 255]
' param (output)
' pL is the HSL luminosity value (L) will be stored when this function exits and it's value is in the
' range [0, 255]
' param (optional)
' pRgbRMax is maximum value allowed for the red component of the RGB input If no argument value is passed
' to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pRgbGMax is maximum value allowed for the green component of the RGB input If no argument value is
' passed to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pRgbBMax is maximum value allowed for the blue component of the RGB input If no argument value is
' passed to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pHslHMax is maximum value allowed for the hue component of the resulting HSL representation of the color.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' param (optional)
' pHslSMax is maximum value allowed for the saturation component of the resulting HSL representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' param (optional)
' pHslLMax is maximum value allowed for the luminosity component of the resulting HSL representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function rgbToHsl _
( _
ByVal pRgb As Long, _
ByRef pH As Long, _
ByRef pS As Long, _
ByRef pL As Long, _
Optional ByVal pRgbRmax As Long = 255&, _
Optional ByVal pRgbGmax As Long = 255&, _
Optional ByVal pRgbBmax As Long = 255&, _
Optional ByVal pHslHmax As Long = 255&, _
Optional ByVal pHslSmax As Long = 255&, _
Optional ByVal pHslLmax As Long = 255& _
) _
As Long
Dim rgbVec As ColorVector
Dim hslVec As ColorVector
rgbVec = newColorVector(CDbl(rgbComponent(pRgb, 1&)), CDbl(rgbComponent(pRgb, 2&)), CDbl(rgbComponent(pRgb, 3&)), CDbl(pRgbRmax), CDbl(pRgbGmax), CDbl(pRgbBmax))
hslVec = HSLvecFromRGBvec(rgbVec, CDbl(pHslHmax), CDbl(pHslSmax), CDbl(pHslLmax))
pH = normalRoundLng(hslVec.x)
pS = normalRoundLng(hslVec.y)
pL = normalRoundLng(hslVec.z)
rgbToHsl = toRgb(pH, pS, pL, pHslHmax, pHslSmax, pHslLmax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' These functions each return one part of the HSL representation of a color given by an RGB representation of
' the color
'
' param
' pRgb is the RGB representation of the color for which one HSL component is returned
' param (optional)
' pRgbRMax is maximum value allowed for the red component of the RGB input If no argument value is passed
' to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pRgbGMax is maximum value allowed for the green component of the RGB input If no argument value is
' passed to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pRgbBMax is maximum value allowed for the blue component of the RGB input If no argument value is
' passed to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pHslHMax is maximum value allowed for the hue component of the resulting HSL representation of the color.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' param (optional)
' pHslSMax is maximum value allowed for the saturation component of the resulting HSL representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' param (optional)
' pHslLMax is maximum value allowed for the luminosity component of the resulting HSL representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function rgbToHue _
( _
ByVal pRgb As Long, _
Optional ByVal pRgbRmax As Long = 255&, _
Optional ByVal pRgbGmax As Long = 255&, _
Optional ByVal pRgbBmax As Long = 255&, _
Optional ByVal pHslHmax As Long = 255&, _
Optional ByVal pHslSmax As Long = 255&, _
Optional ByVal pHslLmax As Long = 255& _
) _
As Long
Dim hue As Long
Dim sat As Long
Dim lum As Long
Dim jnk As Long
jnk = rgbToHsl(pRgb, hue, sat, lum, pRgbRmax, pRgbGmax, pRgbBmax, pHslHmax, pHslSmax, pHslLmax)
rgbToHue = hue
End Function
Public Function rgbToSaturation _
( _
ByVal pRgb As Long, _
Optional ByVal pRgbRmax As Long = 255&, _
Optional ByVal pRgbGmax As Long = 255&, _
Optional ByVal pRgbBmax As Long = 255&, _
Optional ByVal pHslHmax As Long = 255&, _
Optional ByVal pHslSmax As Long = 255&, _
Optional ByVal pHslLmax As Long = 255& _
) _
As Long
Dim hue As Long
Dim sat As Long
Dim lum As Long
Dim jnk As Long
jnk = rgbToHsl(pRgb, hue, sat, lum, pRgbRmax, pRgbGmax, pRgbBmax, pHslHmax, pHslSmax, pHslLmax)
rgbToSaturation = sat
End Function
Public Function rgbToLuminosity _
( _
ByVal pRgb As Long, _
Optional ByVal pRgbRmax As Long = 255&, _
Optional ByVal pRgbGmax As Long = 255&, _
Optional ByVal pRgbBmax As Long = 255&, _
Optional ByVal pHslHmax As Long = 255&, _
Optional ByVal pHslSmax As Long = 255&, _
Optional ByVal pHslLmax As Long = 255& _
) _
As Long
Dim hue As Long
Dim sat As Long
Dim lum As Long
Dim jnk As Long
jnk = rgbToHsl(pRgb, hue, sat, lum, pRgbRmax, pRgbGmax, pRgbBmax, pHslHmax, pHslSmax, pHslLmax)
rgbToLuminosity = lum
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts an RGB color to an HSV color.
'
' return
' this function returns a Long whole number representing an HSV color value. See the built in VBA
' function RGB() for an explanation of this representation.
'
' param
' pRgb is a Long whole number representing an RGB color value. See the built in VBA function RGB() for
' an explanation of this representation.
' param (output)
' pH is where the HSV hue value (H) will be stored when this function exits and it's value is in the
' range [0, 359]
' param (output)
' pS is the HSV saturation value (S) will be stored when this function exits and it's value is in the
' range [0, 100]
' param (output)
' pVal is the HSV value value (L) will be stored when this function exits and it's value is in the
' range [0, 100]
' param (optional)
' pRgbRMax is maximum value allowed for the red component of the RGB input If no argument value is passed
' to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pRgbGMax is maximum value allowed for the green component of the RGB input If no argument value is
' passed to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pRgbBMax is maximum value allowed for the blue component of the RGB input If no argument value is
' passed to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pHsvHMax is maximum value allowed for the hue component of the resulting HSV representation of the color.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' param (optional)
' pHsvSMax is maximum value allowed for the saturation component of the resulting HSV representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' param (optional)
' pHsvVMax is maximum value allowed for the value component of the resulting HSV representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function rgbToHsv _
( _
ByVal pRgb As Long, _
ByRef pH As Long, _
ByRef pS As Long, _
ByRef pVal As Long, _
Optional ByVal pRgbRmax As Long = 255&, _
Optional ByVal pRgbGmax As Long = 255&, _
Optional ByVal pRgbBmax As Long = 255&, _
Optional ByVal pHsvHmax As Long = 255&, _
Optional ByVal pHsvSmax As Long = 255&, _
Optional ByVal pHsvVmax As Long = 255& _
) _
As Long
Dim rgbVec As ColorVector
Dim hsvVec As ColorVector
rgbVec = newColorVector(CDbl(rgbComponent(pRgb, 1&)), CDbl(rgbComponent(pRgb, 2&)), CDbl(rgbComponent(pRgb, 3&)), CDbl(pRgbRmax), CDbl(pRgbGmax), CDbl(pRgbBmax))
hsvVec = HSVvecFromRGBvec(rgbVec, CDbl(pHsvHmax), CDbl(pHsvSmax), CDbl(pHsvVmax))
pH = normalRoundLng(hsvVec.x)
pS = normalRoundLng(hsvVec.y)
pVal = normalRoundLng(hsvVec.z)
rgbToHsv = toRgb(pH, pS, pVal, pHsvHmax, pHsvSmax, pHsvVmax)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' These functions each return one part of the HSV representation of a color given by an RGB representation of
' the color
'
' param
' pRgb is the RGB representation of the color for which one HSV component is returned
' param (optional)
' pRgbRMax is maximum value allowed for the red component of the RGB input If no argument value is passed
' to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pRgbGMax is maximum value allowed for the green component of the RGB input If no argument value is
' passed to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pRgbBMax is maximum value allowed for the blue component of the RGB input If no argument value is
' passed to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pHsvHMax is maximum value allowed for the hue component of the resulting HSV representation of the color.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' param (optional)
' pHsvSMax is maximum value allowed for the saturation component of the resulting HSV representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' param (optional)
' pHsvVMax is maximum value allowed for the value component of the resulting HSV representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function rgbToHsvHue _
( _
ByVal pRgb As Long, _
Optional ByVal pRgbRmax As Long = 255&, _
Optional ByVal pRgbGmax As Long = 255&, _
Optional ByVal pRgbBmax As Long = 255&, _
Optional ByVal pHsvHmax As Long = 255&, _
Optional ByVal pHsvSmax As Long = 255&, _
Optional ByVal pHsvVmax As Long = 255& _
) _
As Long
Dim hue As Long
Dim sat As Long
Dim vlu As Long
Dim jnk As Long
jnk = rgbToHsv(pRgb, hue, sat, vlu, pRgbRmax, pRgbGmax, pRgbBmax, pHsvHmax, pHsvSmax, pHsvVmax)
rgbToHsvHue = hue
End Function
Public Function rgbToHsvSaturation _
( _
ByVal pRgb As Long, _
Optional ByVal pRgbRmax As Long = 255&, _
Optional ByVal pRgbGmax As Long = 255&, _
Optional ByVal pRgbBmax As Long = 255&, _
Optional ByVal pHsvHmax As Long = 255&, _
Optional ByVal pHsvSmax As Long = 255&, _
Optional ByVal pHsvVmax As Long = 255& _
) _
As Long
Dim hue As Long
Dim sat As Long
Dim vlu As Long
Dim jnk As Long
jnk = rgbToHsv(pRgb, hue, sat, vlu, pRgbRmax, pRgbGmax, pRgbBmax, pHsvHmax, pHsvSmax, pHsvVmax)
rgbToHsvSaturation = sat
End Function
Public Function rgbToHsvValue _
( _
ByVal pRgb As Long, _
Optional ByVal pRgbRmax As Long = 255&, _
Optional ByVal pRgbGmax As Long = 255&, _
Optional ByVal pRgbBmax As Long = 255&, _
Optional ByVal pHsvHmax As Long = 255&, _
Optional ByVal pHsvSmax As Long = 255&, _
Optional ByVal pHsvVmax As Long = 255& _
) _
As Long
Dim hue As Long
Dim sat As Long
Dim vlu As Long
Dim jnk As Long
jnk = rgbToHsv(pRgb, hue, sat, vlu, pRgbRmax, pRgbGmax, pRgbBmax, pHsvHmax, pHsvSmax, pHsvVmax)
rgbToHsvValue = vlu
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts an HSL color to an RGB color.
'
' return
' this function returns a Long whole number representing an RGB color value. See the built in VBA
' function RGB() for an explanation of this representation.
'
' param
' pH is the HSL hue value (H) and it's value is in the range [0..255]
' param
' pS is the HSL saturation value (S) and it's value is in the range [0..255]
' param
' pL is the HSL luminosity value (L) and it's value is in the range [0..255]
' param (optional)
' pHslHMax is maximum value allowed for the hue component of the input HSL representation of the color.
' If no argument value is passed to this function through this optional parameter, its value defaults to
' 255.
' param (optional)
' pHslSMax is maximum value allowed for the saturation component of the input HSL representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' param (optional)
' pHslLMax is maximum value allowed for the luminosity component of the input HSL representation of
' the color. If no argument value is passed to this function through this optional parameter, its value
' defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function hslToRgb _
( _
ByVal pH As Double, _
ByVal pS As Double, _
ByVal pL As Double, _
Optional ByVal pHslHmax As Double = 255#, _
Optional ByVal pHslSmax As Double = 255#, _
Optional ByVal pHslLmax As Double = 255# _
) _
As Long
Dim rgbVec As ColorVector
Dim hslVec As ColorVector
hslVec = newColorVector(pH, pS, pL, pHslHmax, pHslSmax, pHslLmax)
rgbVec = RGBvecFromHSLvec(hslVec, 255#, 255#, 255#)
hslToRgb = toRgb(normalRoundLng(rgbVec.x), normalRoundLng(rgbVec.y), normalRoundLng(rgbVec.z), 255&, 255&, 255&)
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ Color Utilities ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the red, green, or blue color component value from a whole number representing a
' native VBA rgb color value. See the built in VBA functionRGB() for an explanation of this representation.
'
' return
' The R, G, or B color component (0 - 255) as a Long
'
' param
' pRgb is the Long in VBA's native rgb format from which one color component (R, G, or B) will be
' extracted.
' param
' pComponent is the component number as a Long that represents the component color to return (1=red,
' 2=green, 3=blue).
' -----------------------------------------------------------------------------------------------------------
Public Function rgbComponent(ByVal pRgb As Long, ByVal pComponent As Long) As Long
Dim shifts As Long
Dim result As Long
shifts = forceIntoRange(pComponent, 1&, 4&)
shifts = (shifts - 1&)
result = (pRgb And cSixHexDigitsMask)
result = shiftBytesRight(result, shifts)
result = result And cFirstByteMask
rgbComponent = result
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function packs three color component values into a single Long. If the three components Y, Y, and Z
' represent the Red, Green, Blue components of an RGB value, then this function is effectively a cover
' function for the VBA RGB() function. This allows the RGB value to be retrieved from a worksheet function.
'
' return
' an Long value representing a color value from a set of x, y and z color components
'
' param
' pX is the x component value of the resulting value
' param
' pY is the y component value of the resulting value
' param
' pZ is the z component value of the resulting value
' param (optional)
' pXMax is maximum value allowed for the pX component. As an example value: it would be 255 for the rgb
' red component or the hsl hue component used by Windows. If no argument value is passed to this procedure
' through this optional parameter, its value defaults to 255.
' param (optional)
' pYMax is maximum value allowed for the pY component. As an example value: it would be 255 for the rgb
' green component or the hsl saturation component used by Windows. If no argument value is passed to this
' procedure through this optional parameter, its value defaults to 255.
' param (optional)
' pZMax is maximum value allowed for the pZ component. As an example value: it would be 255 for the rgb
' blue component or the hsl luminosity component used by Windows. If no argument value is passed to this
' procedure through this optional parameter, its value defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function toRgb _
( _
ByVal pX As Long, _
ByVal pY As Long, _
ByVal pZ As Long, _
Optional ByVal pXMax As Long = 255&, _
Optional ByVal pYMax As Long = 255&, _
Optional ByVal pZMax As Long = 255& _
) _
As Long
'
' ==============================================================================================
' convert x, Y, and Z to the range [0..255] so they fit in a byte
' ----------------------------------------------------------------------------------------------
If (pXMax <> 255&) Then pX = normalRoundLng(equivalentNumerator(CDbl(pX), CDbl(pXMax), 255#))
If (pYMax <> 255&) Then pY = normalRoundLng(equivalentNumerator(CDbl(pY), CDbl(pYMax), 255#))
If (pZMax <> 255&) Then pZ = normalRoundLng(equivalentNumerator(CDbl(pZ), CDbl(pZMax), 255#))
'
' ==============================================================================================
' do these separately so that they don't get skipped because of being in an if statement
' ----------------------------------------------------------------------------------------------
pX = pX Mod 256&
pY = pY Mod 256&
pZ = pZ Mod 256&
'
' ==============================================================================================
' load them each into one byte of a Long and return the resulting Long
' ----------------------------------------------------------------------------------------------
toRgb = rgb(pX, pY, pZ)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This utility function is used to convert a long back and forth between rgb and html format
'
' return
' an Long value representing a value that's been transformed from rgb to html or visa versa.
'
' param
' pValue is the Long to change either from rgb to html or theother way around.
' -----------------------------------------------------------------------------------------------------------
Public Function swapFirstAndThirdByte(ByVal pValue As Long) As Long
Dim byte1 As Long
Dim byte2 As Long
Dim byte3 As Long
byte1 = rgbComponent(pValue, 1&)
byte2 = rgbComponent(pValue, 2&)
byte3 = rgbComponent(pValue, 3&)
swapFirstAndThirdByte = toRgb(byte3, byte2, byte1, 255&, 255&, 255&)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function adjusts an RGB color by the specified HSL deltas
'
' return
' this function returns a Long whole number representing an RGB color value. See the built in VBA
' function RGB() for an explanation of this representation.
'
' param
' pRgb is a Long whole number representing an RGB color value. See the built in VBA function RGB() for
' an explanation of this representation.
' param
' pDeltaH is the specified delta to the HSL hue value (H)
' param
' pDeltaS is the specified delta to the HSL saturation value (S)
' param
' pDeltaL is the specified delta to the HSL luminosity value (L)
' -----------------------------------------------------------------------------------------------------------
Public Function transformedRgbToHslToRgb(ByVal pRgb As Long, ByVal pDeltaH As Long, ByVal pDeltaS As Long, ByVal pDeltaL As Long) As Long
Dim tH As Long
Dim tS As Long
Dim tL As Long
Dim tRgb As Long
tRgb = rgbToHsl(pRgb, tH, tS, tL)
tH = (tH + pDeltaH) Mod 256&
tS = (tS + pDeltaS) Mod 256&
tL = (tL + pDeltaL) Mod 256&
transformedRgbToHslToRgb = hslToRgb(CDbl(tH), CDbl(tS), CDbl(tL))
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the RGB value from the fill value of the specified
' cell.
'
' return
' The Long whole number representing an RGB color value.
'
' param
' pCell is the worksheet cell for which the color component is returned.
' -----------------------------------------------------------------------------------------------------------
Public Function cellRgbValue(ByRef pCell As Range) As Long
cellRgbValue = pCell.Interior.Color
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the red, green, or blue color component value from the fill value of the specified
' cell.
'
' return
' The intensity of the color component (0 - 255) as an integer or -1 indicating that an argument was
' invalid.
'
' param
' pCell is the worksheet cell for which the color component is returned.
' param
' pComponent is the component number as integer that represents the component color to return (1=red,
' 2=green, 3=blue).
' -----------------------------------------------------------------------------------------------------------
Public Function cellRgbComponent(ByRef pCell As Range, ByVal pComponent As Long) As Long
cellRgbComponent = rgbComponent(pCell.Interior.Color, pComponent)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the percieved brightness of an RGB color. I found it along with the following
' narative at:
' http://www.nbdtech.com/blog/archive/2008/04/27/Calculating-the-Perceived-Brightness-of-a-Color.aspx
'
' I needed a way to test if a background color is light or dark in order to choose an appropriate text color
' (black on light colors and white on dark colors), you can find yourself in the same problem if you try to
' convert an image to grayscale.
'
' I found many approaches that didn�t work well, I�ll describe them and the problems I discovered below �
' but first � the successful solution.
'
' I finally found a solution that actually works on this web page (http://alienryderflex.com/hsp.html) the
' formula is:
'
' brightness = sqrt( .241 R2 + .691 G2 + .068 B2 )
'
' Or, in C# using the WPFs Color structure System.Windows.Media.Color (the same exact code should also work
' with the System.Drawing.Color structure used in WinForms and WebForms):
'
' private static int Brightness(Color c)
' {
' return (int)Math.Sqrt
' (
' c.R * c.R * .241 +
' c.G * c.G * .691 +
' c.B * c.B * .068
' );
' }
'
' This subroutine will return a number in the rage of 0 (black) to 255 (White) and to set the foreground
' color based on the Brightness method:
'
' Color textColor = Brightness(backgroundColor) < 130 ? Colors.White : Colors.Black;
'
' I selected cutoff value of 130 by trial and error and it reflects my taste, every value in the rage
' 128-145 will give acceptable results.
'
' Here is a table of all the named colors in .net 3.0, each with its name in readable text on it based on
' the code above, the number in parenthesis is the brightness � click on the image to view it in full size
' (in a new browser window).
'
'
' Usually, when talking about color theory the range 0-1 is used for each component � so (0,0,0) is black,
' (1,1,1) is white and (0.5,0.5,0.5) is 50% gray, I�m not using this range, I�m using the 0-255 range used
' in most programming environments.
'
' Why Not HSL or HSV?
'
' You may think that the luminance (or luminosity) component of the HSL color system or the value
' component of HSV will solve this problem, I did, but I was wrong.
'
' The L component of the HSL and the V component of HSV describe the brightness of a color relative to a
' base color, if this base color is blue you will get a darker color than if this base color is yellow, HSL
' and HSV are very useful if you need to create a lighter or darker version of a color but aren�t very
' useful if you want to know how bright a color is.
'
' The Na�ve RGB Algorithm
'
' If RGB 0,0,0 is black and RGB 255,255,255 is white then R+B+G should give us a good approximation of
' the color brightness, shouldn�t it?
'
' The problem is that some colors are brighter than others, red is brighter then blue and green is
' brighter then red, maybe we just need to find the right coefficients for them?
'
' The W3C Algorithm
'
' The W3C working draft on accessibility has a formula for the perceived brightness of a color (based on
' the YIQ color system):
'
' ((Red value X 299) + (Green value X 587) + (Blue value X 114)) / 1000
'
' This formula and references to it dominate the search results, probably because the W3C has high search
' engine rank.
'
' This is better than using HSL, but it tends to give wrong results for many colors, especially shades of
' yellow.
'
' RGB Color Difference
'
' The W3C also has an algorithm to calculate the difference between colors:
'
' (maximum (Red value 1, Red value 2) - minimum (Red value 1, Red value 2)) + (maximum (Green value 1,
' Green value 2) - minimum (Green value 1, Green value 2)) + (maximum (Blue value 1, Blue value 2) -
' minimum (Blue value 1, Blue value 2))
'
' Or, in shorter form:
'
' dR + dG + dB
'
' Where dR, dG and dB are the difference in the Red, Green and Blue component.
'
' If you calculate difference from white and difference from black � and compare them (if difference from
' black>difference from white then the color is dark) you actually get better results than using the
' brightness formula, but then you get wrong results for light greens and dark blues (probably because
' this formula doesn�t take into account the brightness difference of the colors).
'
' 3D Distance in RGB Space
'
' You can think of the RGB color space as a cube where each of the 3 colors are axis, in one corner you
' have black (RGB 0,0,0) and in the opposite corner you have white RGB (255,255,255), so if a color is
' closer to black it should be darker.
'
' The formula for 3D distance is:
'
' Sqrt(dx2+dy2+dz2)
'
' Where dx, dy and dz are the difference on the x, y and z axis.
'
' This algorithm also gives mixed results because it doesn�t take into account the fact that some colors
' look brighter than others - and that�s gets us back to �
'
' Weighted Distance in 3D RGB Space (or the HSP algorithm)
'
' If you scroll up to the beginning of this post and look at the brightness formula there you will see
' it�s just like the 3D distance formula except it gives different weight to each axis.
'
' So now we finished our tour to color brightness land we have a good formula for calculating perceived
' brightness and (if my explanations where clear) we can actually understand why it works.
'
' return
' The percieved brightness (0 - 255) of an RGB color.
'
' param
' pRgb is the Long whole number representing an RGB color value.
' -----------------------------------------------------------------------------------------------------------
Public Function brightness(ByVal pRgb As Long) As Double
'
' ==============================================================================================
' Are we using the old or new algorithm?
' => old: http://www.nbdtech.com/blog/archive/2008/04/27/Calculating-the-Perceived-Brightness-of-a-Color.aspx
' => new: http://colaargh.blogspot.co.uk/2016/02/readable-text-in-colour.html
' ----------------------------------------------------------------------------------------------
Const algo = "new"
'
' ==============================================================================================
' If it's the new algorithm...
' ----------------------------------------------------------------------------------------------
If (algo = "new") Then
Dim R As Double
Dim G As Double
Dim B As Double
Dim exp As Double
Dim expInv As Double
Dim coeffR As Double
Dim coeffG As Double
Dim coeffB As Double
Dim termR As Double
Dim termG As Double
Dim termB As Double
R = CDbl(rgbComponent(pRgb, 1&))
G = CDbl(rgbComponent(pRgb, 2&))
B = CDbl(rgbComponent(pRgb, 3&))
exp = 2.235
expInv = 1 / exp
coeffR = 0.22475
coeffG = 0.7154
coeffB = 0.05575
termR = coeffR * (R ^ exp)
termG = coeffG * (G ^ exp)
termB = coeffB * (B ^ exp)
brightness = (termR + termG + termB) ^ expInv
'
' ==============================================================================================
' Else it's the old algorithm...
' ----------------------------------------------------------------------------------------------
Else
'
' ==============================================================================================
' the original brightness factors for each RGB component (from the algorithm found on the web)
' ----------------------------------------------------------------------------------------------
Const briteFactorR = 0.241
Const briteFactorG = 0.691
Const briteFactorB = 0.068
'
' ==============================================================================================
' some relationships among the original factors because I'm going to change them and need to do
' some calculations
' ----------------------------------------------------------------------------------------------
Const RB = briteFactorR + briteFactorB
Const RdivRB = briteFactorR / RB
Const BdivRB = briteFactorB / RB
'
' ==============================================================================================
' change the brightness factor for the green component (which seems over valued on my screen)
' there doesnt seem to be a factor change I can make that works acroos the color
' luminescence range
' ----------------------------------------------------------------------------------------------
Const CG = briteFactorG
Const CHG_G = (briteFactorG - CG)
'
' ==============================================================================================
' now make a compensating change to the red and blue components' brightness factors
' ----------------------------------------------------------------------------------------------
Const CR = briteFactorR + (RdivRB * CHG_G)
Const CB = briteFactorB + (BdivRB * CHG_G)
'
' ==============================================================================================
' get the RGB components as Doubles (for precision calculations)
' ----------------------------------------------------------------------------------------------
Dim rComponent As Double
Dim gComponent As Double
Dim bComponent As Double
rComponent = CDbl(rgbComponent(pRgb, 1&))
gComponent = CDbl(rgbComponent(pRgb, 2&))
bComponent = CDbl(rgbComponent(pRgb, 3&))
'
' ==============================================================================================
' finally, compute the brightness with the modified factors. For reference, here's the
' original calculation:
' brightness = Sqr((rComponent * rComponent * 0.241) + (gComponent * gComponent * 0.691) +
' (bComponent * bComponent * 0.068))
' ----------------------------------------------------------------------------------------------
brightness = Sqr((rComponent * rComponent * CR) + (gComponent * gComponent * CG) + (bComponent * bComponent * CB))
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function adjusts the brightness of one RGB value (pRgb2) to match the brightness of another RGB value
' (pRgb1)
'
' ** NOTICE ** This function does not work consistently across the color luminescence range so dont use it.
'
' return
' Long whole number representing an RGB color value that is an adjustment of pRgb2 to match the
' brightness of pRgb1
'
' param
' pRgb1 is the Long whole number representing the RGB color value whose brightness is to be matched.
' param
' pRgb2 is the Long whole number representing the RGB color value whose brightness is to be adjusted.
' -----------------------------------------------------------------------------------------------------------
Public Function matchBrightness(ByVal pRgb1 As Long, ByVal pRgb2 As Long) As Long
'
' ==============================================================================================
' if pRgb1 and pRgb2 are the same there is no adjustment to make
' ----------------------------------------------------------------------------------------------
If (pRgb1 = pRgb2) Then
matchBrightness = pRgb2
Exit Function
End If
'
' ==============================================================================================
' a place to store the HSL components as Longs
' ----------------------------------------------------------------------------------------------
Dim lH As Long
Dim lS As Long
Dim lL As Long
'
' ==============================================================================================
' a place to store the HSL components as Doubles (for precision calculations)
' ----------------------------------------------------------------------------------------------
Dim dH As Double
Dim dS As Double
Dim dL As Double
'
' ==============================================================================================
' a place to store the evolving value of the new RGB being computed from pRgb2
' ----------------------------------------------------------------------------------------------
Dim nRgb2 As Long
'
' ==============================================================================================
' a place to store the brightness of pRgb1 and nRgb2
' ----------------------------------------------------------------------------------------------
Dim b1 As Double
Dim b2 As Double
'
' ==============================================================================================
' other vars
' ----------------------------------------------------------------------------------------------
Dim hsl As Long
'
' ==============================================================================================
' calc the starting brightness and get the HSL components for the RGB we're gonna be adjusting
' - pRgb2
' ----------------------------------------------------------------------------------------------
b1 = brightness(pRgb1)
b2 = brightness(pRgb2)
hsl = rgbToHsl(pRgb2, lH, lS, lL)
dH = CDbl(lH)
dS = CDbl(lS)
dL = CDbl(lL)
'
' ==============================================================================================
' while the evolving new RGB is too dark compared to pRgb1, make it brighter by incrementing
' its luminosity
' ----------------------------------------------------------------------------------------------
While (b2 < b1) And (dL < 255#)
dL = dL + 1#
nRgb2 = hslToRgb(dH, dS, dL)
b2 = brightness(nRgb2)
Wend
'
' ==============================================================================================
' while the evolving new RGB is too bright compared to pRgb1, make it darker by decrementing
' its luminosity
' ----------------------------------------------------------------------------------------------
While (b2 > b1) And (dL > 0#)
dL = dL - 1#
nRgb2 = hslToRgb(dH, dS, dL)
b2 = brightness(nRgb2)
Wend
'
' ==============================================================================================
' return the fully evolved (brightness adjusted) version of pRgb2
' ----------------------------------------------------------------------------------------------
matchBrightness = nRgb2
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the best font color (white or black) for a given fill area color as specified by a
' whole number representing an RGB color value. See the description of the brightness() function for an
' explanation of the "best font color"
'
' return
' Long whole number representing an RGB color value of black or white
'
' param
' pRgb is the Long whole number representing an RGB color value of the fill area.
' -----------------------------------------------------------------------------------------------------------
Public Function bestRgbFontBlackOrWhite(ByVal pRgb As Long) As Long
Dim luminosity As Long
luminosity = hslLuminosity(pRgb)
If Abs(luminosity - 120) < 75& Then
If brightness(pRgb) >= 130# Then
bestRgbFontBlackOrWhite = vbBlack
Else
bestRgbFontBlackOrWhite = vbWhite
End If
ElseIf luminosity > 120& Then
bestRgbFontBlackOrWhite = vbBlack
Else
bestRgbFontBlackOrWhite = vbWhite
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the best font color (white or black) for a given fill area color as specified by a
' whole number representing an RGB color value. See the description of the brightness() function for an
' explanation of the "best font color"
'
' return
' Long whole number representing an RGB color value
'
' param
' pH is the HSL hue value (H) and it's value is in the range [0..255]
' param
' pS is the HSL saturation value (S) and it's value is in the range [0..255]
' param
' pL is the HSL luminosity value (L) and it's value is in the range [0..255]
' param (optional)
' pHueMax is maximum value allowed for the hue component of the HSL representation of the color. Another
' way of viewing it is that it is the number of segments or chunks or discrete values that the continuous
' hue space is broken down into. It is usually 255, which is a value in the range (0..255) and can be
' stored in a single byte, but it doesn't have to be. It can be any value >= 0. This parameter is used to
' characterize the HSL components that are passed into this function. If no argument value is passed to
' this function through this optional parameter, its value defaults to 255.
' param (optional)
' pSaturationMax is maximum value allowed for the saturation component of the HSL representation of the
' color. Another way of viewing it is that it is the number of segments or chunks or discrete values that
' the continuous saturation space is broken down into. It is usually 255, which is a value in the range
' (0..255) and can be stored in a single byte, but it doesn't have to be. It can be any value >= 0. This
' parameter is used to characterize the HSL components that are passed into this function. If no argument
' value is passed to this function through this optional parameter, its value defaults to 255.
' param (optional)
' pLuminosityMax is maximum value allowed for the luminosity component of the HSL representation of the
' color. Another way of viewing it is that it is the number of segments or chunks or discrete values that
' the continuous luminosity space is broken down into. It is usually 255, which is a value in the range
' (0..255) and can be stored in a single byte, but it doesn't have to be. It can be any value >= 0. This
' parameter is used to characterize the HSL components that are passed into this function. If no argument
' value is passed to this function through this optional parameter, its value defaults to 255.
' -----------------------------------------------------------------------------------------------------------
Public Function bestRgbFontColor _
( _
ByVal pH As Double, _
ByVal pS As Double, _
ByVal pL As Double, _
Optional ByVal pHueMax As Double = 255#, _
Optional ByVal pSaturationMax As Double = 255#, _
Optional ByVal pLuminosityMax As Double = 255# _
) _
As Long
'
' ==============================================================================================
' offset from either white or black
' ----------------------------------------------------------------------------------------------
Const LITE_LUM = 255# - 24#
Const DARK_LUM = 0# + 48#
'
' ==============================================================================================
' variables used
' ----------------------------------------------------------------------------------------------
Dim hslVector As ColorVector
Dim hslH As Double
Dim hslS As Double
Dim hslL As Double
'
' ==============================================================================================
' we want to work with HSL components that are scaled to 255.
' ----------------------------------------------------------------------------------------------
hslVector = newColorVector(pH, pS, pL, pHueMax, pSaturationMax, pLuminosityMax)
hslVector = rescaledColorVector(hslVector, 255#, 255#, 255#)
With hslVector
hslH = .x
hslS = .y
hslL = .z
End With
'
' ==============================================================================================
' variables used
' ----------------------------------------------------------------------------------------------
Dim rgbVal As Long
Dim fontHue As Double
Dim fontSat As Double
Dim fontLum As Double
'
' ==============================================================================================
' fontHue and fontSat will be the hue on the other side of the color wheel from pH and pS
' respectively
' ----------------------------------------------------------------------------------------------
fontHue = fmod((hslH + 128#), 256#)
fontSat = fmod((hslS + 128#), 256#)
If (hslL < 16#) Then
fontLum = 255#
ElseIf (hslL > 254#) Then
fontLum = 0#
Else
'
' ==============================================================================================
' convert the original HSL values to Long whole number representing an RGB color
' ----------------------------------------------------------------------------------------------
rgbVal = hslToRgb(hslH, hslS, hslL)
'
' ==============================================================================================
' adjust the luminosity of the font to contrast with the luminosity of the original HSL values
' ----------------------------------------------------------------------------------------------
If Abs(hslL - 120#) < 75# Then
'
' ==============================================================================================
' dark font
' ----------------------------------------------------------------------------------------------
If brightness(rgbVal) >= 130# Then
fontLum = hslL * (70# / 255#) 'DARK_LUM
'
' ==============================================================================================
' light font
' ----------------------------------------------------------------------------------------------
Else
fontLum = 255# - (hslL * (70# / 255#)) 'LITE_LUM
End If
'
' ==============================================================================================
' dark font
' ----------------------------------------------------------------------------------------------
ElseIf hslL > 120# Then
fontLum = hslL * (70# / 255#) 'DARK_LUM
'
' ==============================================================================================
' light font
' ----------------------------------------------------------------------------------------------
Else
fontLum = 255# - (hslL * (70# / 255#)) 'LITE_LUM
End If
End If
'
' ==============================================================================================
' return the font color as an rgb value
' ----------------------------------------------------------------------------------------------
hslVector = newColorVector(fontHue, fontSat, fontLum, 255#, 255#, 255#)
With hslVector
hslH = .x
hslS = .y
hslL = .z
End With
bestRgbFontColor = hslToRgb(hslH, hslS, hslL, 255#, 255#, 255#)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the HSL L value (Luminosity) for a Long whole number representing an RGB color
' value.
'
' The HSL L value is defined as (MAX + Min) / 2 where MAX is the greatest of r, g, and b, and Min is
' the least.
'
' return
' The HSL luminosity component (0 - 255) for a Long whole number representing an RGB color value.
'
' param
' pRgb is the Long whole number representing an RGB color value.
' -----------------------------------------------------------------------------------------------------------
Public Function hslLuminosity(ByVal pRgb As Long) As Long
Dim rgbMax As Long
Dim rgbMin As Long
Dim rComponent As Long
Dim gComponent As Long
Dim bComponent As Long
rComponent = rgbComponent(pRgb, 1)
gComponent = rgbComponent(pRgb, 2)
bComponent = rgbComponent(pRgb, 3)
rgbMax = max(rComponent, gComponent, bComponent)
rgbMin = min(rComponent, gComponent, bComponent)
hslLuminosity = (rgbMax + rgbMin) / 2&
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine, given a saturation and luminosity, computes a contrasting saturation and luminosity
'
' param
' pSin is the given saturation
' param
' pLin is the given luminosity
' param (output)
' pSout is where the contrasting saturation will be stored when this function returns
' param (output)
' pLout is where the contrasting luminosity will be stored when this function returns
' -----------------------------------------------------------------------------------------------------------
Public Sub contrastingSL(ByVal pSin As Double, ByVal pLin As Double, ByRef pSout As Double, ByRef pLout As Double)
pSout = fmod(Abs(255# - (pSin * 6# / 7#)), 255#)
pLout = fmod(Abs(255# - (pLin * 6# / 7#)), 255#)
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine returns a numerical value indicating the difference between two colors. The number is in
' the range 0 to 765 (= 3 * 255). If 2 colors have a colorDifference of >= 510 (= 2* 255), they are
' candidates for using together as forground/background colors in applications where the forground colored
' objects must be easily visible against the background color.
'
' return
' a number in the range 0 .. 765 where 0 means no difference and 765 mean maximum possible difference
'
' param
' pColor1 is an RGB color value to compare against pColor2
' param
' pColor2 is an RGB color value to compare against pColor1
' -----------------------------------------------------------------------------------------------------------
Public Function colorDifference(ByVal pColor1 As Long, ByVal pColor2 As Long) As Long
'
' ==============================================================================================
' variables used
' ----------------------------------------------------------------------------------------------
Dim c1Red As Long
Dim c1Grn As Long
Dim c1Blu As Long
Dim c2Red As Long
Dim c2Grn As Long
Dim c2Blu As Long
Dim minRed As Long
Dim minGrn As Long
Dim minBlu As Long
Dim maxRed As Long
Dim maxGrn As Long
Dim maxBlu As Long
'
' ==============================================================================================
' compute the difference
' ----------------------------------------------------------------------------------------------
c1Red = rgbComponent(pColor1, 1&)
c1Grn = rgbComponent(pColor1, 2&)
c1Blu = rgbComponent(pColor1, 3&)
c2Red = rgbComponent(pColor2, 1&)
c2Grn = rgbComponent(pColor2, 2&)
c2Blu = rgbComponent(pColor2, 3&)
minRed = min(c1Red, c2Red)
minGrn = min(c1Grn, c2Grn)
minBlu = min(c1Blu, c2Blu)
maxRed = max(c1Red, c2Red)
maxGrn = max(c1Grn, c2Grn)
maxBlu = max(c1Blu, c2Blu)
colorDifference = (maxRed - minRed) + (maxGrn - minGrn) + (maxBlu - minBlu)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine returns true if there is a strong color difference between two colors. Two colors are
' defined to have a strong color difference if their colorDifference score is >= 510
'
' return
' True is there is a strong color difference between the two colors, False otherwise.
'
' param
' pColor1 is an RGB color value to compare against pColor2
' param
' pColor2 is an RGB color value to compare against pColor1
' -----------------------------------------------------------------------------------------------------------
Public Function isStrongColorDifference(ByVal pColor1 As Long, ByVal pColor2 As Long) As Boolean
isStrongColorDifference = (colorDifference(pColor1, pColor2) >= 510&)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine returns a numerical value indicating the difference in brightness between two colors. The
' number is in the range 0 to 255. If 2 colors have a brightnessDifference of >= 127, they are candidates
' for using together as forground/background colors in applications where the forground colored objects must
' be easily visible against the background color.
'
' return
' a number in the range 0 .. 255 where 0 means no difference and 255 mean maximum possible difference
'
' param
' pColor1 is an RGB color value to compare against pColor2
' param
' pColor2 is an RGB color value to compare against pColor1
' -----------------------------------------------------------------------------------------------------------
Public Function brightnessDifference(ByVal pColor1 As Long, ByVal pColor2 As Long) As Long
Dim c1Brt As Double
Dim c2Brt As Double
c1Brt = brightness(pColor1)
c2Brt = brightness(pColor2)
brightnessDifference = normalRoundLng(Abs(c1Brt - c2Brt))
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine returns true if there is a strong color brightnessdifference between two colors. Two
' colors are defined to have a strong color brightness difference if their brightnessDifference score is >=
' 127
'
' return
' True is there is a strong color brightness difference between the two colors, False otherwise.
'
' param
' pColor1 is an RGB color value to compare against pColor2
' param
' pColor2 is an RGB color value to compare against pColor1
' -----------------------------------------------------------------------------------------------------------
Public Function isStrongBrightnessDifference(ByVal pColor1 As Long, ByVal pColor2 As Long) As Boolean
isStrongBrightnessDifference = (brightnessDifference(pColor1, pColor2) >= 127&)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This utility function adds an number to a color component (RGB component, Hue, Sat, or Lum) and returns
' the result as a number between 0 and 255 inclusive.
'
' return
' a number between 0 and 255 inclusive
'
' param
' pComponent is a color component
' param
' pAddend is the number to add to the componebt
' -----------------------------------------------------------------------------------------------------------
Public Function colorAddDouble(ByVal pComponent As Double, ByVal pAddend As Double) As Double
colorAddDouble = fmod(Abs(pComponent + pAddend), 255#)
End Function
Public Function colorAddDoubleToLong(ByVal pComponent As Double, ByVal pAddend As Double) As Long
colorAddDoubleToLong = normalRoundLng(colorAddDouble(pComponent, pAddend))
End Function
Public Function colorAddLong(ByVal pComponent As Long, ByVal pAddend As Long) As Long
colorAddLong = colorAddDoubleToLong(CDbl(pComponent), CDbl(pAddend))
End Function
Public Function colorAddLongToDouble(ByVal pComponent As Long, ByVal pAddend As Long) As Double
colorAddLongToDouble = colorAddDouble(CDbl(pComponent), CDbl(pAddend))
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function increments an HSL or HSV hue value by multiple of a proportion of the color wheel.
'
' For example, if have a given hue - h in the range [0..255], and you wanted the value of the hue 1/16th of
' the way around the color wheel clockwise, you would call this function like this:
' hueOneSixteenthFurtherAround = proportionallyIncrementedHue(h, 255, 16, 1)
'
' If you wanted the value of the hue 9/16ths of the way around the color wheel clockwise, you would call this
' function like this:
' hueOneSixteenthFurtherAround = proportionallyIncrementedHue(h, 255, 16, 9)
'
' If your hue was measured in the range [0..359] and wanted the value of the hue 5/16ths of the way around
' the color wheel clockwise, you would call this function like this:
' hueOneSixteenthFurtherAround = proportionallyIncrementedHue(h, 359, 16, 5)
'
' return
' This subroutine returns a Long containing a HSL hue value in the range [0..pHueScale-1]
'
' param
' pHue is the starting hue from which a hue offset by (pMultiple * pProportion) of the color wheel in the
' clockwise direction is returned
' param
' pHueScale is the valid range of hue values plus 1. Another way to see it is that pHueScale is the number
' of hues the color wheel is segmented into, i.e. - how many slices of the color wheel pie there are.
' param
' pProportion is the proportion of the hue range that will be added to pHue to makes up 1 increment
' param
' pMultiple is the number of pProportions thast are added to pHue to get the hue value that this function
' returns.
' -----------------------------------------------------------------------------------------------------------
Public Function proportionallyIncrementedHue _
( _
ByVal pHue As Double, _
ByVal pHueScale As Double, _
ByVal pProportion As Double, _
ByVal pMultiple As Double _
) _
As Double
Dim lcm As Double
Dim inc As Double
Dim hue As Double
Dim hue2LcmFactor As Double
Dim lcm2HueFactor As Double
lcm = Application.lcm(pHueScale, pProportion)
hue2LcmFactor = lcm / pHueScale
lcm2HueFactor = pHueScale / lcm
hue = pHue * hue2LcmFactor
inc = pMultiple * (lcm / pProportion)
hue = hue + inc
hue = fmod(hue * lcm2HueFactor, pHueScale)
proportionallyIncrementedHue = hue
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine uses output parameters to return the three RGB components from an Rgb Long
'
' param
' pRgb is the Rgb Long value from which the separate R, G, and B components will be returned
' param (output)
' pRgbR is the red (R) component
' param (output)
' pRgbG is the green (G) component
' param (output)
' pRgbB is the blue (B) component
' -----------------------------------------------------------------------------------------------------------
Public Sub RGBfromRgb(ByVal pRgb As Long, pRgbR As Integer, pRgbG As Integer, pRgbB As Integer)
pRgbR = pRgb Mod 256
pRgb = pRgb \ 256
pRgbG = pRgb Mod 256
pRgb = pRgb \ 256
pRgbB = pRgb Mod 256
End Sub
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Private Routines ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine validates a ColorVector and if it finds anything wrong it throws an exception to stop the
' application. It validates the ColorVector by:
' => checking that its color component values are within the range of [0..the value specified by their
' corresponding maximum]
' => checking that the color component maximums are all greater than or equal to 1
' => checking that the color component ratios are all in the range of [0..1]
' => checking that the color component ratios multipled by their corresponding maximum is equal to the
' corresponding color component value.
'
' param
' pColorVector is the ColorVector to validate
' param (optional)
' pProcedureName is the name of the procedure that called this validation subroutine. If no argument value
' is passed to this procedure through this optional parameter, its value defaults to the name of this
' procedure.
' param (optional)
' pModuleName is the name of the module containing the procedure that called this validation subroutine If
' no argument value is passed to this procedure through this optional parameter, its value defaults to
' the name of the module containing this procedure.
' -----------------------------------------------------------------------------------------------------------
Private Sub validateColorVector _
( _
ByRef pColorVector As ColorVector, _
Optional ByVal pProcedureName As String = "validateColorVector", _
Optional ByVal pModuleName As String = "M033_Color" _
)
With pColorVector
If (Not isInRange(.x, 0#, .xMax)) Then Call raiseException _
( _
"The ColorVector.x value of: " & .x & " is not within the valid range for .x values, which is [0.." & .xMax & "]", _
pProcedureName, _
pModuleName _
)
If (Not isInRange(.y, 0#, .yMax)) Then Call raiseException _
( _
"The ColorVector.y value of: " & .y & " is not within the valid range for .y values, which is [0.." & .yMax & "]", _
pProcedureName, _
pModuleName _
)
If (Not isInRange(.z, 0#, .zMax)) Then Call raiseException _
( _
"The ColorVector.z value of: " & .z & " is not within the valid range for .z values, which is [0.." & .zMax & "]", _
pProcedureName, _
pModuleName _
)
If (.xMax < 1#) Then Call raiseException _
( _
"The ColorVector.xMax value of: " & .xMax & " is not within the valid range for .xMax values, which is [>=1]", _
pProcedureName, _
pModuleName _
)
If (.yMax < 1#) Then Call raiseException _
( _
"The ColorVector.yMax value of: " & .yMax & " is not within the valid range for .yMax values, which is [>=1]", _
pProcedureName, _
pModuleName _
)
If (.zMax < 1#) Then Call raiseException _
( _
"The ColorVector.zMax value of: " & .zMax & " is not within the valid range for .zMax values, which is [>=1]", _
pProcedureName, _
pModuleName _
)
If (Not isInRange(.xRatio, 0#, 1#)) Then Call raiseException _
( _
"The ColorVector.xRatio value of: " & .xRatio & " is not within the valid range for .xRatio values, which is [0..1]", _
pProcedureName, _
pModuleName _
)
If (Not isInRange(.yRatio, 0#, 1#)) Then Call raiseException _
( _
"The ColorVector.yRatio value of: " & .yRatio & " is not within the valid range for .yRatio values, which is [0..1]", _
pProcedureName, _
pModuleName _
)
If (Not isInRange(.zRatio, 0#, 1#)) Then Call raiseException _
( _
"The ColorVector.zRatio value of: " & .zRatio & " is not within the valid range for .zRatio values, which is [0..1]", _
pProcedureName, _
pModuleName _
)
If (Not doublesAreEqual((.xRatio * .xMax), .x)) Then Call raiseException _
( _
"The ColorVector.x, .xMax, and .xRatio values [" & .x & ", " & .xMax & ", " & .xRatio & _
"] are inconsistent because the value of (.xRatio X .xMax) is " & (.xRatio * .xMax) & _
" and does not equal the value of .x, which is " & .x, _
pProcedureName, _
pModuleName _
)
If (Not doublesAreEqual((.yRatio * .yMax), .y)) Then Call raiseException _
( _
"The ColorVector.y, .yMax, and .yRatio values [" & .y & ", " & .yMax & ", " & .yRatio & _
"] are inconsistent because the value of (.yRatio X .yMax) is " & (.yRatio * .yMax) & _
" and does not equal the value of .y, which is " & .y, _
pProcedureName, _
pModuleName _
)
If (Not doublesAreEqual((.zRatio * .zMax), .z)) Then Call raiseException _
( _
"The ColorVector.z, .zMax, and .zRatio values [" & .z & ", " & .zMax & ", " & .zRatio & _
"] are inconsistent because the value of (.zRatio X .zMax) is " & (.zRatio * .zMax) & _
" and does not equal the value of .z, which is " & .z, _
pProcedureName, _
pModuleName _
)
End With
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function is factored from the RGBvecFromHSLvec function above.
'
' Note: I found this algorithm on the web and can no longer identify the source. If you know the original
' source of this algorithm please reference the site so that I can give the author due credit.
' -----------------------------------------------------------------------------------------------------------
Private Function hueToRGB(ByVal p As Double, ByVal q As Double, ByVal t As Double) As Double
If (t < 0#) Then t = t + 1#
If (t > 1#) Then t = t - 1#
If (t < (1# / 6#)) Then
hueToRGB = p + ((q - p) * 6# * t)
Exit Function
End If
If (t < (1# / 2#)) Then
hueToRGB = q
Exit Function
End If
If (t < (2# / 3#)) Then
hueToRGB = p + (q - p) * ((2# / 3#) - t) * 6#
Exit Function
End If
hueToRGB = p
End Function
Facebook