Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionModule TraitementChercheImage Function traitement() Boss.Timer1.Enabled = False Boss.Timer1.Stop() Dim Debut As String Dim Fin As String Dim d As String = "<ChercheImage> :" 'd=chaine début Debut = InStr(1, Boss.ListBoxExecute.SelectedItem, d) ' Position du < Fin = InStr(1, Boss.ListBoxExecute.SelectedItem, ";") ' Position du < LoadPicturee.PictureBox1.Image = Image.FromFile(Mid$(Boss.ListBoxExecute.SelectedItem, Debut + d.Length, Fin - Debut - d.Length)) Dim Bounds As Rectangle Dim Capture As System.Drawing.Bitmap Dim Graph As Graphics Bounds = Screen.PrimaryScreen.Bounds Capture = New System.Drawing.Bitmap(Bounds.Width, Bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppPArgb) Graph = Graphics.FromImage(Capture) Graph.CopyFromScreen(Bounds.X, Bounds.Y, 0, 0, Bounds.Size, CopyPixelOperation.SourceCopy) d = "début x=" 'd=chaine début Debut = InStr(1, Boss.ListBoxExecute.SelectedItem, d) ' Position du < Fin = InStr(1, Boss.ListBoxExecute.SelectedItem, ",début y=") ' Position du <debutx = Dim debutx = Mid$(Boss.ListBoxExecute.SelectedItem, Debut + d.Length, Fin - Debut - d.Length) d = "début y=" 'd=chaine début Debut = InStr(1, Boss.ListBoxExecute.SelectedItem, d) ' Position du < Fin = InStr(1, Boss.ListBoxExecute.SelectedItem, ",fin x=") ' Position du <debutx = Dim debuty = Mid$(Boss.ListBoxExecute.SelectedItem, Debut + d.Length, Fin - Debut - d.Length) d = "fin x=" 'd=chaine début Debut = InStr(1, Boss.ListBoxExecute.SelectedItem, d) ' Position du < Fin = InStr(1, Boss.ListBoxExecute.SelectedItem, ",fin y=") ' Position du <debutx = Dim finx = Mid$(Boss.ListBoxExecute.SelectedItem, Debut + d.Length, Fin - Debut - d.Length) d = "fin y=" 'd=chaine début Debut = InStr(1, Boss.ListBoxExecute.SelectedItem, d) ' Position du < Fin InStr(1, Boss.ListBoxExecute.SelectedItem, ",.") ' Position du <debutx Dim finy = Mid$(Boss.ListBoxExecute.SelectedItem, Debut + d.Length, Fin - Debut - d.Length) Dim w1 = (finx - debutx) Dim h1 = (finy - debuty) LoadPicturee.PictureBox2.Image = RognImage(Capture, debutx, debuty, w1, h1) Dim cheminImage1 As Image = LoadPicturee.PictureBox1.Image Dim cheminImage2 As Image = LoadPicturee.PictureBox2.Image Dim ResultImage As String = ComparerDeuxImages((LoadPicturee.PictureBox1.Image), (LoadPicturee.PictureBox2.Image), False, 25, 5) If ResultImage = "True" Then LoadPicturee.PictureBox1.Image.Dispose() LoadPicturee.PictureBox2.Image.Dispose() Boss.Timer1.Enabled = True Boss.Timer1.Interval = 500 Boss.Timer1.Start() Else LoadPicturee.PictureBox1.Image.Dispose() LoadPicturee.PictureBox2.Image.Dispose() Boss.Timer1.Enabled = True Boss.Timer1.Interval = 500 Boss.Timer1.Start() Boss.ListBoxExecute.SelectedIndex = Boss.ListBoxExecute.SelectedIndex + 5 End If End Function Private Function RognImage(ByVal ImaSource As Bitmap, ByVal xPixelDep As Int32, ByVal yPixelDep As Int32, ByVal xPixelTotal As Int32, ByVal yPixelTotal As Int32) As Bitmap Dim nouvImage As New Bitmap(xPixelTotal, yPixelTotal) Dim graph As Graphics = Graphics.FromImage(nouvImage) Dim rect As New Rectangle(0, 0, xPixelTotal, yPixelTotal) graph.DrawImage(ImaSource, rect, xPixelDep, yPixelDep, xPixelTotal, yPixelTotal, GraphicsUnit.Pixel) Return nouvImage End Function End Module
Module CompareImage #Region "Comparer deux images" 'PARAMETRES: 'verifierProportions: si ce parametre est à true, on différencie les images de proportions différentes (ex: 9*10 et 10*10) -tolérance de 1% 'TailleEchantillon: définit la taille de la miniature qui sera utilisée pour la comparaison. La fonction est plus rapide sur un echantillon proche de 1 et plus précise (et moins tolérante) si l'échantillon est loin de 1. Par experience 25 donne des résultats satisfaisants pour moi. 'toleranceDeCouleur: nombre entre 0 et 255 qui définit la différence de couleur autorisée sur chaque canal Public Function ComparerDeuxImages(ByVal image1 As Image, ByVal image2 As Image, Optional ByVal verifierProportions As Boolean True, Optional ByVal TailleEchantillon As Integer 25, Optional ByVal toleranceDeCouleur As Byte = 5) As Boolean 'Je fais un premier test rapide de couleur et de forme pour débusquer les images très différentes: If FonctionComparaisonImages(image1, image2, verifierProportions, 1, toleranceDeCouleur) = False Then Return False '-->elles sont tres différentes Else 'si je les trouve proche, je confirme par un test plus précis, mais sans revérifier les proportions (déja fait si demandé) If FonctionComparaisonImages(image1, image2, False, TailleEchantillon, toleranceDeCouleur) = False Then Return False '--> elles ne sont pas suffisemment proches pour être considérées identiques Else Return True '--> elles sont semblables End If End If End Function Private Function FonctionComparaisonImages(ByVal image1 As Image, ByVal image2 As Image, Optional ByVal verifierProportions As Boolean True, Optional ByVal TailleEchantillon As Integer 25, Optional ByVal toleranceDeCouleur As Byte = 5) As Boolean 'vérifier que les images ont les memes proportions If verifierProportions = True Then If Math.Abs(image1.Height / image2.Height - image1.Width / image2.Width) >= 0.01 Then Return False End If 'vérifier la précision: If TailleEchantillon < 1 Then TailleEchantillon = 1 If TailleEchantillon > image1.Width Then TailleEchantillon = image1.Width If TailleEchantillon > image2.Width Then TailleEchantillon = image2.Width If TailleEchantillon > image1.Height Then TailleEchantillon = image1.Height If TailleEchantillon > image2.Height Then TailleEchantillon = image2.Height 'On fait une miniature carrée des deux images que l'on va comparer 'IMAGE1 Dim Thumb1 As New Bitmap(TailleEchantillon, TailleEchantillon) Dim Graph1 As Graphics = Graphics.FromImage(Thumb1) Graph1.InterpolationMode = Drawing2D.InterpolationMode.Low Graph1.DrawImage(image1, New Rectangle(0, 0, TailleEchantillon, TailleEchantillon)) Graph1.Dispose() 'IMAGE2 Dim Thumb2 As New Bitmap(TailleEchantillon, TailleEchantillon) Dim Graph2 As Graphics = Graphics.FromImage(Thumb2) Graph2.InterpolationMode = Drawing2D.InterpolationMode.Low Graph2.DrawImage(image2, New Rectangle(0, 0, TailleEchantillon, TailleEchantillon)) Graph2.Dispose() Dim temp1 As Integer Dim temp2 As Integer 'pour chaque pixel des images miniatures on vérifie que les couleurs RGB sont identiques à la toleranceDeCouleur près For x As Integer = 0 To TailleEchantillon - 1 For y As Integer = 0 To TailleEchantillon - 1 temp1 = (Thumb1.GetPixel(x, y).B) temp2 = (Thumb2.GetPixel(x, y).B) If Math.Abs(temp1 - temp2) > toleranceDeCouleur Then Return False temp1 = (Thumb1.GetPixel(x, y).G) temp2 = (Thumb2.GetPixel(x, y).G) If Math.Abs(temp1 - temp2) > toleranceDeCouleur Then Return False temp1 = (Thumb1.GetPixel(x, y).R) temp2 = (Thumb2.GetPixel(x, y).R) If Math.Abs(temp1 - temp2) > toleranceDeCouleur Then Return False Next Next 'si on est pas encore sorti de la fonction les images sont similaires: Return True End Function #End Region End Module
If ResultImage = "True" Then LoadPictureee.Close() LoadPictureee.Dispose() Boss.TextBox1.Text += "mémoire libéré" Thread.Sleep(500) Boss.Timer1.Enabled = True Boss.Timer1.Interval = 500 Boss.Timer1.Start() Else LoadPictureee.Close() LoadPictureee.Dispose() Boss.TextBox1.Text += "mémoire libéré" Thread.Sleep(500) Boss.Timer1.Enabled = True Boss.Timer1.Interval = 500 Boss.Timer1.Start() Boss.ListBoxExecute.SelectedIndex = Boss.ListBoxExecute.SelectedIndex + 5 End If