vb图象问题

2005-11-02 01:32:18 167 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

Yunfeng.Xie 墨衍会员 · AI 创作全网分发关注 + 加入社区

【机器学习】DBSCAN聚类算法的理论/实现与调参 DBSCAN，密度聚类算法，算法流程，调参，python实现，c++实现阅读详情

怎样在VB中判断二幅JPG图象是否是一样的?要很快的速度

...全文

DBSCAN聚类算法改进之后的聚类算法，不需要设计k值，通过设置阈值和半径找到所有的分类阅读详情

Yunfeng.Xie

VB基础类 7,788 成员 197,583 内容

+ 关注 + 加入社区

切换为时间正序

Yunfeng.Xie 2005-11-02

打赏
举报

我是用CCD抓的图象然后在抓比较二次抓的是不是一样的图片,然后就定位

韧恒 2005-11-02

打赏
举报

不知道楼主想要多快呢？我大致写了个过程，这个过程对于完全相似的两幅图像来讲执行是最慢的，如果两幅图像大小都不一样，那就更快了。
在我的P3 1.0G/128M/win2000上比较完全相同的1024*768的图像，编译后大约1是0.5秒左右。这段代码肯定不是最快的，首先，我建的是24位场景，如果你检查图片色深，建立相应位深的场景对于16位的图像来讲应该会更快。更重要的是，如果你使用SAFEARRAY2D结构来代替数组的分配，我相信速会大大提高。

Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0 ' color table in RGBs
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 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 Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
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 BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
'Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Dim iBitmap As Long, iDC As Long

Private Function CompeImage(f1 As String, f2 As String) As Boolean
Dim bi24BitInfo1 As BITMAPINFO, bBytes1() As Byte
Dim bi24BitInfo2 As BITMAPINFO, bBytes2() As Byte
Dim pic1 As Picture, iDC1 As Long, tDC1 As Long
Dim pic2 As Picture, iDC2 As Long, tDC2 As Long
Dim hDIBScene1 As Long, bmp1 As BITMAP
Dim hDIBScene2 As Long, bmp2 As BITMAP
Dim cnt As Long

Set pic1 = LoadPicture(f1)
Set pic2 = LoadPicture(f2)

iDC1 = CreateCompatibleDC(0)
iDC2 = CreateCompatibleDC(0)

GetObject pic1.handle, Len(bmp1), bmp1
GetObject pic2.handle, Len(bmp2), bmp2

With bi24BitInfo1.bmiHeader
.biSize = Len(bi24BitInfo1.bmiHeader)
.biWidth = bmp1.bmWidth
.biHeight = bmp1.bmHeight
.biPlanes = 1
.biBitCount = 24
.biCompression = BI_RGB
.biSizeImage = ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
End With

With bi24BitInfo2.bmiHeader
.biSize = Len(bi24BitInfo2.bmiHeader)
.biWidth = bmp2.bmWidth
.biHeight = bmp2.bmHeight
.biPlanes = 1
.biBitCount = 24
.biCompression = BI_RGB
.biSizeImage = ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
End With

If bi24BitInfo1.bmiHeader.biSizeImage <> bi24BitInfo2.bmiHeader.biSizeImage Then
Exit Function
End If

ReDim bBytes1(bi24BitInfo1.bmiHeader.biSizeImage - 1)
ReDim bBytes2(bi24BitInfo2.bmiHeader.biSizeImage - 1)

hDIBScene1 = CreateDIBSection(iDC1, bi24BitInfo1, DIB_RGB_COLORS, 0, 0, 0)
hDIBScene2 = CreateDIBSection(iDC2, bi24BitInfo2, DIB_RGB_COLORS, 0, 0, 0)

DeleteObject SelectObject(iDC1, hDIBScene1)
DeleteObject SelectObject(iDC2, hDIBScene2)

tDC1 = CreateCompatibleDC(0)
tDC2 = CreateCompatibleDC(0)

DeleteObject SelectObject(tDC1, pic1.handle)
DeleteObject SelectObject(tDC2, pic2.handle)

BitBlt iDC1, 0, 0, bmp1.bmWidth, bmp1.bmHeight, tDC1, 0, 0, vbSrcCopy
BitBlt iDC2, 0, 0, bmp2.bmWidth, bmp2.bmHeight, tDC2, 0, 0, vbSrcCopy

GetDIBits iDC1, hDIBScene1, 0, bi24BitInfo1.bmiHeader.biHeight, bBytes1(0), bi24BitInfo1, DIB_RGB_COLORS
GetDIBits iDC2, hDIBScene2, 0, bi24BitInfo2.bmiHeader.biHeight, bBytes2(0), bi24BitInfo2, DIB_RGB_COLORS

CompeImage = True
For cnt = 0 To bi24BitInfo1.bmiHeader.biSizeImage - 1
If bBytes1(cnt) <> bBytes2(cnt) Then
CompeImage = False
Exit For
End If
Next cnt

DeleteDC tDC1
DeleteDC tDC2
DeleteDC iDC1
DeleteDC iDC2
DeleteObject hDIBScene1
DeleteObject hDIBScene2
End Function

Private Sub Command1_Click()
Dim t As Single

t = Timer
Me.Print CompeImage("L:\My Documents\BMP\Img15522739.jpg", "L:\My Documents\BMP\Img15522739.jpg")

Me.Print Timer - t
End Sub

fishmans 2005-11-02

打赏
举报

用API getdibits()到数组,再比较两数组

Summer006 2005-11-02

打赏
举报

如果图像的大小，各点颜色完全一样，就好办多了。直接循环判断，有一点不同就退出循环。

如果图像的大小，各点颜色不是完全一样的话，就麻烦了。要做图像匹配，要找好算法。。建议到专题分类去提问，那里图像高手比较多，不过用vb的倒少了

vb图象问题

相关推荐