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

 

 


Tema destacado: Curso de javascript por TickTack


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [RETO] GetMaskColor 		0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [RETO] GetMaskColor  (Leído 2,543 veces)
LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
[RETO] GetMaskColor
« en: 25 Marzo 2011, 17:48 pm »
Hola esta es una función que debo realizar así que la pongo como un reto para quienes estén aburridos, les cuento de que se trata, la idea es obtener el color de mascara de una imagen, como pueden ver en la siguiente

a simple vista reconocemos que es un color Magenta, lo que intentaremos es obtenerlo mediante código, para no complicar las cosas usaremos un PictureBox sin bordes (BordeStyle = none), AutoSize = True  y ScaleMode = vbPixels
para obtener el color utilizaremos el api GetPixel
Código:
Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

entonces en el picture pondremos una de las imagenes que se encuentran abajo de todo.
la imagen es una tira de iconos, nosotros debemos verificar en cada esquina de ese icono cual es el color, el color que se repita mas veces sera el color de mascara
como muestro en esta imagen
con puntos azules y rojos son los puntos donde debemos comprobar el color almacenarlo en algún array o lo que sea y luego ir sumando para al final ver cual es el que se repitio mas veces.












como son todos iconos cuadrados una ayuda para obtener el tamaño de cada icono y la cantidad de iconos
Código:
Private Sub Form_Load()
    Dim lWidth As Long
    Dim lHeight As Long
    Dim NumIcon As Long

    lWidth = (Picture1.ScaleWidth \ Picture1.ScaleHeight)
    If lWidth = 0 Then lWidth = 1
    lWidth = Picture1.ScaleWidth \ lWidth
    lHeight = Picture1.ScaleHeight
    
    NumIcon = Picture1.ScaleWidth \ lWidth
    
    Debug.Print lWidth, lHeight, NumIcon
End Sub
En línea
seba123neo
Moderador
***
Desconectado Desconectado

Mensajes: 3.621



Ver Perfil WWW
Re: [RETO] GetMaskColor
« Respuesta #1 en: 25 Marzo 2011, 22:29 pm »
Hola, esta hecho asi nomas, debe tener algun error, pero es la idea no ?

Código
  1. Option Explicit
  2.  
  3. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  4.  
  5. Private vArrColores() As Variant
  6.  
  7. Private Sub Form_Load()
  8.     Dim lWidth As Long
  9.     Dim lHeight As Long
  10.     Dim NumIcon As Long
  11.  
  12.     lWidth = (Picture1.ScaleWidth \ Picture1.ScaleHeight)
  13.     If lWidth = 0 Then lWidth = 1
  14.     lWidth = Picture1.ScaleWidth \ lWidth
  15.     lHeight = Picture1.ScaleHeight
  16.  
  17.     NumIcon = Picture1.ScaleWidth \ lWidth
  18.  
  19.     lWidth = lWidth / 15
  20.     lHeight = lHeight / 15
  21.  
  22.     Dim i As Integer
  23.     Dim vCont As Integer
  24.  
  25.     vCont = 0
  26.  
  27.     ReDim vArrColores(NumIcon * 4)
  28.  
  29.     For i = 0 To NumIcon - 1
  30.  
  31.         'Verifica la esquina Izquiera superior
  32.         If i > 0 Then
  33.             Debug.Print Picture1.hdc, (lWidth * i) + 1, 0
  34.             vArrColores(vCont) = GetPixel(Picture1.hdc, (lWidth * i) + 1, 0)
  35.         Else
  36.             Debug.Print Picture1.hdc, lWidth * i, 0
  37.             vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth * i, 0)
  38.         End If
  39.  
  40.         vCont = vCont + 1
  41.  
  42.         'Verifica la esquina Izquiera inferior
  43.         If i > 0 Then
  44.             Debug.Print Picture1.hdc, (lWidth * i) + 1, lHeight - 1
  45.             vArrColores(vCont) = GetPixel(Picture1.hdc, (lWidth * i) + 1, lHeight - 1)
  46.         Else
  47.             Debug.Print Picture1.hdc, lWidth * i, lHeight - 1
  48.             vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth * i, lHeight - 1)
  49.         End If
  50.  
  51.         vCont = vCont + 1
  52.  
  53.         'Verifica la esquina Derecha Superior
  54.         If i > 0 Then
  55.             Debug.Print Picture1.hdc, lWidth * (i + 1) - 1, 0
  56.             vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth * (i + 1) - 1, 0)
  57.         Else
  58.             Debug.Print Picture1.hdc, lWidth - 1, 0
  59.             vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth - 1, 0)
  60.         End If
  61.  
  62.         vCont = vCont + 1
  63.  
  64.         'Verifica la esquina Derecha Inferior
  65.         If i > 0 Then
  66.             Debug.Print Picture1.hdc, lWidth * (i + 1) - 1, lHeight - 1
  67.             vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth * (i + 1) - 1, lHeight - 1)
  68.         Else
  69.             Debug.Print Picture1.hdc, lWidth - 1, lHeight - 1
  70.             vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth - 1, lHeight - 1)
  71.         End If
  72.  
  73.         vCont = vCont + 1
  74.  
  75.         Debug.Print ""
  76.     Next
  77.  
  78.     Call Ordenar_Matriz(vArrColores, LBound(vArrColores), UBound(vArrColores) - 1)
  79.  
  80.     Debug.Print "------------RESULTADO COLORES------------"
  81.  
  82.     Dim q As Integer
  83.     Dim vColorTemp As Long
  84.     Dim vContTemp As Long
  85.  
  86.     Do Until q = UBound(vArrColores) - 1
  87.  
  88.         vColorTemp = vArrColores(q)
  89.         vContTemp = 0
  90.  
  91.         Do Until vColorTemp <> vArrColores(q)
  92.             vContTemp = vContTemp + 1
  93.             If q <> UBound(vArrColores) - 1 Then q = q + 1
  94.         Loop
  95.  
  96.         Debug.Print "COLOR " & vColorTemp & " REPETIDO: " & vContTemp & " VECES"
  97.     Loop
  98. End Sub
  99.  
  100. Private Sub Ordenar_Matriz(El_Vector() As Variant, Limite_Inferior As Long, Limite_Superior As Long)
  101.  
  102.     Dim i As Long, j As Long, x As Variant, y As Variant
  103.  
  104.     i = Limite_Inferior
  105.     j = Limite_Superior
  106.  
  107.     x = El_Vector((Limite_Inferior + Limite_Superior) / 2)
  108.  
  109.     While i <= j
  110.  
  111.         While (El_Vector(i) < x) And (i < Limite_Superior)
  112.             i = i + 1
  113.         Wend
  114.  
  115.         While (x < El_Vector(j)) And (j > Limite_Inferior)
  116.             j = j - 1
  117.         Wend
  118.  
  119.         If i <= j Then
  120.             y = El_Vector(i)
  121.             El_Vector(i) = El_Vector(j)
  122.             El_Vector(j) = y
  123.             i = i + 1
  124.             j = j - 1
  125.         End If
  126.  
  127.     Wend
  128.  
  129.     If Limite_Inferior < j Then Ordenar_Matriz El_Vector(), Limite_Inferior, j
  130.     If i < Limite_Superior Then Ordenar_Matriz El_Vector(), i, Limite_Superior
  131. End Sub
  132.  

