Accueil > > > COMPARER 2 IMAGES
COMPARER 2 IMAGES
Information sur la source
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.
Source
- 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
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 !
Historique
- 12 janvier 2006 02:25:04 :
- Mot clef
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Couleur SetPixel différente de couleure GetPixel sous Windows 2000 [ par cushy007 ]
Couleur SetPixel différente de couleure GetPixel sous Windows 2000 [ par cushy007 ]
Salut, J'ai un problème sous Windows 2000 avec les couleurs des API SetPixel et GetPixel. La couleur que me renvoie GetPixel est différente
Getpixel sans voir l'image [ par loskiller62 ]
Le GetPixel ne fonctionne que si on visualise l'image (picturebox) à l'ecran. Ca me pose un problème si l'image est trop grande car alors on ne peut p
SetPixel et AutoRedraw [ par neria ]
Salut tous le monde !Je vais essayer de faire court :J'essaye d'afficher une image contenue dans un tableau a l'aide de l'API SetPixel. Le problème c'
GetPixel et SetPixel [ par MoiDebutantVB ]
Je me rapelle avoir vu une source .Net qui utilisait GetPixel et Set Pixel ainsi qu'une Api et une autre méthode pour remplacer une couleur d'une bitm
Construire une image depuis un buffer couleur (.NET) [ par ad vitam aeternam ]
Bonjour à tous!Voila, je possède un robot POB-LITE (cf: pob-technology.com). J'ai donc crée un petit logiciel me permet de le diriger à distance depui
Pb d'impression avec Setpixel [ par aldebarre ]
Bonjour J'utilise l'api setpixel pour modifier la couleur de certaines zone d'une image se trouvant ds un picturebox mais mon souci est que quand
enregistrer une image créer avec setpixel [ par chodavins ]
bonjour,j'ai créé une image dans une picturebox avec une succéssion de setpixel, et quand je veux enregistrer cette image avec savepicture j'optiens u
API : HDC et Setpixel [ par Stephane ]
Salut à tous voila, dans le cadre d'un projet encadré, je realise une compression d'images. Mon problème est que au moment d'afficher
ordre d'affichage des images [ par cqui789 ]
Bonjour (Re), Ce coup-ci, je vais parler d'images. J'ai sur ma form une serie d'images. au design de la form, je peut choisir pour chaque image send
|
Derniers Blogs
[RIA SERVICES] INCLUDE ET DOMAINDATASOURCE[RIA SERVICES] INCLUDE ET DOMAINDATASOURCE par Audrey
Dans un de mes articles précédents , j'avais parlé des DomainDataSource avec RIA Services dans le cas d'une interface Maître - Détail. Dans le même principe, je vais parler d'une autre manière de mettre en forme ce cas d'interface avec RIA Services. Et po...
Cliquez pour lire la suite de l'article par Audrey ZUNE : VERSION ZUNE SOFTWARE V 4.2 ET LA SOCIALISATIONZUNE : VERSION ZUNE SOFTWARE V 4.2 ET LA SOCIALISATION par ROMELARD Fabrice
Une des nouveautés de la version V 3.0 était l'apparition de l'onglet Social qui ne fonctionnait que si le MarketPlace était activé sur son poste. Cela limitait donc son intérêt, car hors du cadre commercial USA-CANADA, peu de monde trouva...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice PRATIQUE DE SILVERLIGHT PAR ERIC AMBROSIPRATIQUE DE SILVERLIGHT PAR ERIC AMBROSI par MPOWARE
Je viens de finir la lecture du dernier livre d'
Eric Ambrosi
éditions PEARSON
Son livre donne une approche pratique de Silverlight qui sera aussi bien comprise par le développeur que par le designeur.
Tous les aspects du développement RIA sont abor...
Cliquez pour lire la suite de l'article par MPOWARE APPRENDRE à DéVELOPPER POUR LES MOBILES AVEC LA NOUVELLE GéNéRATION .NETAPPRENDRE à DéVELOPPER POUR LES MOBILES AVEC LA NOUVELLE GéNéRATION .NET par odewit
2 déclinaisons de Silverlight et 2 déclinaisons de Mono permettent dorénavant (ou permettront prochainement) de développer des applications .NET mobiles pour les principales plates-formes du marché :
Silverlight pour Symbian, basé sur Silverlight 2...
Cliquez pour lire la suite de l'article par odewit ZUNE : NOUVELLE VERSION DU ZUNE SOFTWARE - V 4.2ZUNE : NOUVELLE VERSION DU ZUNE SOFTWARE - V 4.2 par ROMELARD Fabrice
Avec la dernière génération du lecteur MP3 de Microsoft, le ZUNE HD, Microsoft a publié une nouvelle version du logiciel pour PC. Ainsi, je me suis décidé à installer celle-ci sur mon Tablet PC ACER, comme toujours le logiciel est donc tél...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
Academy System (10.9.4.0)ACADEMY SYSTEM (10.9.4.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Xilisoft Convertisseur Vidéo Ultimate (5.1.39.0305)XILISOFT CONVERTISSEUR VIDéO ULTIMATE (5.1.39.0305)Xilisoft Convertisseur Vidéo Ultimate est un outil puissant de conversion vidéo, facile à utilise... Cliquez pour télécharger Xilisoft Convertisseur Vidéo Ultimate Xilisoft DVD Ripper Ultimate (5.0.64.0304)XILISOFT DVD RIPPER ULTIMATE (5.0.64.0304)Xilisoft DVD Ripper Ultimate est un logiciel excellent pour copier et convertir DVD vers presque ... Cliquez pour télécharger Xilisoft DVD Ripper Ultimate Rigs of Rods (63.3)RIGS OF RODS (63.3)c'est un jeu de multi-simulation camions,autobus voitures, avions, bateaux, hélicoptère avec défo... Cliquez pour télécharger Rigs of Rods
|