niksalehi
چهارشنبه 12 شهریور 1393, 14:51 عصر
با سلام
من با کد زیر 2 عکس رو با هم مقایسه میکنم ، با استفاده از این کد اگه عکس ها شبیهه هم باشن مشخص میشه :
کد ماژول:
Option Explicit
Private Type BITMAPINFOHEADER
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 RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
Private lonPix_1() As Long
Private lonPix_2() As Long
Public Function ImagesSame(Pic_1 As PictureBox, Pic_2 As PictureBox) As Boolean
Dim bih_1 As BITMAPINFOHEADER, bih_2 As BITMAPINFOHEADER
With bih_1
.biSize = Len(bih_1)
.biPlanes = 1
.biWidth = Pic_1.ScaleWidth
.biHeight = Pic_1.ScaleHeight
.biBitCount = 32
End With
bih_2 = bih_1
ReDim lonPix_1((bih_1.biWidth * bih_1.biHeight) - 1)
ReDim lonPix_2((bih_2.biWidth * bih_2.biHeight) - 1)
GetDIBits Pic_1.hDC, Pic_1.Picture.Handle, 0&, bih_1.biHeight, lonPix_1(0), bih_1, 0
GetDIBits Pic_2.hDC, Pic_2.Picture.Handle, 0&, bih_2.biHeight, lonPix_2(0), bih_2, 0
ImagesSame = ComparePixels
Erase lonPix_1()
Erase lonPix_2()
End Function
'Returns true if pixels from both arrays are the same.
Private Function ComparePixels() As Boolean
Dim lonU1 As Long, lonU2 As Long
Dim bolFound As Boolean, lonLoop As Long
lonU1 = UBound(lonPix_1())
lonU2 = UBound(lonPix_2())
If lonU1 = lonU2 Then
For lonLoop = LBound(lonPix_1()) To lonU1
If lonPix_1(lonLoop) <> lonPix_2(lonLoop) Then
bolFound = True
Exit For
End If
Next lonLoop
ComparePixels = Not bolFound
Else
ComparePixels = False
End If
End Function
کد:
Dim bolRes As Boolean
bolRes = ImagesSame(Picture0, Picture1)
Text = "The images are " & IIf(bolRes, "the same!", "different!")
حالا فرض میکنم من 1 عکس رو میخوام با 2000 عکس داخل دیتابیس مقایسه کنم!
سریع ترین راه چیه؟ دوستان اگه مشکلم حل بشه واقعا کمک بزرگی بهم کردین :لبخندساده:
من با کد زیر 2 عکس رو با هم مقایسه میکنم ، با استفاده از این کد اگه عکس ها شبیهه هم باشن مشخص میشه :
کد ماژول:
Option Explicit
Private Type BITMAPINFOHEADER
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 RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
Private lonPix_1() As Long
Private lonPix_2() As Long
Public Function ImagesSame(Pic_1 As PictureBox, Pic_2 As PictureBox) As Boolean
Dim bih_1 As BITMAPINFOHEADER, bih_2 As BITMAPINFOHEADER
With bih_1
.biSize = Len(bih_1)
.biPlanes = 1
.biWidth = Pic_1.ScaleWidth
.biHeight = Pic_1.ScaleHeight
.biBitCount = 32
End With
bih_2 = bih_1
ReDim lonPix_1((bih_1.biWidth * bih_1.biHeight) - 1)
ReDim lonPix_2((bih_2.biWidth * bih_2.biHeight) - 1)
GetDIBits Pic_1.hDC, Pic_1.Picture.Handle, 0&, bih_1.biHeight, lonPix_1(0), bih_1, 0
GetDIBits Pic_2.hDC, Pic_2.Picture.Handle, 0&, bih_2.biHeight, lonPix_2(0), bih_2, 0
ImagesSame = ComparePixels
Erase lonPix_1()
Erase lonPix_2()
End Function
'Returns true if pixels from both arrays are the same.
Private Function ComparePixels() As Boolean
Dim lonU1 As Long, lonU2 As Long
Dim bolFound As Boolean, lonLoop As Long
lonU1 = UBound(lonPix_1())
lonU2 = UBound(lonPix_2())
If lonU1 = lonU2 Then
For lonLoop = LBound(lonPix_1()) To lonU1
If lonPix_1(lonLoop) <> lonPix_2(lonLoop) Then
bolFound = True
Exit For
End If
Next lonLoop
ComparePixels = Not bolFound
Else
ComparePixels = False
End If
End Function
کد:
Dim bolRes As Boolean
bolRes = ImagesSame(Picture0, Picture1)
Text = "The images are " & IIf(bolRes, "the same!", "different!")
حالا فرض میکنم من 1 عکس رو میخوام با 2000 عکس داخل دیتابیس مقایسه کنم!
سریع ترین راه چیه؟ دوستان اگه مشکلم حل بشه واقعا کمک بزرگی بهم کردین :لبخندساده: