.
Estando dicutiendo con Psyke1 sobre un metodo de reconocimiento de colores y casi 2 semanas indagando en ello he creado esta clase que verifica si un color es similar a otro (Despresiando el componente Alpha).

Aqui les dejo e modulo de clase:

* La funcion que tiene es que reconoce TONOS de un color y retorna true si es derivado del mismo color ya sea un color mas claro u opaco.

cSpectrumColor.cls

 
'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
'  // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=35:cspectrumcolor&catid=15:catmoduloscls&Itemid=24
'   /////////////////////////////////////////////////////////////
 
Option Explicit
 
Private lRGBA       As Long
 
Public Property Get color() As Long
    color = lRGBA
End Property
 
Public Property Let color(ByVal lColor As Long)
    lRGBA = lColor
End Property
 
Public Function spectrumEqualL(ByVal lColorRGBA As Long, Optional ByVal lTolerance As Long = 10) As Boolean
Dim oSpectrum       As cSpectrumColor
    Set oSpectrum = New cSpectrumColor
    oSpectrum.color = lColorRGBA
    spectrumEqualL = spectrumEqualC(oSpectrum)
    Set oSpectrum = Nothing
End Function
 
Public Function spectrumEqualC(ByVal oSpectrum As cSpectrumColor, Optional ByVal lTolerance As Long = 10) As Boolean
Dim lRed(1)             As Long
Dim lGreen(1)           As Long
Dim lBlue(1)            As Long
Dim lBackColor          As Long
 
    lBackColor = oSpectrum.spectrumScale(oSpectrum.scaleFactorL(lRGBA) - 100)
    Call oSpectrum.componentsRGBA(lRed(1), lGreen(1), lBlue(1), &H0)
    oSpectrum.color = lBackColor
 
    Call componentsRGBA(lRed(0), lGreen(0), lBlue(0), &H0)
 
    If (max(lRed(0), lRed(1)) - min(lRed(0), lRed(1)) < lTolerance) Then
        If (max(lGreen(0), lGreen(1)) - min(lGreen(0), lGreen(1)) < lTolerance) Then
            If (max(lBlue(0), lBlue(1)) - min(lBlue(0), lBlue(1)) < lTolerance) Then
                spectrumEqualC = True
            End If
        End If
    End If
End Function
 
Public Function spectrumScale(ByVal lScale As Double) As Long
Dim lRed                As Long
Dim lGreen              As Long
Dim lBlue               As Long
'Dim lAlpha              As Long
 
    spectrumScale = lRGBA
    Call componentsRGBA(lRed, lGreen, lBlue, &H0)
    Call Me.colorFromRGBA(((lRed * (lScale / 100)) + lRed), ((lGreen * (lScale / 100)) + lGreen), ((lBlue * (lScale / 100)) + lBlue), &H0)
End Function
 
Public Function scaleFactorL(ByVal lColorRGBA As Long) As Double
Dim lRed                As Long
Dim lGreen              As Long
Dim lBlue               As Long
'Dim lAlpha              As Long
 
    Call componentsRGBA(lRed, lGreen, lBlue, &H0)
 
    Select Case max3(lRed, lGreen, lBlue)
        Case lRed: If (lRed) Then scaleFactorL = (lColorRGBA And &HFF&) * 100 / lRed
        Case lGreen: If (lGreen) Then scaleFactorL = ((lColorRGBA And &HFF00&) \ &H100&) * 100 / lGreen
        Case lBlue: If (lBlue) Then scaleFactorL = ((lColorRGBA And &HFF0000) \ &H10000) * 100 / lBlue
    End Select
 
End Function
 
Public Function scaleFactorC(ByVal oSpectrum As cSpectrumColor) As Double
    scaleFactorC = scaleFactorL(oSpectrum.color())
End Function
 
