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
Código
' ' ///////////////////////////////////////////////////////////// ' // // ' // 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:
Código
' // 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!¡.