Public Sub DetectaColores(Pic As PictureBox, Color As Long, Intensidad As Integer)
Dim BytesPerLine As Long
Dim WinDC As Long
Dim TmpDC As Long
Dim dl As Long
Dim mBmp As Long
Dim AntBmp As Long
Dim Addrs As Long
Dim ContadorX As Long
Dim ContadorY As Long
Dim lpBits() As Byte
Dim mSizeImage As Long
Dim Rojo As Long, Verde As Long, Azul As Long, Gris As Long
Dim M_BitmapInfo As BITMAPINFO24
Dim SA As SAFEARRAY2D
Dim posX, posY, n As Long
Dim postX, postY As String
Dim repeat As Long
Dim repetir As Integer
Dim Matris, Tolerancia
[B][COLOR=blue]Dim colorD As Boolean[/COLOR][/B]
[B][COLOR=blue]colorD = False[/COLOR][/B]
Tolerancia = Form1.HScroll1.Value
'Screen.MousePointer = 11
GetRGB Color, R, G, B
Pic = Pic 'solo para refrescar a la imagen original
Pic.ScaleMode = 3
Pic.AutoRedraw = True
BytesPerLine = ScanAlign(Pic.ScaleWidth * 3)
mSizeImage = BytesPerLine * Pic.ScaleHeight
With M_BitmapInfo.bmiHeader
.biSize = Len(M_BitmapInfo.bmiHeader)
.biWidth = Pic.ScaleWidth
.biHeight = Pic.ScaleHeight
.biPlanes = 1
.biBitCount = 24
.biCompression = BI_RGB
.biSizeImage = mSizeImage
End With
WinDC = GetDC(0)
TmpDC = CreateCompatibleDC(WinDC)
mBmp = CreateDIBSection(WinDC, M_BitmapInfo, DIB_RGB_COLORS, Addrs, 0, 0)
dl = ReleaseDC(0, WinDC)
With SA
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = Pic.ScaleHeight
.Bounds(1).lLbound = 0
.Bounds(1).cElements = BytesPerLine
.pvData = Addrs
End With
CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4
AntBmp = SelectObject(TmpDC, mBmp)
dl = BitBlt(TmpDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hDC, 0, 0, SRCCOPY)
For ContadorY = 0 To Pic.ScaleHeight - 1
For ContadorX = 0 To (Pic.ScaleWidth * 3) - 1 Step 3
Rojo = lpBits(ContadorX + 2, ContadorY)
Verde = lpBits(ContadorX + 1, ContadorY)
Azul = lpBits(ContadorX, ContadorY)
'++++++++++++++++++++++detecta el color rojo+++++++++++++++++++++++++++++++++++
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
If (Rojo - Tolerancia > Azul) And (Rojo - Tolerancia > Verde) Then
n = n + 1
Rojo = 0
Verde = 200
Azul = 0
posX = posX + (ContadorX / 3 - 2) '+ posX
posY = posY + (234 - ContadorY) '+ posY
[B][COLOR=blue]colorD = True[/COLOR][/B]
End If
'Form1.Text4 = Form1.Text4 & "(" & Rojo & "," & Verde & "," & Azul & ")" & " "
'++++++++++++++++mezcla los colores del pixelll++++++++++++++++++++++++++++++++++
lpBits(ContadorX, ContadorY) = Azul '- Rojo / Intensidad + B / Intensidad
lpBits(ContadorX + 1, ContadorY) = Verde ' - Verde / Intensidad + G / Intensidad
lpBits(ContadorX + 2, ContadorY) = Rojo '- Azul / Intensidad + R / Intensidad
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Next ContadorX
Next ContadorY
CopyMemory ByVal VarPtrArray(lpBits), 0&, 4
dl = BitBlt(Pic.hDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, TmpDC, 0, 0, SRCCOPY)
dl = SelectObject(TmpDC, AntBmp)
dl = DeleteObject(mBmp)
dl = DeleteDC(TmpDC)
[B][COLOR=blue]If colorD Then PlaySound App.Path & "\SOUNDS.wav"[/COLOR][/B]
'Form1.Text4.Text = Matris
'Screen.MousePointer = 0
'+++++++++++++++++dibujo el circulo sobre el color rojo derectado y promedio+++++++
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
On Error Resume Next
Form1.Text1.Text = CLng(posX / n)
Form1.Text2.Text = CLng(posY / n)
Form1.Text3.Text = n
With Form1.Picture2
Form1.Picture2.FillStyle = 7
Form1.Picture2.FillColor = RGB(0, 189, 0) 'verde
Form1.Picture2.Circle (posX / n, posY / n), _
30, _
vbRed
End With
Pic.Refresh
End Sub