发表评论(0)作者:, 平台:, 阅读:12471, 日期:2000-03-12
将真彩色图像变为256色灰度(BIG5码):
来源:cww参考BBS上的文章而作
将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
来源:cww参考BBS上的文章而作
将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