VB編程-真彩色轉(zhuǎn)為灰度圖像源碼要點

《VB編程-真彩色轉(zhuǎn)為灰度圖像源碼要點》由會員分享，可在線閱讀，更多相關(guān)《VB編程-真彩色轉(zhuǎn)為灰度圖像源碼要點（38頁珍藏版）》請在裝配圖網(wǎng)上搜索。

1、VB編程真彩色轉(zhuǎn)為灰度圖像源碼,以下代碼請貼在一個新建的 Cimage類中Option ExplicitPrivate TypeBITMAPFILEHEADERbfType As IntegerbfSize As LongbfReservedl As IntegerbfReserved2 As IntegerbfOff Bits As LongEnd TypePrivate TypeBITMAPINFOHEADERbiSizeAs LongbiWidthAs LongbiHeightAs LongbiPlanesAs IntegerbiBitCountAs IntegerbiCompressi

2、onAs LongbiSizeimageAs LongbiXPelsPerMeter As Long biYPelsPerMeter As Long biCIrUsed As Long biCIrlmportant As LongEnd TypePrivate TypebitmapbmTypeAs LongbmWidthAs LongbmHeightAs LongbmWidthBytes As LongbmPlanesAs IntegerbmBitsPixel As IntegerBmBits As LongEnd TypePrivate TypeRGBQUADBlue As ByteGree

3、n As ByteRed As ByteReserved As ByteEnd TypePrivate TypeBITMAPINFObmiHeader As BITMAPINFOHEADERbmiColors As RGBQUADEnd Type帶掩碼的正常真彩色Private Const BI_bitfields = 3&Private Const BI_RGB = 0Private Const DIB_RGB_COLORS = 0Private ConstOBJ BITMAP = 7Private ConstSRCCOPY= &HCC0020Private ConstlMAGE_BITMA

4、P = 0Private ConstLR_LOADFROMFILE = &H10Private ConstLR_CREATEDIBSECTION = &H2000而不是位圖的句柄Private Const STRETCH_ANDSCANS = 1個模式通常應(yīng)用于采用了白色背景的單色位圖Private ConstSTRETCH_ORSCANS = 2Private Const STRETCH_DELETESCANS = 3用于采用了白色背景的單色位圖Private Const STRETCH_HALFTONE =4模式要明顯慢于其他模式位圖對象直接拷貝Loadimage函數(shù)的載入類型，位圖從文件

5、載入如果指定了 IMAGE_BITMAP，就返回D舊Section的句柄,默認(rèn)設(shè)置。剔除的線段與剩下的線段進(jìn)行 AND運算。這剔除的線段被簡單的清除。這個模式通常用于彩色位圖剔除的線段與剩下的線段進(jìn)行 OR運算。這個模式通常應(yīng)舊標(biāo)位圖上的像素塊被設(shè)為源位圖上大致近似的塊。這個用于圖像方面的相關(guān) API 函數(shù)聲明*Private Declare Function CreateDIBSection Lib gdi32 (ByVal hdc As Long, lpBitsInfo As BITMAPINFOHEADER,ByVal wUsage As Long, lpBits As Long, By

6、Val handle As Long, ByVal dw As Long) As LongPrivate Declare FunctionCreateCompatibleDC Lib gdi32 (ByVal hdc As Long) As LongPrivate Declare Function GetDIBColorTable Lib gdi32 (ByVal hdc As Long, ByVal un1 As Long, ByVal un2 As Long, lpRGBQuad As Any) As LongPrivate Declare Function SetDIBColorTabl

7、e Lib gdi32 (ByVal hdc As Long, ByVal un1 As Long, ByVal un2 As Long, pcRGBQuad As RGBQUAD) As Long用于系統(tǒng)輸出的相關(guān)API 函數(shù)聲明*Private Declare Function BitBlt Lib gdi32 (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidthAs Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Lon

8、g, ByVal ySrc As Long, ByVal dwRop AsLong) As LongPrivate Declare Function StretchBlt Lib gdi32 (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidthAs Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidthAs Long, ByVal nSrcHeight As

9、Long, ByVal dwRop As Long) As LongPrivate Declare FunctionGetStretchBltMode Lib gdi32 (ByVal hdc As Long) As LongPrivate Declare FunctionSetStretchBltMode Lib gdi32 (ByVal hdc As Long, ByVal nStretchMode As Long) As Long用于內(nèi)存處理的相關(guān) API 函數(shù)聲明*Private Const GMEMFIXED = &H0Private Const GMEMZEROINIT = &H4

