热门文章 | 热门软件| 热门源码 | 热门电影 | 知识库 | 联系我们
软件 源码 教程 影视 健康 招聘
  HTML | JavaScript | ASP | PHP | JSP | NET | VB | VC | VF | Windows | Linux | Mysql | Mssql | Oracle | Struts 
当前位置: 创世纪计算机资源网 -> 文章频道 ->vb 
站内搜索:
把图像换成灰度
作者:佚名 来源:不详 整理日期:2007-4-13

加一个Command1 一个 Picture1

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
 Picture1.AutoRedraw = True
 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
 将灰度转换为RGB
 rgb5 = RGB(Y, Y, Y)
 SetPixelV hdc5, i, j, rgb5
 Next j
 Next i
 Set Picture1.Picture = Picture1.Image
End Sub

Private Function Red(ByVal mlColor As Long) As Long
 从RGB值中获得红色值
 Red = mlColor And &HFF
End Function

Private Function Green(ByVal mlColor As Long) As Long
 从RGB值中获得绿色值
 Green = (mlColor \ &H100) And &HFF
End Function

Private Function Blue(ByVal mlColor As Long) As Long
 从RGB值中获得蓝色值
 Blue = (mlColor \ &H10000) And &HFF
End Function

相关文章