elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Únete al Grupo Steam elhacker.NET


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Source] SpectrumColor ( Reconocimiento de tonos de colores ).
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Source] SpectrumColor ( Reconocimiento de tonos de colores ).  (Leído 1,127 veces)
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
[Source] SpectrumColor ( Reconocimiento de tonos de colores ).
« en: 8 Octubre 2011, 21:55 pm »

.
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
  1.  
  2. '
  3. '   /////////////////////////////////////////////////////////////
  4. '   //                                                         //
  5. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  6. '   //                                                         //
  7. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  8. '   //                                                         //
  9. '   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
  10. '   // no se eliminen los creditos originales de este codigo   //
  11. '   // No importando que sea modificado/editado o engrandesido //
  12. '   // o achicado, si es en base a este codigo                 //
  13. '   /////////////////////////////////////////////////////////////
  14. '  // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=35:cspectrumcolor&catid=15:catmoduloscls&Itemid=24
  15. '   /////////////////////////////////////////////////////////////
  16.  
  17. Option Explicit
  18.  
  19. Private lRGBA       As Long
  20.  
  21. Public Property Get color() As Long
  22.    color = lRGBA
  23. End Property
  24.  
  25. Public Property Let color(ByVal lColor As Long)
  26.    lRGBA = lColor
  27. End Property
  28.  
  29. Public Function spectrumEqualL(ByVal lColorRGBA As Long, Optional ByVal lTolerance As Long = 10) As Boolean
  30. Dim oSpectrum       As cSpectrumColor
  31.    Set oSpectrum = New cSpectrumColor
  32.    oSpectrum.color = lColorRGBA
  33.    spectrumEqualL = spectrumEqualC(oSpectrum)
  34.    Set oSpectrum = Nothing
  35. End Function
  36.  
  37. Public Function spectrumEqualC(ByVal oSpectrum As cSpectrumColor, Optional ByVal lTolerance As Long = 10) As Boolean
  38. Dim lRed(1)             As Long
  39. Dim lGreen(1)           As Long
  40. Dim lBlue(1)            As Long
  41. Dim lBackColor          As Long
  42.  
  43.    lBackColor = oSpectrum.spectrumScale(oSpectrum.scaleFactorL(lRGBA) - 100)
  44.    Call oSpectrum.componentsRGBA(lRed(1), lGreen(1), lBlue(1), &H0)
  45.    oSpectrum.color = lBackColor
  46.  
  47.    Call componentsRGBA(lRed(0), lGreen(0), lBlue(0), &H0)
  48.  
  49.    If (max(lRed(0), lRed(1)) - min(lRed(0), lRed(1)) < lTolerance) Then
  50.        If (max(lGreen(0), lGreen(1)) - min(lGreen(0), lGreen(1)) < lTolerance) Then
  51.            If (max(lBlue(0), lBlue(1)) - min(lBlue(0), lBlue(1)) < lTolerance) Then
  52.                spectrumEqualC = True
  53.            End If
  54.        End If
  55.    End If
  56. End Function
  57.  
  58. Public Function spectrumScale(ByVal lScale As Double) As Long
  59. Dim lRed                As Long
  60. Dim lGreen              As Long
  61. Dim lBlue               As Long
  62. 'Dim lAlpha              As Long
  63.  
  64.    spectrumScale = lRGBA
  65.    Call componentsRGBA(lRed, lGreen, lBlue, &H0)
  66.    Call Me.colorFromRGBA(((lRed * (lScale / 100)) + lRed), ((lGreen * (lScale / 100)) + lGreen), ((lBlue * (lScale / 100)) + lBlue), &H0)
  67. End Function
  68.  
  69. Public Function scaleFactorL(ByVal lColorRGBA As Long) As Double
  70. Dim lRed                As Long
  71. Dim lGreen              As Long
  72. Dim lBlue               As Long
  73. 'Dim lAlpha              As Long
  74.  
  75.    Call componentsRGBA(lRed, lGreen, lBlue, &H0)
  76.  
  77.    Select Case max3(lRed, lGreen, lBlue)
  78.        Case lRed: If (lRed) Then scaleFactorL = (lColorRGBA And &HFF&) * 100 / lRed
  79.        Case lGreen: If (lGreen) Then scaleFactorL = ((lColorRGBA And &HFF00&) \ &H100&) * 100 / lGreen
  80.        Case lBlue: If (lBlue) Then scaleFactorL = ((lColorRGBA And &HFF0000) \ &H10000) * 100 / lBlue
  81.    End Select
  82.  
  83. End Function
  84.  
  85. Public Function scaleFactorC(ByVal oSpectrum As cSpectrumColor) As Double
  86.    scaleFactorC = scaleFactorL(oSpectrum.color())
  87. End Function
  88.  
  89. Private Function max(ByVal lVal1 As Long, ByVal lval2 As Long) As Long
  90.    If (lVal1 > lval2) Then
  91.        max = lVal1
  92.    Else
  93.        max = lval2
  94.    End If
  95. End Function
  96.  
  97. Private Function min(ByVal lVal1 As Long, ByVal lval2 As Long) As Long
  98.    If (lVal1 < lval2) Then
  99.        min = lVal1
  100.    Else
  101.        min = lval2
  102.    End If
  103. End Function
  104.  
  105. Private Function max3(ByVal lVal1 As Long, ByVal lval2 As Long, ByVal lval3 As Long) As Long
  106.    max3 = max(max(lVal1, lval2), lval3)
  107. End Function
  108.  
  109. Public Sub componentsRGBA(ByRef lRed As Long, ByRef lGreen As Long, ByRef lBlue As Long, ByRef lAlpha As Long)
  110.    lRed = (lRGBA And &HFF&)
  111.    lGreen = ((lRGBA And &HFF00&) / &H100&)
  112.    lBlue = ((lRGBA And &HFF0000) / &H10000)
  113.    lAlpha = ((lRGBA And &HFF000000) / &H1000000)
  114. End Sub
  115.  
  116. Public Sub colorFromRGBA(ByVal lRed As Long, ByVal lGreen As Long, ByVal lBlue As Long, ByVal lAlpha As Long)
  117.    lRGBA = (lRed)
  118.    lRGBA = (lRGBA Or ((lGreen And &HFF&) * &H100&))
  119.    lRGBA = (lRGBA Or ((lBlue And &HFF&) * &H10000))
  120.    lRGBA = (lRGBA Or ((lAlpha And &HFF&) * &H1000000))
  121. End Sub
  122.  
  123.  