10、0Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)Private Declare FunctionVarPtrArray Lib msvbvm50 Alias V arPtr (Ptr() As Any) As LongPrivate Declare FunctionGlobalAlloc Lib kernel32 (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPrivate Declare FunctionGlobalFree Lib kernel32 (ByVal hMem As

11、 Long) As LongPrivate Declare Sub CopyMemory Lib kernel32 Alias RtlMoveMemory (lpDst As Any, lpSrc As Any, ByValByteLength As Long)Private Declare SubZeroMemory Lib kernel32 Alias RtlMoveMemory (dest As Any, ByVal numBytes As Long)公共常用的 API 函數(shù)函數(shù)聲明*Private Declare FunctionDeleteDC Lib gdi32 (ByVal hd

12、c As Long) As LongPrivate Declare FunctionSelectObject Lib gdi32 (ByVal hdc As Long, ByVal hObject As Long) As Long 保存了內(nèi)存DC當(dāng)前DibSection 的句柄原始DibSection 的句柄當(dāng)前 DibSection 的內(nèi)存地址當(dāng)前圖像的掃描行字節(jié)數(shù)Private Declare FunctionDeleteObject Lib gdi32 (ByVal hObject As Long) As LongPrivate mHdcAsLongPrivate mhDibAsLong

13、Private mhOldDibAsLongPrivate mPtrAs LongPrivate mWidthBytesAs LongPrivate mBmpInfoAs BITMAPINFOHEADER 當(dāng)前圖像的文件信息Private Sub Class_Terminate()DestroyEnd SubPublic Property Get Width() As LongWidth = mBmpInfo.biWidthEnd PropertyPublic Property Get Height() As LongHeight = mBmpInfo.biHeightEnd Property

14、Public Property Get hdc() As Longhdc = mHdcEnd PropertyPublic Property Get DataPtr() As LongDataPtr = mPtrEnd PropertyPublic Property Get WidthBytes() As LongWidthBytes = mWidthBytesEnd Property* 函 數(shù) 名 ： CreateDib輸 入 ： WidthDIB 的寬度Height-DIB 的高度Bits-位圖的位數(shù)，默認(rèn)為 32* 輸 出 ： 返回是否創(chuàng)建成功* 功能描述 ： 創(chuàng)建新的 DIB*Priv

15、ate Function CreateDib(ByVal Width As Long, ByVal Height As Long, Optional ByVal Bits As Integer = 32) AsBooleanDim i As LongDestroy銷毀以前的 DIBmHdc = CreateCompatibleDC(0)創(chuàng)建DIB 設(shè)備場景If mHdc 0 ThenWith mBmpInfo位圖信息頭.biSize = Len(mBmpInfo) .biPlanes = 1.biBitCount = Bits.biWidth = Width.biHeight = Height

16、.biCompression = BI_RGBSelect Case Bits保證每個掃描行必須是4 的倍數(shù)Case 1mWidthBytes = (.biWidth + 7) 8 + 3) And &HFFFFFFFC)Case 4mWidthBytes = (.biWidth + 1) 2 + 3) And &HFFFFFFFC)Case 8mWidthBytes = (.biWidth + 3) And &HFFFFFFFC)Case 16mWidthBytes = (.biWidth * 2 + 3) And &HFFFFFFFC)Case 24mWidthBytes = (.biWi

17、dth * 3 + 3) And &HFFFFFFFC)Case 32mWidthBytes = .biWidth * 4Case ElseExit FunctionEnd Select.biSizeImage = mWidthBytes * .biHeightEnd WithmhDib = CreateDIBSection(mHdc, mBmpInfo, DIB_RGB_COLORS, mPtr, 0, 0)創(chuàng)建 DIB , mPtr就是指向這個創(chuàng)建的 DIBSECTION 的內(nèi)存地址If mhDib 0 ThenmhOldDib = SelectObject(mHdc, mhDib)If

18、Bits = 8 Then是灰度圖像，建立起調(diào)色板ReDim ColorTable(0 To 255) As RGBQUADFor i = 0 To 255ColorTable(i).Red = iColorTable(i).Green = iColorTable(i).Blue = iNextSetDIBColorTable mHdc, 0, 256, ColorTable(0)End IfCreateDib = True選入設(shè)備場景如果是 8位，我們認(rèn)為它設(shè)置調(diào)色板數(shù)據(jù)End IfEnd IfEnd FunctionPublic Function LoadPictureFormFile(F

19、ilename As String) As Boolean件或非圖片文件時出錯On Error Resume Next防止LoadPicture加載不支持的圖片文Dim StdPic As StdPictureDim Width As Long, Height As LongIf Dir(Filename) ThenSet StdPic = LoadPicture(Filename)If Not StdPic Is Nothing ThenWidth = ConvertHimetrix2Pixels(StdPic.Width, True) StdPicture 寬度中的單位是Himetrics

