网页功能: 加入收藏 设为首页 网站搜索  
彩色BMP档转成灰度
发表日期:2002-12-08作者:[] 出处:  

将RGB想成3D之X,Y,Z轴,则BMP的RGB为(r,g,b)与座标(Y,Y,Y)距离最小时的Y即为灰度值

Y = 0.29900 * R + 0.58700 * G + 0.11400 * B

  整数化

Y = ( 9798*R + 19235*G + 3735*B) / 32768

RGB(Y, Y, Y)就可以了

需一个内有彩色图的PictureBox, CommandBox

Option Explicit

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

Private tmpPic As Picture

Private Sub Form_Load()

Picture1.ScaleMode = 3 '设为Pixel

Picture1.AutoRedraw = True '设定所有Pixel的改变不立即在pictureBox上显示

Set tmpPic = Picture1.Picture

End Sub

Private Sub Command1_click()

Dim width5 As Long, heigh5 As Long, rgb5 As Long

Dim hdc5 As Long, i As Long, j As Long

Dim bBlue As Long, bRed As Long, bGreen As Long

Dim Y As Long

width5 = Picture1.ScaleWidth

heigh5 = Picture1.ScaleHeight

hdc5 = Picture1.hdc

For i = 1 To width5

  For j = 1 To heigh5

    rgb5 = GetPixel(hdc5, i, j)

    bBlue = Blue(rgb5)

    bRed = Red(rgb5)

    bGreen = Green(rgb5)

    Y = (9798 * bRed + 19235 * bGreen + 3735 * bBlue) \ 32768

    rgb5 = RGB(Y, Y, Y)

    SetPixelV hdc5, i, j, rgb5

  Next j

Next i

Set Picture1.Picture = Picture1.Image '此时才真正显示Picture

End Sub

Private Function Red(ByVal mlColor As Long) As Long

Red = mlColor And &HFF

End Function

Private Function Green(ByVal mlColor As Long) As Long

Green = (mlColor \ &H100) And &HFF

End Function

Private Function Blue(ByVal mlColor As Long) As Long

Blue = (mlColor \ &H10000) And &HFF

End Function

我来说两句】 【加入收藏】 【返加顶部】 【打印本页】 【关闭窗口
中搜索 彩色BMP档转成灰度
本类热点文章
  用VB制作软键盘
  用VB制作软键盘
  制作半透明窗体
  让messagebox自动消失
  让messagebox自动消失
  给Listview做个背景
  给Listview做个背景
  VB程序实现WindowsXP效果的界面
  VB打造超酷个性化菜单
  用VB实现“百叶窗”的图形特效
  用VB实现“百叶窗”的图形特效
  用VB绘制正弦动画曲线
最新分类信息我要发布 
最新招聘信息

关于我们 / 合作推广 / 给我留言 / 版权举报 / 意见建议 / 广告投放  
Copyright ©2003-2024 Lihuasoft.net webmaster(at)lihuasoft.net
网站编程QQ群   京ICP备05001064号 页面生成时间:0.00373