Private Function max(ByVal lVal1 As Long, ByVal lval2 As Long) As Long
    If (lVal1 > lval2) Then
        max = lVal1
    Else
        max = lval2
    End If
End Function
 
Private Function min(ByVal lVal1 As Long, ByVal lval2 As Long) As Long
    If (lVal1 < lval2) Then
        min = lVal1
    Else
        min = lval2
    End If
End Function
 
Private Function max3(ByVal lVal1 As Long, ByVal lval2 As Long, ByVal lval3 As Long) As Long
    max3 = max(max(lVal1, lval2), lval3)
End Function
 
Public Sub componentsRGBA(ByRef lRed As Long, ByRef lGreen As Long, ByRef lBlue As Long, ByRef lAlpha As Long)
    lRed = (lRGBA And &HFF&)
    lGreen = ((lRGBA And &HFF00&) / &H100&)
    lBlue = ((lRGBA And &HFF0000) / &H10000)
    lAlpha = ((lRGBA And &HFF000000) / &H1000000)
End Sub
 
Public Sub colorFromRGBA(ByVal lRed As Long, ByVal lGreen As Long, ByVal lBlue As Long, ByVal lAlpha As Long)
    lRGBA = (lRed)
    lRGBA = (lRGBA Or ((lGreen And &HFF&) * &H100&))
    lRGBA = (lRGBA Or ((lBlue And &HFF&) * &H10000))
    lRGBA = (lRGBA Or ((lAlpha And &HFF&) * &H1000000))
End Sub
 
 

Prueba/Test:

 
 
'   //  En un form...
'   //  Se requieren 6 VScroll (con propiedad Index).
'   //  Se requieren 2 PictureBox (con propiedad Index)
 
Option Explicit
 
Dim oSpectrum(1)    As cSpectrumColor
 
Private Sub Form_Load()
Dim i           As Long
    Set oSpectrum(0) = New cSpectrumColor
    Set oSpectrum(1) = New cSpectrumColor
 
    For i = VScroll1.LBound To VScroll1.UBound
        VScroll1(i).min = 0
        VScroll1(i).max = 255
    Next
End Sub
 
Private Sub Form_Terminate()
    Set oSpectrum(0) = Nothing
    Set oSpectrum(1) = Nothing
End Sub
 
Private Sub VScroll1_Change(Index As Integer)
    Call VScroll1_Scroll(Index)
End Sub
 
Private Sub VScroll1_Scroll(Index As Integer)
Dim i           As Long
    If (Index > &H2) Then i = 1
    Picture1(i).BackColor = RGB(Int(VScroll1((i * 3)).Value), _
                                Int(VScroll1((i * 3) + 1).Value), _
                                Int(VScroll1((i * 3) + 2).Value))
    oSpectrum(i).color = Picture1(i).BackColor
    Debug.Print oSpectrum(i).spectrumEqualC(oSpectrum(i Xor 1)), i, i Xor 1
End Sub
 
 

P.D.: el codigo lo estare editando y publicando en cSpectrumColor.

Temibles Lunas!¡.

Dejo esta reduccion que no usa clases solo se invoca la funcion  equalSpectrumColor.

 
'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
 
Option Explicit
 
Private Function max(ByVal lVal1 As Long, ByVal lVal2 As Long) As Long
    If (lVal1 > lVal2) Then
        max = lVal1
    Else
        max = lVal2
    End If
End Function
 
Private Function max3(ByVal lVal1 As Long, ByVal lVal2 As Long, ByVal lval3 As Long) As Long
    max3 = max(max(lVal1, lVal2), lval3)
End Function
 
Private Function min(ByVal lVal1 As Long, ByVal lVal2 As Long) As Long
    If (lVal1 < lVal2) Then
        min = lVal1
    Else
        min = lVal2
    End If
End Function
 
Private Function min3(ByVal lVal1 As Long, ByVal lVal2 As Long, ByVal lval3 As Long) As Long
    min3 = min(min(lVal1, lVal2), lval3)
