Tema destacado: Nueva página de elhacker.net en Google+ 
 Autor
|
Tema: [RETO] GetMaskColor (Leído 509 veces)
|
|
LeandroA
|
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 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 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
|
Hola, esta hecho asi nomas, debe tener algun error, pero es la idea no ? Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private vArrColores() As Variant
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
lWidth = lWidth / 15
lHeight = lHeight / 15
Dim i As Integer
Dim vCont As Integer
vCont = 0
ReDim vArrColores(NumIcon * 4)
For i = 0 To NumIcon - 1
'Verifica la esquina Izquiera superior
If i > 0 Then
Debug.Print Picture1.hdc, (lWidth * i) + 1, 0
vArrColores(vCont) = GetPixel(Picture1.hdc, (lWidth * i) + 1, 0)
Else
Debug.Print Picture1.hdc, lWidth * i, 0
vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth * i, 0)
End If
vCont = vCont + 1
'Verifica la esquina Izquiera inferior
If i > 0 Then
Debug.Print Picture1.hdc, (lWidth * i) + 1, lHeight - 1
vArrColores(vCont) = GetPixel(Picture1.hdc, (lWidth * i) + 1, lHeight - 1)
Else
Debug.Print Picture1.hdc, lWidth * i, lHeight - 1
vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth * i, lHeight - 1)
End If
vCont = vCont + 1
'Verifica la esquina Derecha Superior
If i > 0 Then
Debug.Print Picture1.hdc, lWidth * (i + 1) - 1, 0
vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth * (i + 1) - 1, 0)
Else
Debug.Print Picture1.hdc, lWidth - 1, 0
vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth - 1, 0)
End If
vCont = vCont + 1
'Verifica la esquina Derecha Inferior
If i > 0 Then
Debug.Print Picture1.hdc, lWidth * (i + 1) - 1, lHeight - 1
vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth * (i + 1) - 1, lHeight - 1)
Else
Debug.Print Picture1.hdc, lWidth - 1, lHeight - 1
vArrColores(vCont) = GetPixel(Picture1.hdc, lWidth - 1, lHeight - 1)
End If
vCont = vCont + 1
Debug.Print ""
Next
Call Ordenar_Matriz(vArrColores, LBound(vArrColores), UBound(vArrColores) - 1)
Debug.Print "------------RESULTADO COLORES------------"
Dim q As Integer
Dim vColorTemp As Long
Dim vContTemp As Long
Do Until q = UBound(vArrColores) - 1
vColorTemp = vArrColores(q)
vContTemp = 0
Do Until vColorTemp <> vArrColores(q)
vContTemp = vContTemp + 1
If q <> UBound(vArrColores) - 1 Then q = q + 1
Loop
Debug.Print "COLOR " & vColorTemp & " REPETIDO: " & vContTemp & " VECES"
Loop
End Sub
Private Sub Ordenar_Matriz(El_Vector() As Variant, Limite_Inferior As Long, Limite_Superior As Long)
Dim i As Long, j As Long, x As Variant, y As Variant
i = Limite_Inferior
j = Limite_Superior
x = El_Vector((Limite_Inferior + Limite_Superior) / 2)
While i <= j
While (El_Vector(i) < x) And (i < Limite_Superior)
i = i + 1
Wend
While (x < El_Vector(j)) And (j > Limite_Inferior)
j = j - 1
Wend
If i <= j Then
y = El_Vector(i)
El_Vector(i) = El_Vector(j)
El_Vector(j) = y
i = i + 1
j = j - 1
End If
Wend
If Limite_Inferior < j Then Ordenar_Matriz El_Vector(), Limite_Inferior, j
If i < Limite_Superior Then Ordenar_Matriz El_Vector(), i, Limite_Superior
End Sub
saludos.
|
|
|
|
|
En línea
|
Mucha gente, especialmente la ignorante desea castigarte por decir la verdad, por ser correcto, por ser tú. Nunca te disculpes por ser correcto, o por estar años delante de tu tiempo.
Si estas en lo cierto, y lo sabes, que hable tu razón. Incluso si eres una minoria de uno solo, la verdad sigue siendo la verdad. M. Gandhi
|
|
|
|
LeandroA
|
Aca esta mi función Option Explicit
Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
Private Type BuferColor
Color As Long
Count As Long
End Type
Private Sub Form_Load()
Picture1.AutoRedraw = True
Me.BackColor = GetMaskColor(Picture1)
End Sub
Private Function GetMaskColor(oPic As PictureBox) As Long
Dim i As Long, j As Long, x As Long
Dim lWidth As Long, lHeight As Long
Dim NumIcon As Long
Dim aColors() As Long
Dim BC() As BuferColor
Dim bFind As Boolean
Dim lMax As Long, ArrSize As Long
lWidth = (oPic.ScaleWidth \ oPic.ScaleHeight)
If lWidth = 0 Then lWidth = 1
lWidth = oPic.ScaleWidth \ lWidth
lHeight = oPic.ScaleHeight
NumIcon = oPic.ScaleWidth \ lWidth
ArrSize = (NumIcon * 4) - 1
ReDim aColors(ArrSize)
For i = 0 To NumIcon - 1
aColors(j) = GetPixel(oPic.hdc, x, 0)
aColors(j + 1) = GetPixel(oPic.hdc, x + lWidth - 1, 0)
aColors(j + 2) = GetPixel(oPic.hdc, x, lHeight - 1)
aColors(j + 3) = GetPixel(oPic.hdc, x + lWidth - 1, lHeight - 1)
j = j + 4
x = x + lWidth
Next
ReDim BC(ArrSize)
x = 0
For i = 0 To ArrSize
bFind = False
For j = 0 To x
If BC(j).Color = aColors(i) Then
BC(j).Count = BC(j).Count + 1
bFind = True
Exit For
End If
Next
If Not bFind Then BC(x).Color = aColors(i): x = x + 1
Next
For i = 0 To x - 1
If BC(i).Count > lMax Then
lMax = BC(i).Count
GetMaskColor = BC(i).Color
End If
Next
End Function
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
|
|
|
|
|
 |
