灰度图转换成伪全彩的代码的函数有没有现成的呢？

Question

灰度图转换成伪全彩的代码的函数有没有现成的呢？

Answer 1

'模块部分
'灰度图转RGB
'用的是最常见的转换曲线，效果很差，如果你知道更好的转换曲线，请告诉我'==================================================================
' 函数: GetGrayRValue
'
' 功能: 从指定灰度值颜色中分离出红色分量
'
' 入口: rgbColor    指定的颜色
'
Function GetGrayRValue&(ByVal rgbColor&)
'-----------------------------------------------------------------
    GetGrayRValue = rgbColor Mod 256
    GetGrayRValue = (GetGrayRValue + 65536) Mod 256
    Select Case GetGrayRValue
        Case GetGrayRValue <= 255 / 2
            GetGrayRValue = 0
        Case GetGrayRValue > 255 / 2 And GetGrayRValue < 255 * 3 / 4
            GetGrayRValue = (GetGrayRValue - 255 / 4) * 4
        Case GetGrayRValue >= 255 * 3 / 4
            GetGrayRValue = 255
    End Select
'-----------------------------------------------------------------
End Function
'==================================================================
'==================================================================
' 函数: GetGrayGValue
'
' 功能: 从指定灰度值颜色中分离出绿色分量
'
' 入口: rgbColor    指定的颜色
'
Function GetGrayGValue&(ByVal rgbColor&)
'-----------------------------------------------------------------
    GetGrayGValue = (rgbColor \ 256) Mod 256
    GetGrayGValue = (GetGrayGValue + 65536) Mod 256
    Select Case GetGrayGValue
        Case GetGrayGValue <= 255 / 4
            GetGrayGValue = GetGrayGValue * 4
        Case GetGrayGValue > 255 / 4 And GetGrayGValue < 255 * 3 / 4
            GetGrayGValue = 255
        Case GetGrayGValue >= 255 * 3 / 4
            GetGrayGValue = 255 - (GetGrayGValue - 255 * 3 / 4) * 4
    End Select
'-----------------------------------------------------------------
End Function
'==================================================================
'==================================================================
' 函数: GetGrayBValue
'
' 功能: 从指定灰度值颜色中分离出蓝色分量
'
' 入口: rgbColor    指定的颜色
'
Function GetGrayBValue&(ByVal rgbColor&)
'-----------------------------------------------------------------
    GetGrayBValue = rgbColor \ 65536
    GetGrayBValue = (GetGrayBValue + 65536) Mod 256
    Select Case GetGrayBValue
        Case GetGrayBValue <= 255 / 4
            GetGrayBValue = 255
        Case GetGrayBValue > 255 / 4 And GetGrayBValue < 255 * 3 / 4
            GetGrayBValue = 255 - (GetGrayBValue - 255 / 4) * 4
        Case GetGrayBValue >= 256 * 3 / 4
            GetGrayBValue = 0
    End Select
'-----------------------------------------------------------------
End Function
'==================================================================
'==================================================================
' 函数: GetRValue
'
' 功能: 将场景的某一点的颜色转换为RGB颜色
'
' 入口: SrcDC       指定的颜色
'       nx          场景中点的X
'       ny          场景中点的Y
'       nMaskColor  [可选],该颜色不会改变
'
Sub ChangetoRGB(ByVal SrcDC&, _
                 ByVal nx&, _
                 ByVal ny&, _
                 Optional ByVal nMaskColor& = -1)
'-----------------------------------------------------------------
    Dim rgbColor&
    Dim RValue&, GValue&, BValue&
    Dim dl&
    
    'get color.
    rgbColor = GetPixel(SrcDC, nx, ny)
    
    'if rgbColor=MaskColor, don't chang the color
    If rgbColor = nMaskColor Then GoTo Release:
    RValue = GetGrayRValue(rgbColor)
    GValue = GetGrayGValue(rgbColor)
    BValue = GetGrayBValue(rgbColor)
    
    'set new color
    
    rgbColor = RValue + 255 * GValue + 65536 * BValue
    
    dl& = SetPixelV(SrcDC, nx, ny, rgbColor)
    
Release:
    rgbColor = 0
    RValue = 0: GValue = 0: BValue = 0
    dl = 0
'-----------------------------------------------------------------
End Sub
'=================================================================='==================================================================
' 函数: DrawRGBBitmap
'
' 功能: 将DC中的某一区域转换为RGB表示
'
' 入口: hdc         DC
'       nx          区域的起始点X
'       ny          区域的起始点Y
'       nWidth      区域的宽度
'       nHeight     区域的高度
'       nMaskColor  屏蔽色
'
Sub DrawRGBBitmap(ByVal hdc&, _
                   ByVal nx&, _
                   ByVal ny&, _
                   ByVal nWidth&, _
                   ByVal nHeight&, _
                   Optional ByVal nMaskColor& = -1)
'-----------------------------------------------------------------
    Dim i&, j&
    
    'Chang the bitmap to RGB bitmap in hdc.
    For i = nx To nWidth
        For j = ny To nHeight
            'Call ChangetoRGB function
            ChangetoRGB hdc, i, j, nMaskColor
        Next j
    Next i
'-----------------------------------------------------------------
End Sub
'============
调用时，用一个picturebox载入一幅灰度图，类似下面就可以了：
 DrawRGBBitmap picSrc.hdc, 0, 0, 320, 240希望大家用玉砸我！