End Function
 
Public Sub longToRGBA(ByVal lRGBA As Long, ByRef bRed As Byte, ByRef bGreen As Byte, ByRef bBlue As Byte, ByRef bAlpha As Byte)
    bRed = (lRGBA And &HFF&)
    bGreen = ((lRGBA And &HFF00&) / &H100&)
    bBlue = ((lRGBA And &HFF0000) / &H10000)
    bAlpha = ((lRGBA And &HFF000000) / &H1000000)
End Sub
 
Public Function RGBAToLong(ByVal bRed As Long, ByVal bGreen As Long, ByVal bBlue As Long, ByVal bAlpha As Long) As Long
    RGBAToLong = (bRed) Or ((bGreen And &HFF&) * &H100&) Or ((bBlue And &HFF&) * &H10000) Or ((bAlpha And &HFF&) * &H1000000)
End Function
 
Public Function scaleSpectrumFactor(ByVal lColor1 As Long, ByVal lColor2 As Long) As Double
Dim bRed                As Byte
Dim bGreen              As Byte
Dim bBlue               As Byte
'Dim bAlpha              As byte
 
    Call longToRGBA(lColor1, bRed, bGreen, bBlue, &H0)
    Select Case max3(bRed, bGreen, bBlue)
        Case bRed: If (bRed) Then scaleSpectrumFactor = (lColor2 And &HFF&) * 100 / bRed
        Case bGreen: If (bGreen) Then scaleSpectrumFactor = ((lColor2 And &HFF00&) \ &H100&) * 100 / bGreen
        Case bBlue: If (bBlue) Then scaleSpectrumFactor = ((lColor2 And &HFF0000) \ &H10000) * 100 / bBlue
    End Select
 
End Function
 
Public Function spectrumColorScale(ByVal lColor As Long, ByVal lScale As Double) As Long
Dim bRed                As Byte
Dim bGreen              As Byte
Dim bBlue               As Byte
'Dim bAlpha              As byte
 
    Call longToRGBA(lColor, bRed, bGreen, bBlue, &H0)
    spectrumColorScale = RGBAToLong(((bRed * (lScale / 100)) + bRed), ((bGreen * (lScale / 100)) + bGreen), ((bBlue * (lScale / 100)) + bBlue), &H0)
End Function
 
Public Sub lSwap(ByRef lVal1 As Long, ByRef lVal2 As Long)
    '   //  Intercambia {lVal1} por {lVal2} y {lVal2} a {lVal1} sin variable temporal
    lVal1 = lVal1 Xor lVal2
    lVal2 = lVal2 Xor lVal1
    lVal1 = lVal1 Xor lVal2
End Sub
 
Public Function equalSpectrumColor(ByVal lColor1 As Long, ByVal lColor2 As Long, Optional ByVal lTolerance As Long = 10) As Boolean
Dim bRed(1)             As Byte
Dim bGreen(1)           As Byte
Dim bBlue(1)            As Byte
'Dim bAlpha(1)              As byte
 
    If (lColor1 > lColor2) Then Call lSwap(lColor1, lColor2)
 
    Call longToRGBA(spectrumColorScale(lColor2, scaleSpectrumFactor(lColor2, lColor1) - 100), bRed(1), bGreen(1), bBlue(1), &H0)
    Call longToRGBA(lColor1, bRed(0), bGreen(0), bBlue(0), &H0)
 
    If (max(bRed(0), bRed(1)) - min(bRed(0), bRed(1)) < lTolerance) Then
        If (max(bGreen(0), bGreen(1)) - min(bGreen(0), bGreen(1)) < lTolerance) Then
            If (max(bBlue(0), bBlue(1)) - min(bBlue(0), bBlue(1)) < lTolerance) Then
                equalSpectrumColor = True
            End If
        End If
    End If
 
End Function
 
 

Temibles Lunas!¡.