Comparer 2 images

Soyez le premier à donner votre avis sur cette source.

Vue 17 626 fois - Téléchargée 1 898 fois

Télécharger le projet
Commenter

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 / 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 !
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
asem67
Messages postés
145
Date d'inscription
mardi 3 septembre 2002
Statut
Membre
Dernière intervention
24 février 2008
 -
slt.
c'est coool ces ce que je cherche
merci
Signaler
cs_clementpat
Messages postés
406
Date d'inscription
lundi 2 décembre 2002
Statut
Membre
Dernière intervention
25 janvier 2014
 -
super bien pensé !
Signaler
cs_mehdibou
Messages postés
365
Date d'inscription
vendredi 24 mai 2002
Statut
Membre
Dernière intervention
18 octobre 2004
 -
ho, mais que c'est joli tout ça ;)
Signaler
Vbsupernul
Messages postés
287
Date d'inscription
vendredi 25 octobre 2002
Statut
Membre
Dernière intervention
18 janvier 2004
 -
Voilà mon piti, un commentaire, enfin ;)
Bien bien !
Bien commentée & tt !
9/10
Signaler
cs_PereNoel
Messages postés
68
Date d'inscription
mardi 31 décembre 2002
Statut
Membre
Dernière intervention
2 mai 2004
 -
C'est tres cool ! Bonne prog ! Bravooo ! Clap ! Clap ! Clap !
Afficher les 6 commentaires
S'inscrire maintenant

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.

Du même auteur (cs_max12)