Prueba/Test:

Código
  1.  
  2.  
  3. '   //  En un form...
  4. '   //  Se requieren 6 VScroll (con propiedad Index).
  5. '   //  Se requieren 2 PictureBox (con propiedad Index)
  6.  
  7. Option Explicit
  8.  
  9. Dim oSpectrum(1)    As cSpectrumColor
  10.  
  11. Private Sub Form_Load()
  12. Dim i           As Long
  13.    Set oSpectrum(0) = New cSpectrumColor
  14.    Set oSpectrum(1) = New cSpectrumColor
  15.  
  16.    For i = VScroll1.LBound To VScroll1.UBound
  17.        VScroll1(i).min = 0
  18.        VScroll1(i).max = 255
  19.    Next
  20. End Sub
  21.  
  22. Private Sub Form_Terminate()
  23.    Set oSpectrum(0) = Nothing
  24.    Set oSpectrum(1) = Nothing
  25. End Sub
  26.  
  27. Private Sub VScroll1_Change(Index As Integer)
  28.    Call VScroll1_Scroll(Index)
  29. End Sub
  30.  
  31. Private Sub VScroll1_Scroll(Index As Integer)
  32. Dim i           As Long
  33.    If (Index > &H2) Then i = 1
  34.    Picture1(i).BackColor = RGB(Int(VScroll1((i * 3)).Value), _
  35.                                Int(VScroll1((i * 3) + 1).Value), _
  36.                                Int(VScroll1((i * 3) + 2).Value))
  37.    oSpectrum(i).color = Picture1(i).BackColor
  38.    Debug.Print oSpectrum(i).spectrumEqualC(oSpectrum(i Xor 1)), i, i Xor 1
  39. End Sub
  40.  
  41.  

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

Temibles Lunas!¡.


« Última modificación: 8 Octubre 2011, 22:50 pm por BlackZeroX▓▓▒▒░░ » En línea

The Dark Shadow is my passion.
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [Source] cSpectrumColor
« Respuesta #1 en: 8 Octubre 2011, 22:12 pm »

.
* Nota se que puedo ocupar en lugar de long el tipo byte en los componentes RGBA pero lo he dejado en long por cuestiones personales...

Dulces Lunas!¡.


En línea

The Dark Shadow is my passion.
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [Source] cSpectrumColor
« Respuesta #2 en: 8 Octubre 2011, 22:46 pm »

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

