COMPARER 2 IMAGES

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

Télécharger le zip

12 janvier 2006 02:25:04 :

Mot clef