50分求颜色的各种表示形式之间的转换，例如RGB，十六进制，vb中的&H8000000F&等表示形式

Question

50分求颜色的各种表示形式之间的转换，例如RGB，十六进制，vb中的&H8000000F&等表示形式

Answer 1

Option ExplicitPrivate Type RGB
    Red As Byte
    Green As Byte
    Blue As Byte
End Type
Private Function RGBToLong(ColorRGB As RGB) As Long
    ' Just what it looks like =)
    RGBToLong = RGB(ColorRGB.Red, ColorRGB.Green, ColorRGB.Blue)
End FunctionPrivate Function LongToRGB(ColorVal As Long) As RGB
    ' And vice-versa =)
    If ColorVal >= 0 Then
        With LongToRGB
            .Red = (ColorVal And &HFF) Mod 256
            .Green = ((ColorVal And &HFF00) \ &H100) Mod 256
            .Blue = ((ColorVal And &HFF0000) \ &H10000) Mod 256
        End With
    End If
End FunctionPrivate Sub Command1_Click()
    Dim mRGB As RGB
    mRGB.Red = 127
    mRGB.Green = 0
    mRGB.Blue = 127
    Dim i As Long
    i = RGBToLong(mRGB)
    Debug.Print "RGB(" + CStr(mRGB.Red) + "," + CStr(mRGB.Green) + "," + CStr(mRGB.Blue) + ")，对应的数值为：" + CStr(i)
    Dim S As String
    S = Hex(i)
    Debug.Print "其16进制表示为&H" + S
    MsgBox "RGB(" + CStr(mRGB.Red) + "," + CStr(mRGB.Green) + "," + CStr(mRGB.Blue) + ")，对应的数值为：" + CStr(i) + vbCrLf + "其16进制表示为&H" + S
End SubPrivate Sub Command2_Click()
    Dim S As String
    S = "&H7FFF7F"
    Dim i As Long
    i = Val(S)
    Debug.Print "16进制数" + S + "对应的10进制表示为" + CStr(i)
    Dim mRGB As RGB
    mRGB = LongToRGB(i)
    Debug.Print "其RGB颜色表示为：" + "RGB(" + CStr(mRGB.Red) + "," + CStr(mRGB.Green) + "," + CStr(mRGB.Blue) + ")"
    MsgBox "16进制数" + S + "对应的10进制表示为" + CStr(i) + vbCrLf + "其RGB颜色表示为：" + "RGB(" + CStr(mRGB.Red) + "," + CStr(mRGB.Green) + "," + CStr(mRGB.Blue) + ")"
End Sub

Answer 2

谢谢。真是高手，你还知道CYMK跟他们之间的转换吗？像photoshop中的两种RGB和CYMK。

Answer 3

有人知道CYMK怎么和RGB转换吗？

Answer 4

颜色值转换为灰度值函数：
function RGBToGray(R as integer,G as inteter,B as integer) as long
  dim NewR as single
  dim NewG as single  
  dim NewB as single  NewR=0.3 * R
  NewC=0.59*C
  NewB=0.11 * B
  
  RGBToGray=RGB(NewR,NewC,NewB)
end function以上函数不知能不能满足你的要求

Answer 5

谢谢,这个我先收好,CYMK怎么和RGB转换呢?望高手指点!

Answer 6

看看这个吧
http://media.cs.tsinghua.edu.cn/~ahz/digitalimageprocess/chapter18/chapt18_ahz.htm

Answer 7

使用以下API可以
&H8000000F& 为 OLE_COLOR(RGB)
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long  如：
          Dim tmpColor As OLE_COLOR
          Call OleTranslateColor(vbButtonFace, 0, tmpColor)

Answer 8

颜色转换函数(RGB、HSB、CMYK、Lab) 
作者：enmity | 灵感之源 发表日期：2003年12月9日 Option ExplicitPrivate R As Byte
Private G As Byte
Private B As Byte
Public Property Get cmyC() As Byte
    cmyC = 255 - R
End PropertyPublic Property Get cmyM() As Byte
    cmyM = 255 - G
End Property
Public Property Get cmykK() As Integer
    cmykK = Minimum(255 - R, 255 - G, 255 - B) / 2.55
End Property
Public Property Get cmykC() As Integer
    Dim MyR As Integer, Div As Integer
    MyR = R / 2.55
    
    Div = (100 - cmykK)
    If Div = 0 Then Div = 1
    
    cmykC = ((100 - MyR - cmykK) / Div) * 100
End PropertyPublic Property Get cmykM() As Integer
    Dim MyG As Integer, Div As Integer
    MyG = G / 2.55
    
    Div = (100 - cmykK)
    If Div = 0 Then Div = 1
    
    cmykM = ((100 - MyG - cmykK) / Div) * 100
End PropertyPublic Property Get cmykY() As Integer
    Dim MyB As Integer, Div As Integer
    MyB = B / 2.55
    
    Div = (100 - cmykK)
    If Div = 0 Then Div = 1
    
    cmykY = ((100 - MyB - cmykK) / Div) * 100
End PropertyPublic Property Get cmyY() As Byte
    cmyY = 255 - B
End Property
Public Property Get hlsH() As Integer
    Dim MyR As Single, MyG As Single, MyB As Single
    Dim Max As Single, Min As Single
    Dim Delta As Single, MyVal As Single
    
    MyR = R / 255: MyG = G / 255: MyB = B / 255
    
    Max = Maximum(MyR, MyG, MyB)
    Min = Minimum(MyR, MyG, MyB)
    
    If Max <> Min Then
        Delta = Max - Min
        Select Case Max
            Case MyR
                MyVal = (MyG - MyB) / Delta
            Case MyG
                MyVal = 2 + (MyB - MyR) / Delta
            Case MyB
                MyVal = 4 + (MyR - MyG) / Delta
        End Select
    End If
    
    MyVal = (MyVal + 1) * 60
    If MyVal < 0 Then MyVal = MyVal + 360
    
    hlsH = MyVal
    Debug.Print hlsH