20、創(chuàng)建一個空白的DibHeight = ConvertHimetrix2Pixels(StdPic.Height, False)If CreateDib(Width, Height, 32) = True ThenStdPic.Render mHdc + 0, 0, 0, Width + 0, Height + 0, 0, StdPic.Height, StdPic.Width, -StdPic.Height,ByVal 0類似于BMP 的逆序存儲，所以用 -StdPic.HeightEnd IfSet StdPic = NothingEnd IfEnd IfEnd FunctionPublic

21、 Function ChangeToGreyMode() As BooleanDim iAs Long, jAs LongDim DataArr(0 To 2)As Byte, pDataArr(0 To 0) As LongDim OldArrPtrAs Long, OldpArrPtrAs LongDim DataArrC(0 To 2)As Byte, pDataArrC(0 To 0) As LongDim OldArrPtrCAs Long, OldpArrPtrCAs LongDim LineAddBytesDim PixelAddBytesConst BlueAs LongAs

22、Long, mPtrCAs Long = 28As LongConst GreenAs Long = 150用 long 可以方便的避免 VB 的溢出錯誤Const RedAs Long = 77If mHdc 0 And mBmpInfo.biBitCount = 32 ThenMakePoint VarPtrArray(DataArr), VarPtrArray(pDataArr), OldArrPtr, OldpArrPtr綁定模擬指針MakePoint VarPtrArray(DataArrC), VarPtrArray(pDataArrC), OldArrPtrC, OldpArrP

23、trCmPtrC = GlobalAlloc(GPTR, mBmpInfo.biSizeImage)CopyMemory ByVal mPtrC, ByVal mPtr, mBmpInfo.biSizeImage復(fù)制真彩色圖像的數(shù)據(jù)，其實就是一片連續(xù)的內(nèi)存而已If CreateDib(Width, Height, 8) = True Then新建一個8 位位圖pDataArr(0) = mPtrpDataArrC(0) = mPtrCLineAddBytes = mWidthBytes - mBmpInfo.biWidth保證每個掃描行的寬度For i = 1 To mBmpInfo.biHe

24、ightFor j = 1 To mBmpInfo.biWidthDataArr(0) = (DataArrC(0) * Blue + DataArrC(1) * Green + DataArrC(2) * Red) 255灰度算 pDataArrC(0) = pDataArrC(0) + 4pDataArr(0) = pDataArr(0) + 1NextpDataArr(0) = pDataArr(0) + LineAddBytes32 位的位圖不需要這個NextEnd IfGlobalFree mPtrC釋放分配的內(nèi)存FreePoint VarPtrArray(DataArr), Var

25、PtrArray(pDataArr), OldArrPtr, OldpArrPtrFreePoint VarPtrArray(DataArrC), VarPtrArray(pDataArrC), OldArrPtrC, OldpArrPtrC取消模擬指針End IfChangeToGreyMode = TrueEnd FunctionPublic Function OutPut(ByVal OutDC As Long, Optional ByVal x As Long = 0, Optional ByVal y As Long = 0, OptionalByVal Width As Long,

26、 Optional ByVal Height As Long, Optional ByVal Srcx As Long = 0, Optional ByVal Srcy As Long = 0, Optional ByVal dwRop As RasterOpConstants = vbSrcCopy) As BooleanIf Width = 0 Then Width = mBmpInfo.biWidthIf Height = 0 Then Height = mBmpInfo.biHeightOutPut = BitBlt(OutDC, x, y, Width, Height, mHdc,

27、Srcx, Srcy, dwRop)End FunctionPublic Sub Destroy()If mHdc 0 ThenIf mhDib 0 ThenSelectObject mHdc, mhOldDibDeleteObject mhDibEnd IfDeleteObject mHdcmBmpInfo.biBitCount = 0mBmpInfo.biWidth = 0mBmpInfo.biHeight = 0mBmpInfo.biSizeimage = 0End IfmHdc = 0: mPtr = 0:m Width Bytes = 0mhDib = 0: mhOldDib = 0

28、:End Sub將 Himetrics 轉(zhuǎn)變?yōu)?PixelsPrivate Function ConvertHimetrix2Pixels(HiMetrix As Long, Horizontally As Boolean) As LongIf Horizontally ThenConvertHimetrix2Pixels = HiMetrix * 1440 / 2540 / Screen.TwipsPerPixelXElseConvertHimetrix2Pixels = HiMetrix * 1440 / 2540 / Screen.TwipsPerPixelYEnd IfEnd Func

