Imports System.Drawing.Drawing2D
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Drawing.Imaging
Public Class ImmagineInfo
Enum Funzioni
TrovaOggettiEscludendoSfondo = 1
TrovaOggettiDiUnColore = 2
End Enum
#Region "Variabili E Proprieta Globali"
Private _coloreSfondo As Color
Private _coloreOggetto As Color
Private Oggetto As OggettiImmagine
Private _Oggetti As New List(Of OggettiImmagine)
Public _immagine As Bitmap
Private _controllo As Object
Private _CoefficenteSfondo As Integer = 30
Private _CoefficenteOggetto As Integer = 30
Private PuntiInseriti As New List(Of Integer)
Private immagineRed As Bitmap
Private Funz As Funzioni = Funzioni.TrovaOggettiDiUnColore
Private _PuntiPerPallino As Integer
Public Shared value As Integer
Public Shared valueMax As Integer
Public Property PuntiPerPallino() As Integer
Get
Return _PuntiPerPallino
End Get
Set(ByVal value As Integer)
_PuntiPerPallino = value
End Set
End Property
Public Property CoefficenteSfondo() As Integer
Get
Return _CoefficenteSfondo
End Get
Set(ByVal value As Integer)
_CoefficenteSfondo = value
End Set
End Property
Public Property Funzione() As Funzioni
Get
Return Funz
End Get
Set(ByVal value As Funzioni)
Funz = value
End Set
End Property
Public Property Red_Imagine() As Bitmap
Get
Return immagineRed
End Get
Set(ByVal value As Bitmap)
immagineRed = value
End Set
End Property
Public Property ColoreSfondo() As Color
Get
Return _coloreSfondo
End Get
Set(ByVal value As Color)
_coloreSfondo = value
End Set
End Property
Public Property ColoreOggetto() As Color
Get
Return _coloreOggetto
End Get
Set(ByVal value As Color)
_coloreOggetto = value
End Set
End Property
Public ReadOnly Property Oggetti() As List(Of OggettiImmagine)
Get
Return _Oggetti
End Get
End Property
Public Property Immagine() As Bitmap
Get
Return _immagine
End Get
Set(ByVal value As Bitmap)
_immagine = value
End Set
End Property
Public Property Control() As Object
Get
Return _controllo
End Get
Set(ByVal value As Object)
_controllo = value
End Set
End Property
Public Property CoefficenteOggetto() As Integer
Get
Return _CoefficenteOggetto
End Get
Set(ByVal value As Integer)
_CoefficenteOggetto = value
End Set
End Property
#End Region
Private Delegate Sub SetImageDelegate(ByVal imm As Bitmap, ByVal controllo As Object)
Private Sub SetImage(ByVal imm As Bitmap, ByVal controllo As Object)
If controllo.InvokeRequired Then
controllo.BeginInvoke(New SetImageDelegate(AddressOf SetImage), New Object() {imm, controllo})
Exit Sub
End If
'controllo.Invalidate()
controllo.image = imm
End Sub
''' <summary>
''' La Classe permette di contere le vare aree in un immagine
''' </summary>
''' <param name="imm">Immagine da Parsare.</param>
''' <param name="coefficenteOgg">Coefficente Degli oggetti Per il Confronto con immagini Sfocate.</param>
''' <param name="CoefficenteSfondo">Coefficente Dello sfondo Per il Confronto con immagini Sfocate.</param>
''' <remarks></remarks>
Sub New(ByVal imm As Bitmap, ByVal coefficenteOgg As Integer, ByVal CoefficenteSfondo As Integer, Optional ByVal Controllo As Object = Nothing)
immagine = imm
CoefficenteSfondo = CoefficenteSfondo
CoefficenteOggetto = coefficenteOgg
Control = Controllo
Parser()
End Sub
Sub New()
End Sub
Sub Parser()
If immagine Is Nothing Then 'immagine originale da non toccare
Exit Sub
End If
Dim Larghezza As Integer = immagine.Width - 1 'Larghezza
Dim Altezza As Integer = immagine.Height - 1 'Altezza
Dim x As Integer
Dim y As Integer
Dim ColoreAttuale As Color
' GDI+ still lies to us - the return format is BGR, NOT RGB.
Dim bmData As BitmapData = Immagine.LockBits(New Rectangle(0, 0, Immagine.Width, Immagine.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
Dim stride As Integer = bmData.Stride
Dim Scan0 As System.IntPtr = bmData.Scan0
Dim bytes As Integer = Immagine.Width * Immagine.Height * 3
Dim p(bytes - 1) As Byte
' Copy the RGB values into the array.
System.Runtime.InteropServices.Marshal.Copy(Scan0, p, 0, bytes)
'finire da qui e lavorare su p variabile puntatore di area di memoria
If Funzione = Funzioni.TrovaOggettiDiUnColore Then
If _coloreSfondo = Nothing Then
MsgBox("Per La funzione di ricerca degli oggetti Di un Colore bisogna selezionare pripa il colore da catturare")
Exit Sub
End If
Else 'Se Gli oggetti sono di piu colori iposto il colore di sfondo
' e inposto la variabile boleana a false cosi che ogni colore diverso lo considera un oggettto
'Trova_Escludi = False
If _coloreSfondo = Nothing Then
_coloreSfondo = Color.FromArgb(p(0), p(1), p(2)) '
End If
End If
immagineRed = DirectCast(Immagine.Clone, Bitmap)immagine che modifico e assegno 'al controllo tramite delegato
Dim c As Integer = 0
Dim nOffset As Integer = stride - bmData.Width * 3
valueMax = Altezza
For y = 0 To Altezza
value = y
For x = 0 To Larghezza
'Debug.Assert(Control.InvokeRequired = False)
If y = 42 Then
Threading.Thread.Sleep(10)
End If
'ColoreAttuale = Immagine.GetPixel(x, y)
ColoreAttuale = Color.FromArgb(p(c + 2), p(c + 1), p(c))
'Application.DoEvents()
If PuntiInseriti.IndexOf(c) = -1 Then
If IsNearestColor(_coloreSfondo, ColoreAttuale, CoefficenteSfondo) = False Then 'Funzione Di Confronto Colore con coefficente
Application.DoEvents()
Oggetto = New OggettiImmagine
Oggetto.coefficente = CoefficenteOggetto
Oggetto.colore = ColoreAttuale
Oggetto.point = Area(c, CoefficenteOggetto)
If Oggetto.point.Count > PuntiPerPallino Then
_Oggetti.Add(Oggetto)
End If
End If
End If
c += 3
Next
c += nOffset
Next
If Control IsNot Nothing Then
SetImage(immagineRed, Control)
End If
Immagine.UnlockBits(bmData)
MsgBox("Ho Trovato N° Oggetti " & Oggetti.Count & " di Colore ")
End Sub
Private Shared Function CercaUnPunto(ByVal p As Point, ByVal list As List(Of Point))
For Each punto As Point In list
If punto = p Then
Return True
End If
Next
Return False
End Function
'Strumento secchiello
Public Function Area(ByVal c As Integer, ByVal Coefficente As Integer) As List(Of Integer)
Dim Points As New List(Of Integer)
Dim NewPoints As New List(Of Integer)
Dim ColoreAttuale As Color = Nothing
Dim Col_Oggetto As Color
Dim ArrayPoint As New List(Of Integer)
'
Points.Add(c)
Dim bSrc As Bitmap = DirectCast(immagineRed.Clone(), Bitmap)
' GDI+ still lies to us - the return format is BGR, NOT RGB.
Dim bmData As BitmapData = immagineRed.LockBits(New Rectangle(0, 0, immagineRed.Width, immagineRed.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
Dim bmSrc As BitmapData = bSrc.LockBits(New Rectangle(0, 0, bSrc.Width, bSrc.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
Dim SrcScan0 As System.IntPtr = bmSrc.Scan0
Dim stride As Integer = bmData.Stride
Dim Scan0 As System.IntPtr = bmData.Scan0
Dim bytes As Integer = immagineRed.Width * immagineRed.Height * 3
Dim p2(bytes - 1) As Byte
Dim bytes1 As Integer = immagineRed.Width * immagineRed.Height * 3
Dim pSrc(bytes1 - 1) As Byte
' Copy the RGB values into the array.
System.Runtime.InteropServices.Marshal.Copy(Scan0, p2, 0, bytes)
System.Runtime.InteropServices.Marshal.Copy(SrcScan0, pSrc, 0, bytes1)
Dim nOffset As Integer = stride - bmData.Width * 3
' sicurezza che la variabile "Col_Oggetto" venga inpostata manualmente su un colore di
'un oggetto per evitare la ripetizione della ricerca dei punti inseriti
If Funzione = Funzioni.TrovaOggettiDiUnColore Then
If ColoreOggetto = Nothing Then
Col_Oggetto = Color.FromArgb(pSrc(c + 2), pSrc(c + 1), pSrc(c))
Else
Col_Oggetto = ColoreOggetto
End If
Else
Col_Oggetto = Color.FromArgb(pSrc(c + 2), pSrc(c + 1), pSrc(c))
End If
Do
For Each K As Integer In Points
'Application.DoEvents()
Dim sin As Integer
Dim dest As Integer
Dim sop As Integer
Dim Sot As Integer
'testa il punto a destra di questo
If K > 3 Then
sin = K - 3
End If
ColoreAttuale = Color.FromArgb(pSrc(sin + 2), pSrc(sin + 1), pSrc(sin))
If IsNearestColor(Col_Oggetto, ColoreAttuale, CoefficenteOggetto) = True Then 'Funzione Di Confronto Colore con coefficente
If PuntiInseriti.IndexOf(sin) = -1 Then
p2(sin + 2) = Color.Red.R
p2(sin + 1) = Color.Red.G
p2(sin) = Color.Red.B
NewPoints.Add(sin)
PuntiInseriti.Add(sin)
ArrayPoint.Add(sin)
PuntiInseriti.Add(sin + 1)
ArrayPoint.Add(sin + 1)
PuntiInseriti.Add(sin + 2)
ArrayPoint.Add(sin + 2)
End If
End If
If dest < (bytes - 3) Then
dest = K + 3
End If
ColoreAttuale = Color.FromArgb(pSrc(dest + 2), pSrc(dest + 1), pSrc(dest))
If IsNearestColor(Col_Oggetto, ColoreAttuale, CoefficenteOggetto) = True Then
If PuntiInseriti.IndexOf(dest) = -1 Then
p2(dest + 2) = Color.Red.R
p2(dest + 1) = Color.Red.G
p2(dest) = Color.Red.B
NewPoints.Add(dest)
PuntiInseriti.Add(dest)
ArrayPoint.Add(dest)
PuntiInseriti.Add(dest + 1)
ArrayPoint.Add(dest + 1)
PuntiInseriti.Add(dest + 2)
ArrayPoint.Add(dest + 2)
End If
End If
If K > (stride) Then
sop = K - stride
End If
ColoreAttuale = Color.FromArgb(pSrc(sop + 2), pSrc(sop + 1), pSrc(sop))
If IsNearestColor(Col_Oggetto, ColoreAttuale, CoefficenteOggetto) = True Then
If PuntiInseriti.IndexOf(sop) = -1 Then
p2(sop + 2) = Color.Red.R
p2(sop + 1) = Color.Red.G
p2(sop) = Color.Red.B
NewPoints.Add(sop)
PuntiInseriti.Add(sop)
ArrayPoint.Add(sop)
PuntiInseriti.Add(sop + 1)
ArrayPoint.Add(sop + 1)
PuntiInseriti.Add(sop + 2)
ArrayPoint.Add(sop + 2)
End If
End If
If Sot < (bytes - stride) Then
Sot = K + stride
End If
If Sot < bytes Then
ColoreAttuale = Color.FromArgb(pSrc(Sot + 2), pSrc(Sot + 1), pSrc(Sot))
If IsNearestColor(Col_Oggetto, ColoreAttuale, CoefficenteOggetto) = True Then
If PuntiInseriti.IndexOf(Sot) = -1 Then
p2(Sot + 2) = Color.Red.R
p2(Sot + 1) = Color.Red.G
p2(Sot) = Color.Red.B
NewPoints.Add(Sot)
PuntiInseriti.Add(Sot)
ArrayPoint.Add(Sot)
PuntiInseriti.Add(Sot + 1)
ArrayPoint.Add(Sot + 1)
PuntiInseriti.Add(Sot + 2)
ArrayPoint.Add(Sot + 2)
End If
End If
End If
Next
Points.Clear()
Points.AddRange(NewPoints)
NewPoints.Clear()
Loop Until Points.Count = 0
' Copy the RGB values back to the bitmap
System.Runtime.InteropServices.Marshal.Copy(pSrc, 0, SrcScan0, bytes1)
System.Runtime.InteropServices.Marshal.Copy(p2, 0, Scan0, bytes)
immagineRed.UnlockBits(bmData)
bSrc.UnlockBits(bmSrc)
Return ArrayPoint
End Function
''' <summary>
''' Funzione supplementare per determinare
''' se il colore2 e nelle vicinanze del colore1
''' </summary>
''' <param name="color1">Colore del origine</param>
''' <param name="Color2">Colore da controllare</param>
''' <param name="coefficiente"> <code> integer </code> da 0 a 255(differenza tra i componenti ARDB dei colori </param>
''' <returns>Restituisce <code>true </code>, se la differenza tra i componenti ARGB del colore2
''' e quelli del colore1, non supera il coefficiente, altrimenti <code>false</code></returns>
''' <remarks></remarks>
Public Function IsNearestColor(ByVal color1 As Color, ByVal Color2 As Color, ByVal coefficiente As Integer) As Boolean
Dim ADif As Integer = Math.Abs(CInt(color1.A) - CInt(Color2.A))
Dim Rdif As Integer = Math.Abs(CInt(color1.R) - CInt(Color2.R))
Dim Gdif As Integer = Math.Abs(CInt(color1.G) - CInt(Color2.G))
Dim Bdif As Integer = Math.Abs(CInt(color1.B) - CInt(Color2.B))
If ADif < coefficiente _
And Rdif < coefficiente _
And Gdif < coefficiente _
And Bdif < coefficiente _
Then
Return True
Else
Return False
End If
End Function
End Class
Public Class OggettiImmagine
Public point As New List(Of Integer)
Public coefficente As Integer
Public colore As Color
End Class