End Property
Public Property Get hlsL() As Integer
    hlsL = ((Maximum(R, G, B) + Minimum(R, G, B)) / 2) / 2.55
End Property
Public Property Get hlsS() As Integer
    Dim MyR As Single, MyG As Single, MyB As Single
    Dim Max As Single, Min As Single, MyS As Single
    
    MyR = R / 255: MyG = G / 255: MyB = B / 255
    
    Max = Maximum(MyR, MyG, MyB)
    Min = Minimum(MyR, MyG, MyB)
    
    If Max <> Min Then
        If hlsL <= 50 Then
            MyS = (Max - Min) / (Max + Min)
        Else
            MyS = (Max - Min) / (2 - Max - Min)
        End If
        hlsS = MyS * 100
    End If
End PropertyPrivate Function Minimum(ParamArray Vals())
    Dim n As Integer, MinVal
    
    MinVal = Vals(0)
    
    For n = 0 To UBound(Vals)
        If Vals(n) < MinVal Then MinVal = Vals(n)
    Next n    Minimum = MinVal
End Function
Private Function Maximum(ParamArray Vals())
    Dim n As Integer, MaxVal
    
    For n = 0 To UBound(Vals)
        If Vals(n) > MaxVal Then MaxVal = Vals(n)
    Next n    Maximum = MaxVal
End FunctionPublic Property Let rgbR(NewVal As Byte)
    R = NewVal
End Property
Public Property Get rgbR() As Byte
    rgbR = R
End PropertyPublic Property Get rgbG() As Byte
    rgbG = G
End PropertyPublic Property Get rgbB() As Byte
    rgbB = B
End Property
Public Property Get ycbcrY() As Byte
    ycbcrY = R * 0.2989 + G * 0.5866 + B * 0.1145
End Property
Public Property Get ycbcrCb() As Byte
    Dim MyCb As Integer
    MyCb = -0.1687 * R - 0.3313 * G + 0.5 * B + 128
    
    ycbcrCb = IIf(MyCb <= 255, MyCb, 255)
End Property
Public Property Get ycbcrCr() As Byte
    Dim MyCr As Integer
    MyCr = 0.5 * R - 0.4187 * G - 0.0813 * B + 128
    
    ycbcrCr = IIf(MyCr <= 255, MyCr, 255)
End PropertyPublic Property Let rgbG(NewVal As Byte)
    G = NewVal
End Property
Public Property Let rgbB(NewVal As Byte)
    B = NewVal
End Property
Public Sub SetCMY(C As Integer, M As Integer, Y As Integer)
    R = 255 - C
    G = 255 - M
    B = 255 - Y
End Sub
Public Sub SetHLS(H As Integer, L As Integer, S As Integer)
    Dim MyR As Single, MyG As Single, MyB As Single
    Dim MyH As Single, MyL As Single, MyS As Single
    Dim Min As Single, Max As Single, Delta As Single
    
    MyH = (H / 60) - 1: MyL = L / 100: MyS = S / 100
    If MyS = 0 Then
        MyR = MyL: MyG = MyL: MyB = MyL
    Else
        If MyL <= 0.5 Then
            Min = MyL * (1 - MyS)
        Else
            Min = MyL - MyS * (1 - MyL)
        End If
        Max = 2 * MyL - Min
        Delta = Max - Min
        
        Select Case MyH
            Case Is < 1
                MyR = Max
                If MyH < 0 Then
                    MyG = Min
                    MyB = MyG - MyH * Delta
                Else
                    MyB = Min
                    MyG = MyH * Delta + MyB
                End If
            Case Is < 3
                MyG = Max
                If MyH < 2 Then
                    MyB = Min
                    MyR = MyB - (MyH - 2) * Delta
                Else
                    MyR = Min
                    MyB = (MyH - 2) * Delta + MyR
                End If
            Case Else
                MyB = Max
                If MyH < 4 Then
                    MyR = Min
                    MyG = MyR - (MyH - 4) * Delta
                Else
                    MyG = Min
                    MyR = (MyH - 4) * Delta + MyG
                End If
        End Select
    End If
    
    R = MyR * 255: G = MyG * 255: B = MyB * 255
End Sub
Public Sub SetCMYK(C As Integer, M As Integer, Y As Integer, K As Integer)
    Dim MyC As Single, MyM As Single, MyY As Single, MyK As Single
    
    MyC = C / 100: MyM = M / 100: MyY = Y / 100: MyK = K / 100
    
    R = (1 - (MyC * (1 - MyK) + MyK)) * 255
    G = (1 - (MyM * (1 - MyK) + MyK)) * 255
    B = (1 - (MyY * (1 - MyK) + MyK)) * 255
End SubPublic Sub SetYCbCr(Y As Integer, Cb As Integer, Cr As Integer)
    Dim MyR As Integer, MyG As Integer, MyB As Integer
    
    MyR = Y + 1.402 * (Cr - 128)
    MyG = Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)
    MyB = Y + 1.772 * (Cb - 128)
    
    If MyR > 255 Then MyR = 255
    If MyG > 255 Then MyG = 255
    If MyB > 255 Then MyB = 255
    
    If MyR < 0 Then MyR = 0
    If MyG < 0 Then MyG = 0
    If MyB < 0 Then MyB = 0    R = MyR
    G = MyG
    B = MyB
End Sub 
 

Answer 9

这是一个简单得不能再简单的问题,用Hex(a)就可以了.
例如:
DIM T AS STRING
T=HEX(RGB(255,0,0))