VB6把彩色图片变成灰阶的方法计算机等级考试

文章作者 100test 发表时间 2010:01:01 10:52:46
来源 100Test.Com百考试题网

　　第一读取文件加载 picturebox里 地球人都会这里就不说了
　　’下面建立一个模块
　　view plaincopy to clipboardprint?
　　·········10········20········30········40········50········60········70········80········90········100·······110·······120·······130·······140·······150
　　Option Explicit
　　’算法二要的API
　　Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
　　Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
　　Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
　　Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
　　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
　　’算法一要的API
　　Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
　　Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal crColor As Long) As Long
　　’算法二 提高速度约2秒 是方法1的46倍速度
　　Public Function TurnBmp(hSrcBmp As Long, Optional hDestBmp As Long = 0) As Boolean
　　Dim x As Long, Y As Long
　　Dim BytesPixel As Long
　　If hDestBmp = 0 Then hDestBmp = hSrcBmp
　　Dim tSBmpInfo As BITMAP, tDBmpInfo As BITMAP
　　Dim sBits() As Byte, dBits() As Byte
　　’获得位图信息
　　Call GetObject(hSrcBmp, Len(tSBmpInfo), tSBmpInfo)
　　Call GetObject(hDestBmp, Len(tDBmpInfo), tDBmpInfo)
　　’申请空间
　　ReDim sBits(1 To tSBmpInfo.bmWidthBytes, 1 To tSBmpInfo.bmHeight)
　　ReDim dBits(1 To tDBmpInfo.bmWidthBytes, 1 To tDBmpInfo.bmHeight)
　　’获得源图与目标图二进制位
　　Call GetBitmapBits(hSrcBmp, tSBmpInfo.bmWidthBytes * tSBmpInfo.bmHeight, sBits(1, 1))
　　Call GetBitmapBits(hDestBmp, tDBmpInfo.bmWidthBytes * tDBmpInfo.bmHeight, dBits(1, 1))
　　’计算颜色值占用多少字节
　　BytesPixel = tSBmpInfo.bmBitsPixel / 8
　　Dim l As Integer
　　Dim b As Long