要处理个图像首先要获得该图像像素值而VB本身提供PICTUREControl控件虽然可以打开很多类型图片但是它提供那个POINT思路方法读取像素实在是太慢而使用GetPixel这个API速度也快不到哪里去PIONT思路方法本身就是对于GetPixel个包装

　　在VB中要快速获取幅在PICTURE中打开图像比较快速思路方法是使用DIB思路方法当然还有DDB思路方法不过使用DDB思路方法还需要考虑区别颜色深度图像分别处理在实现上要相对复杂而使用DIB思路方法则不必并且在处理速度上比DDB思路方法也慢有限

　　过程:获得个在PICTUREControl控件中打开图像所有像素

Public Sub DibGet(ByVal IdSource As Long, XBegin As Long, ByVal YBegin As Long, ByVal XEnd As Long, ByVal YEnd As Long)
　Dim iBitmap As Long
　Dim iDC As Long
　Dim I As LongDim
　Dim W As Long
　Dim H As Long

　On Error GoTo ErrLine
　Done = False
　TimeGet = timeGetTime
　InPutWid = XEnd - XBegin
　InPutHei = YEnd - YBegin
　W = InPutWid + 1
　H = InPutHei + 1

　I = (Bits \ 8) - 1
　ReDim ColVal(I, InPutWid, InPutHei)
　With bi24BitInfo.bmiHeader
　　.biBitCount = Bits
　　.biCompression = 0&
　　.biPlanes = 1
　　.biSize = Len(bi24BitInfo.bmiHeader)
　　.biWidth = W
　　.biHeight = H
　End With

　iBitmap = GetCurrentObject(IdSource, 7&)
　GetDIBits IdSource, iBitmap, 0&, H, ColVal(0, 0, 0), bi24BitInfo, 0& DeleteObject iBitmap
　Done = True
　TimeGet = timeGetTime - TimeGetExit Sub
ErrLine:
　MsgBox "号:" & Err.Number & ":" & Err.Description
End Sub

　　在这个过程中所用到只是些参数设定和API不涉及算法

　　过程 2:图像输出过程:

Public Sub DIBPut(ByVal IdDestination As Long)
　Dim W As Long
　Dim H As Long

　On Error GoTo ErrLine
　Done = False
　TimePut = timeGetTime

　W = OutPutWid + 1
　H = OutPutHei + 1

　With bi24BitInfo.bmiHeader
　　.biWidth = W
　　.biHeight = H
　　LineBytes = ((W * Bits + 31) And &HFFFFFFE0) \ 8
　　.biSizeImage = LineBytes * H
　End With
　SetDIBitsToDevice IdDestination, 0, 0, W, H, 0, 0, 0, H, ColOut(0, 0, 0), bi24BitInfo.bmiHeader, 0

　Done = True
　TimePut = timeGetTime - TimePut
　Exit Sub
ErrLine:
　MsgBox Err.Description
End Sub


] 上页  1 2  
  



　　下面解释下在过程中到全局变量和数据结构以及API定义

　　API定义:

　　删除个DC

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 GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long

　　获取DIB

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 timeGetTime Lib "winmm.dll" As Long

　　数据结构定义:

Private Type BitMapInfoHeader '文件信息头——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

　　这 3个数据结构都是在DIB中不可缺少我们不必深究只是按照顺序复制粘贴直接使用就是了

　　过程中用到全局变量:

Private Const Bits As Long = 32 '颜色深度这里把所有图像都按照32位来处理
Public Done As Boolean '用于标记个过程是否结束
Public TimeGet As Long '用于记录输入过程处理所花费时间
Public TimePut As Long '用于记录输出过程处理所花费时间
Dim ColVal As Byte '用于存放从DIB输入像素值
Dim ColOut As Byte '用于存放向DIB输出像素值
Dim InPutHei As Long '用于记录输入图像高度
Dim InPutWid As Long '用于记录输入图像宽度
Dim bi24BitInfo As BitMapInfo '定义BMP信息

　　可以看出我在输入和输出中使用了两个区别动态ColVal和ColOut这么做是有道理我们不只是为了输入和输出图像中间还要对像素进行处理包括图像缩放、色彩调整、锐化、柔化等等处理使用两个区别来分别存放数据更有利于实现

　　有些性急朋友说不定已经把贴到工程里试用了可是会发现根本不能输出图像这是当你用DIBGET获得图像还在ColVal 中呢需要把它们放到ColOut这个中去DIBPUT这个过程才能起作用

　　这里再给出个用于整体移动数据过程:

Public Sub CopyData(ByVal W As Long, ByVal H As Long)
　Dim Length As Long
　Dim I As Long
　Dim L As Long
　I = Bits \ 8
　L = I - 1
　Length = (W + 1&) * (H + 1&) * I
　ReDim ColOut(L, W, H)
　CopyMemory ColOut(0, 0, 0), ColVal(0, 0, 0), Length
End sub

　　API定义:

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)

　　这时我们就可以来试下效果了:

　　把你显示器调到32位色

　　将前面所有API和变量定义全部贴到个新建模块里

　　新建个窗体加两个PICTUREControl控件:pictrue1 ,picture2 个按钮command1

　　在pictrue1中加载个图片

　　在command1中写如下代码:

sub command1_click
　With picture1
　　.ScaleMode=3
　　.BorderStyle=0
　　DibGet .hdc,0,0,.scalewidth,.scaleheight
　End With
　CopyData InPutHei ,InPutWid
　picture2.AutoRedraw=True
　DibPut picture2.hdc
　picture2.refresh
end sub

　　运行下按钮按下pictreu1中图片就立刻显示到了picture2中

　　这时你可能会说弄了这么半天就贴个图？用PaPicture不是就可以了吗？

　　不错如果只是要贴个图确实不用这么麻烦可是我们后面要说图像处理部分将会用到前门得到像素值所以这只是个开始我真正要讲东西还在后面呢请大家继续关注