Código
  1.  
  2. '
  3. '   /////////////////////////////////////////////////////////////
  4. '   //                                                         //
  5. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  6. '   //                                                         //
  7. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  8. '   //                                                         //
  9. '   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
  10. '   // no se eliminen los creditos originales de este codigo   //
  11. '   // No importando que sea modificado/editado o engrandesido //
  12. '   // o achicado, si es en base a este codigo                 //
  13. '   /////////////////////////////////////////////////////////////
  14.  
  15. Option Explicit
  16.  
  17. Private Function max(ByVal lVal1 As Long, ByVal lVal2 As Long) As Long
  18.    If (lVal1 > lVal2) Then
  19.        max = lVal1
  20.    Else
  21.        max = lVal2
  22.    End If
  23. End Function
  24.  
  25. Private Function max3(ByVal lVal1 As Long, ByVal lVal2 As Long, ByVal lval3 As Long) As Long
  26.    max3 = max(max(lVal1, lVal2), lval3)
  27. End Function
  28.  
  29. Private Function min(ByVal lVal1 As Long, ByVal lVal2 As Long) As Long
  30.    If (lVal1 < lVal2) Then
  31.        min = lVal1
  32.    Else
  33.        min = lVal2
  34.    End If
  35. End Function
  36.  
  37. Private Function min3(ByVal lVal1 As Long, ByVal lVal2 As Long, ByVal lval3 As Long) As Long
  38.    min3 = min(min(lVal1, lVal2), lval3)
  39. End Function
  40.  
  41. Public Sub longToRGBA(ByVal lRGBA As Long, ByRef bRed As Byte, ByRef bGreen As Byte, ByRef bBlue As Byte, ByRef bAlpha As Byte)
  42.    bRed = (lRGBA And &HFF&)
  43.    bGreen = ((lRGBA And &HFF00&) / &H100&)
  44.    bBlue = ((lRGBA And &HFF0000) / &H10000)
  45.    bAlpha = ((lRGBA And &HFF000000) / &H1000000)
  46. End Sub
  47.  
  48. Public Function RGBAToLong(ByVal bRed As Long, ByVal bGreen As Long, ByVal bBlue As Long, ByVal bAlpha As Long) As Long
  49.    RGBAToLong = (bRed) Or ((bGreen And &HFF&) * &H100&) Or ((bBlue And &HFF&) * &H10000) Or ((bAlpha And &HFF&) * &H1000000)
  50. End Function
  51.  
  52. Public Function scaleSpectrumFactor(ByVal lColor1 As Long, ByVal lColor2 As Long) As Double
  53. Dim bRed                As Byte
  54. Dim bGreen              As Byte
  55. Dim bBlue               As Byte
  56. 'Dim bAlpha              As byte
  57.  
  58.    Call longToRGBA(lColor1, bRed, bGreen, bBlue, &H0)
  59.    Select Case max3(bRed, bGreen, bBlue)
  60.        Case bRed: If (bRed) Then scaleSpectrumFactor = (lColor2 And &HFF&) * 100 / bRed
  61.        Case bGreen: If (bGreen) Then scaleSpectrumFactor = ((lColor2 And &HFF00&) \ &H100&) * 100 / bGreen
  62.        Case bBlue: If (bBlue) Then scaleSpectrumFactor = ((lColor2 And &HFF0000) \ &H10000) * 100 / bBlue
  63.    End Select
  64.  
  65. End Function
  66.  
  67. Public Function spectrumColorScale(ByVal lColor As Long, ByVal lScale As Double) As Long
  68. Dim bRed                As Byte
  69. Dim bGreen              As Byte
  70. Dim bBlue               As Byte
  71. 'Dim bAlpha              As byte
  72.  
  73.    Call longToRGBA(lColor, bRed, bGreen, bBlue, &H0)
  74.    spectrumColorScale = RGBAToLong(((bRed * (lScale / 100)) + bRed), ((bGreen * (lScale / 100)) + bGreen), ((bBlue * (lScale / 100)) + bBlue), &H0)
  75. End Function
  76.  
  77. Public Sub lSwap(ByRef lVal1 As Long, ByRef lVal2 As Long)
  78.    '   //  Intercambia {lVal1} por {lVal2} y {lVal2} a {lVal1} sin variable temporal
  79.    lVal1 = lVal1 Xor lVal2
  80.    lVal2 = lVal2 Xor lVal1
  81.    lVal1 = lVal1 Xor lVal2
  82. End Sub
  83.  
  84. Public Function equalSpectrumColor(ByVal lColor1 As Long, ByVal lColor2 As Long, Optional ByVal lTolerance As Long = 10) As Boolean
  85. Dim bRed(1)             As Byte
  86. Dim bGreen(1)           As Byte
  87. Dim bBlue(1)            As Byte
  88. 'Dim bAlpha(1)              As byte
  89.  
  90.    If (lColor1 > lColor2) Then Call lSwap(lColor1, lColor2)
  91.  
  92.    Call longToRGBA(spectrumColorScale(lColor2, scaleSpectrumFactor(lColor2, lColor1) - 100), bRed(1), bGreen(1), bBlue(1), &H0)
  93.    Call longToRGBA(lColor1, bRed(0), bGreen(0), bBlue(0), &H0)
  94.  
  95.    If (max(bRed(0), bRed(1)) - min(bRed(0), bRed(1)) < lTolerance) Then
  96.        If (max(bGreen(0), bGreen(1)) - min(bGreen(0), bGreen(1)) < lTolerance) Then
  97.            If (max(bBlue(0), bBlue(1)) - min(bBlue(0), bBlue(1)) < lTolerance) Then
  98.                equalSpectrumColor = True
  99.            End If
  100.        End If
  101.    End If
  102.  
  103. End Function
  104.  
  105.  

Temibles Lunas!¡.
En línea

The Dark Shadow is my passion.
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
calificar la voz en base a tonos MP3 + CDG
Multimedia
jf_plata 0 993 Último mensaje 23 Junio 2006, 21:30 pm
por jf_plata
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines