PDA

View Full Version : بهترین راه و سریعترین راه مقایسه عکس ها با هم



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 عکس داخل دیتابیس مقایسه کنم!
سریع ترین راه چیه؟ دوستان اگه مشکلم حل بشه واقعا کمک بزرگی بهم کردین :لبخندساده: