Option Explicit
Option Base 1
Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData& Lib "user32" (ByVal wFormat&, ByVal hMem&)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function DestroyIcon& Lib "user32" (ByVal hIcon&)
Private Const ImgTemp1 As String = "C:\ImgTemp1.jpg"
Private Const ImgTemp2 As String = "C:\ImgTemp2.jpg"
Private Sub CommandButton1_Click()
Dim iPic As StdPicture
Dim hCopy&
Dim Img As ImageFile
Dim Tableau1 As Variant, Tableau2 As Variant
'Place l'image dans le presse papier
Set iPic = Me.Image1.Picture
OpenClipboard 0&: EmptyClipboard
hCopy = SetClipboardData(2, iPic.Handle)
CloseClipboard
'Enregistre l'image sur le disque dur
If hCopy Then SavePicture iPic, ImgTemp1
DestroyIcon iPic.Handle
'Place l'image dans le presse papier
Set iPic = Me.Image2.Picture
OpenClipboard 0&: EmptyClipboard
hCopy = SetClipboardData(2, iPic.Handle)
CloseClipboard
'Enregistre l'image sur le disque dur
If hCopy Then SavePicture iPic, ImgTemp2
DestroyIcon iPic.Handle
Set Img = New ImageFile
Img.LoadFile "C:\ImgTemp1.jpg"
Tableau1 = Img.FileData.BinaryData
Set Img = Nothing
Set Img = New ImageFile
Img.LoadFile "C:\ImgTemp2.jpg"
Tableau2 = Img.FileData.BinaryData
Set Img = Nothing
MsgBox "Identiques: " & TableauxIdentiques(Tableau1, Tableau2)
Kill ImgTemp1
Kill ImgTemp2
End Sub
Function TableauxIdentiques(Tab1, Tab2) As Boolean
Dim i As Double
If UBound(Tab1) <> UBound(Tab2) Then
TableauxIdentiques = False
Exit Function
Else
For i = 1 To UBound(Tab1)
If Tab1(i) <> Tab2(i) Then
TableauxIdentiques = False
Exit Function
End If
Next i
End If
TableauxIdentiques = True
End Function