29、tion*過 程 名 ：MakePoint* 輸 入 ：*功能描述 ：綁定模擬數(shù)組I *+Public Sub MakePoint(ByVal DataArrPtr As Long,OldpArrPtr As Long)Dim Temp As Long, TempPtr As LongCopyMemory Temp, ByVai DataArrPtr, 4Temp = Temp + 12CopyMemory TempPtr, ByVai pDataArrPtr, 4TempPtr = TempPtr + 12CopyMemory OldpArrPtr, By Vai TempPtr, 4Cop

30、yMemory By Vai TempPtr, Temp, 4指針CopyMemory OldArrPtr, ByVai Temp, 4，*By Vai pDataArrPtr As Long, By Ref OldArrPtr As Long, By Ref彳導(dǎo)至ij DataArrPtr的SAFEARRAY結(jié)構(gòu)的地址這個指針偏移12個字節(jié)后就是pvData指針彳導(dǎo)至ij pDataArrPtr的SAFEARRAY結(jié)構(gòu)的地址這個指針偏移12個字節(jié)后就是pvData指針彳呆存舊地址使 pDataArrPtr 指向 DataArrPtr 的 SAFEARRAY 結(jié)構(gòu)的 pvData，保存舊地址E

31、nd Sub*過 程 名 ：FreePoint* 輸 入 ：*功能描述 ：取消綁定模擬數(shù)組*Public Sub FreePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, ByVal OldArrPtr As Long, ByValOldpArrPtr As Long)Dim TempPtr As LongCopyMemory TempPtr, ByVal DataArrPtr, 4得到DataArrPtr 的 SAFEARRAY 結(jié)構(gòu)的地址CopyMemory ByVal (TempPtr + 12), OldArrPtr,

32、 4恢復(fù)舊地址CopyMemory TempPtr, ByVal pDataArrPtr, 4得到pDataArrPtr 的 SAFEARRAY 結(jié)構(gòu)的地址CopyMemory ByVal (TempPtr + 12), OldpArrPtr, 4 恢復(fù)舊地址End Sub*過 程 名 ：ChkFileWrite* 輸 入 ： Filename - 文件路徑，文件不存在，返回錯誤*功能描述 ：判斷是否可以寫入改文件*Private Function ChkFileWrite(Filename As String) As BooleanDim FileNum As LongFileNum = F

33、reeFileOn Error Resume NextOpen Filename For Output As #FileNumIf Err.Number ThenElseClose #FileNumChkFileWrite = TrueEnd IfEnd Function以下位測試代碼:Private Sub Form_Load()Me.AutoRedraw = TrueDim Img As New CimageImg.LoadPictureFormFile c:2.bmpImg.ChangeToGreyModeImg.OutPut Me.hdcMe.RefreshImg.SavePictur

34、eToFile c:3.bmp看看保存后的圖像是不是8 位的Img.Destroy記得一定要銷毀哦End SubPublic Function SavePictureToFile(Filename As String) As BooleanDim iAs Long, jAs LongDim FileNumberAs Long, ColorTable()As RGBQUADDim BmpInfoHeader As BITMAPFILEHEADER目標(biāo)文件可寫且有數(shù)據(jù)可寫If ChkFileWrite(Filename) = True And mHdc 0 ThenBMP 文件的標(biāo)識BmpInfo

35、Header.bfType = &H4D42If mBmpInfo.biBitCount = 8 Then只有 biBitCount 等于 1、 4、 8 時才有調(diào)色板調(diào)色板的大小BmpInfoHeader.bfOffBits = 54 + 4 * 256ReDim ColorTable(0 To 255) As RGBQUADGetDIBColorTable mHdc, 0, 256, ColorTable(0)ElseIf mBmpInfo.biBitCount = 32 ThenBmpInfoHeader.bfOffBits = 54End IfBmpInfoHeader.bfSize

36、= BmpInfoHeader.bfOffBits + mBmpInfo.biSizeImage文件大小FileNumber = FreeFileBMP 文件頭位圖信息頭調(diào)色板Open Filename For Binary As #FileNumberPut #FileNumber, , BmpInfoHeaderPut #FileNumber, , mBmpInfoIf mBmpInfo.biBitCount = 8 Then Put #FileNumber, , ColorTableReDim DibBytes(1 To mBmpInfo.biSizeImage) As ByteCopyMemory DibBytes(1), ByVal mPtr, mBmpInfo.biSizeImagePut #FileNumber, , DibBytes位圖數(shù)據(jù)Close #FileNumberSavePictureToFile = TrueEnd IfEnd Function