0/5 (6 avis)
Vue 18 372 fois - Téléchargée 1 971 fois
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
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.