saludos.
En línea
LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: [RETO] GetMaskColor
« Respuesta #2 en: 26 Marzo 2011, 00:19 am »
Aca esta mi función

Código
  1. Option Explicit
  2. Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
  3.  
  4. Private Type BuferColor
  5.     Color As Long
  6.     Count As Long
  7. End Type
  8.  
  9. Private Sub Form_Load()
  10.     Picture1.AutoRedraw = True
  11.     Me.BackColor = GetMaskColor(Picture1)
  12. End Sub
  13.  
  14. Private Function GetMaskColor(oPic As PictureBox) As Long
  15.     Dim i As Long, j As Long, x As Long
  16.     Dim lWidth As Long, lHeight As Long
  17.     Dim NumIcon As Long
  18.     Dim aColors() As Long
  19.     Dim BC() As BuferColor
  20.     Dim bFind As Boolean
  21.     Dim lMax As Long, ArrSize As Long
  22.  
  23.     lWidth = (oPic.ScaleWidth \ oPic.ScaleHeight)
  24.     If lWidth = 0 Then lWidth = 1
  25.     lWidth = oPic.ScaleWidth \ lWidth
  26.     lHeight = oPic.ScaleHeight
  27.  
  28.     NumIcon = oPic.ScaleWidth \ lWidth
  29.  
  30.     ArrSize = (NumIcon * 4) - 1
  31.  
  32.     ReDim aColors(ArrSize)
  33.  
  34.  
  35.     For i = 0 To NumIcon - 1
  36.         aColors(j) = GetPixel(oPic.hdc, x, 0)
  37.         aColors(j + 1) = GetPixel(oPic.hdc, x + lWidth - 1, 0)
  38.         aColors(j + 2) = GetPixel(oPic.hdc, x, lHeight - 1)
  39.         aColors(j + 3) = GetPixel(oPic.hdc, x + lWidth - 1, lHeight - 1)
  40.         j = j + 4
  41.         x = x + lWidth
  42.     Next
  43.  
  44.     ReDim BC(ArrSize)
  45.     x = 0
  46.  
  47.     For i = 0 To ArrSize
  48.        bFind = False
  49.        For j = 0 To x
  50.             If BC(j).Color = aColors(i) Then
  51.                 BC(j).Count = BC(j).Count + 1
  52.                 bFind = True
  53.                 Exit For
  54.             End If
  55.        Next
  56.        If Not bFind Then BC(x).Color = aColors(i): x = x + 1
  57.     Next
  58.  
  59.     For i = 0 To x - 1
  60.         If BC(i).Count > lMax Then
  61.             lMax = BC(i).Count
  62.             GetMaskColor = BC(i).Color
  63.         End If
  64.     Next
  65.  
  66. End Function
  67.  

Seba la idea es obtener un color final, puede que alla un empate en la cantidad de colores  pero almenos es una aproximación

Saludos.
En línea
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Reto ;)
Ingeniería Inversa 		NeoKiller 3 3,201 Último mensaje 15 Agosto 2004, 23:12 pm
por NeoKiller
Reto!!
Ingeniería Inversa 		HaCkZaTaN 2 3,214 Último mensaje 10 Septiembre 2004, 09:30 am
por Ðevastador
Reto vB
Ingeniería Inversa 		nhouse 2 3,708 Último mensaje 16 Marzo 2005, 09:41 am
por 4rS3NI(
reto en VB6
Ingeniería Inversa 		ellolo 1 2,823 Último mensaje 15 Abril 2005, 10:03 am
por UnpaCker!
Un reto !!! « 1 2 3 »
Programación Visual Basic 		VirucKingX 24 9,250 Último mensaje 8 Mayo 2006, 23:36 pm
por Kizar
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines