過程一：獲得一個在PICTURE控件中打開的圖像的所有像素。
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
過程二：圖像輸出的過程：
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
下面解釋一下在過程中到的全局變量和數據結構，以及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
這三個數據結構都是在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信息
這裡再給出一個用於數組整體移動數據的過程：
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和變量定義全部貼到一個新建的模塊裡
新建一個窗體，加兩個PICTURE控件：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
新浪微博
QQ空间
人人网
腾讯微博
Facebook
Google+
Plurk
Twitter
Line