OVH Cloud OVH Cloud

Compartaison de picture box

2 réponses
Avatar
Brice
Bonjour,

Est-il possible de comparer deux picture box pour savoir si elles
contiennent la même image.

Merci

Brice

2 réponses

Avatar
Zoury
Salut Brice! :O)

La façon la plus rapide qui me vient à l'esprit est de récupéré le DIB de
tes PictureBoxes et de boucler les octets de ceux afin de les comparer un à
un...

'***
' Form1
' 2 PictureBoxes
Option Explicit

Private Declare Function GetDIBits _
Lib "gdi32" _
( _
ByVal aHDC As Long, _
ByVal hBitmap As Long, _
ByVal nStartScan As Long, _
ByVal nNumScans As Long, _
ByRef lpvBits As Any, _
ByRef lpBI As BitmapInfo8, _
ByVal wUsage As Long _
) As Long

Private Declare Function GetDC _
Lib "user32" _
( _
ByVal hwnd As Long _
) As Long

Private Declare Function ReleaseDC _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal hDC As Long _
) As Long

Private Type BitmapInfoHeader '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Private Type BitmapInfo8
bmiHeader As BitmapInfoHeader
bmiColors(255) As Long
End Type

Private Sub Form_Load()
Set Picture1.Picture = LoadPicture("c:Image.bmp")
Set Picture2.Picture = LoadPicture("c:2Jours.bmp")
Debug.Print ComparePictures(Picture1.Picture, Picture2.Picture)
End Sub

Private Function ComparePictures(ByRef pic1 As StdPicture, ByRef pic2 As
StdPicture) As Boolean

Dim by1() As Byte
Dim by2() As Byte
Dim i As Long

by1 = GetDIBData(pic1)
by2 = GetDIBData(pic2)

' Vérifie les tailles...
If (Not IsArrayInit(by1) Or Not IsArrayInit(by2)) Then Exit Function
If (LBound(by1) <> LBound(by2) Or UBound(by1) <> UBound(by2)) Then Exit
Function

' Vérifie le contenu
For i = 0 To UBound(by1)
If (by1(i) <> by2(i)) Then Exit Function
Next i

ComparePictures = True

End Function

Private Function GetDIBData(ByRef pic As StdPicture) As Byte()

Dim by() As Byte
Dim bi As BitmapInfo8
Const DIB_RGB_COLORS = 0

Dim hDC As Long
hDC = GetDC(0) ' Desktop

bi.bmiHeader.biSize = LenB(bi.bmiHeader)
If GetDIBits(hDC, pic.Handle, 0, 0, ByVal 0&, bi, DIB_RGB_COLORS) Then
ReDim by(bi.bmiHeader.biSizeImage - 1) As Byte
Call GetDIBits(hDC, pic.Handle, 0, bi.bmiHeader.biHeight, by(0), bi,
DIB_RGB_COLORS)
End If

GetDIBData = by

Call ReleaseDC(0&, hDC)

End Function

Private Function IsArrayInit(ByVal v As Variant) As Boolean
On Error Resume Next
v = UBound(v)
IsArrayInit = (Err.Number <> 9 And Err.Number <> 13)
End Function
'***

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
"Brice" wrote in message
news:blu7tg$qbj$
Bonjour,

Est-il possible de comparer deux picture box pour savoir si elles
contiennent la même image.

Merci

Brice




Avatar
Brice
Merci Zoury

A+


"Zoury" wrote in message
news:
Salut Brice! :O)

La façon la plus rapide qui me vient à l'esprit est de récupéré le DIB de
tes PictureBoxes et de boucler les octets de ceux afin de les comparer un


à
un...