Comparer 2 images
0/5 (6 avis)
Vue 18 372 fois - Téléchargée 1 971 fois
Description
Ce code sert a faire la comparaison entre 2 images, l'utiliser c'est surtout pour une webcam par exemple, pour la détection de mouvement (Sa sachant que l'image même si on bouge pas est jamais 100% pareil)
Il serais facile d'optimiser, il suffirait d'enlever quelque option surtout, celle qui ne vous servent absolument a rien.
Absolument rien !
Il serais facile d'optimiser, il suffirait d'enlever quelque option surtout, celle qui ne vous servent absolument a rien.
Source / Exemple :
Public Type lRetour
lRougeStat As Variant
lVertStat As Variant
lBleuStat As Variant
lMoyenneStat As Variant
End Type
Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Declare Function GetTickCount Lib "kernel32" () As Long
Public Function Comparaison(cBox As PictureBox, cBox2 As PictureBox, cResult As PictureBox _
, Optional Sensible As Long = 10, Optional Mode As Long = 1, _
Optional cRouge As Boolean = True, Optional cVert As Boolean = True, Optional cBleu As Boolean = True, _
Optional GreyScale As Boolean = False) As lRetour
On Error Resume Next 'Une erreur peu si vite arrivé
'Début de la déclaration de variable
Dim X As Long, Y As Long
Dim R1 As Long, V1 As Long, B1 As Long
Dim R2 As Long, V2 As Long, B2 As Long, r As Long
Dim Couleur As Long, Couleur2 As Long, EcrirePixel As Boolean
Dim lOR As Long, lOV As Long, lOB As Long, Debut As Long
'=====================================================
'Ici on a le code de comparaison
'=====================================================
cResult.Cls
Debut = GetTickCount
For X = 0 To cBox.ScaleWidth Step Mode
For Y = 0 To cBox.ScaleHeight Step Mode
Couleur = GetPixel(cBox.hdc, X, Y)
'///Séparation des couleurs pour la première image
If cRouge = True Then R1 = Int(Couleur And &HFF)
If cVert = True Then V1 = Int((Couleur And &H100FF00) / &H100)
If cBleu = True Then B1 = Int((Couleur And &HFF0000) / &H10000)
'///Séparation des couleurs pour la première image
Couleur2 = GetPixel(cBox2.hdc, X, Y)
'///Séparation des couleurs pour la 2 image
If cRouge = True Then R2 = Int(Couleur2 And &HFF)
If cVert = True Then V2 = Int((Couleur2 And &H100FF00) / &H100)
If cBleu = True Then B2 = Int((Couleur2 And &HFF0000) / &H10000)
'///Séparation des couleurs pour la 2 image
'FrmMain.List1.AddItem R1 & " " & R2
' SetPixel cResult.hdc, X, Y, RGB(R1, V1, 0)
EcrirePixel = False
'Comparaison au niveau du rouge
If (Not ((R1 > (R2 - Sensible)) And (R1 < (R2 + Sensible)))) And cRouge = True Then
lOR = lOR + 1
EcrirePixel = True
End If
'Comparaison au niveau du vert
If (Not ((V1 > (V2 - Sensible)) And (V1 < (V2 + Sensible)))) And cVert = True Then
lOV = lOV + 1
EcrirePixel = True
End If
'Comparaison au niveau du bleu
If (Not ((B1 > (B2 - Sensible)) And (B1 < (B2 + Sensible)))) And cBleu = True Then
lOB = lOB + 1
EcrirePixel = True
End If
If EcrirePixel = True Then
'//Représentation graphique, pas forcément utile
If GreyScale = True Then
GreyColor = Int((((R1 + R2) / 2) + ((B1 + B2) / 2) + ((V1 + V2) / 2)) / 3)
SetPixel cResult.hdc, X, Y, RGB(GreyColor, GreyColor, GreyColor)
Else
SetPixel cResult.hdc, X, Y, RGB(((R1 + R2) / 2), ((V1 + V2) / 2), ((B1 + B2) / 2))
End If
'//Représentation graphique, pas forcément utile
End If
Next Y
Next X
'Retour des statistique
With Comparaison
.lRougeStat = Format((((lOR / ((cBox.ScaleWidth * cBox.ScaleHeight) / Mode)) * 100) * Mode), "##0.0000")
.lVertStat = Format(((lOV / ((cBox.ScaleWidth * cBox.ScaleHeight) / Mode)) * 100 * Mode), "##0.0000")
.lBleuStat = Format(((lOB / ((cBox.ScaleWidth * cBox.ScaleHeight) / Mode)) * 100 * Mode), "##0.0000")
.lMoyenneStat = Format(((Int(Comparaison.lRougeStat) + Int(Comparaison.lVertStat) + Int(Comparaison.lBleuStat)) / 3), "###.0000")
End With
'//A virer absolument, c'est seulement pour la démonstration
FrmMain.Caption = "Temps d'exécution : " & (GetTickCount - Debut) / 1000 & " seconde(s)"
cResult.Refresh
End Function
Conclusion :
Absolument rien !
Codes Sources
A voir également
- Cbleu
- Cvert commentaires - Meilleures réponses
- Cvert - Meilleures réponses
- Comparer deux images - Guide
- Visual Basic / VB.NET : Comparer deux images pixel/pixel - CodeS SourceS - Guide
- Visual Basic / VB.NET : Comparer deux images - CodeS SourceS - Guide
- Comparer 2 image ✓ - Forum - C# / .NET
- Visual Basic / VB.NET : Snap comparator (comparateur de deux images) - CodeS SourceS - Guide
14 avril 2005 à 00:04
c'est coool ces ce que je cherche
merci
16 oct. 2004 à 21:23
8 févr. 2003 à 16:58
8 févr. 2003 à 16:24
Bien bien !
Bien commentée & tt !
9/10
8 févr. 2003 à 16:24
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.