几个颜色转换函数源码

VB的几个颜色转换函数源码

'把ARGB转RGB。
Public Function ARGBToRGB(ByVal Color As Long) As Long
Dim R As Long,G As Long,B As Long
R = (Color And &HFF0000) \ &H10000
G = Color And &HFF00&
B = (Color And &HFF&) * &H10000
ARGBToRGB = R Or G Or B
End Function

'----------RGB转24位色--------------------
Private Function RGB(ByVal Red As Byte,ByVal Green As Byte,ByVal Blue As Byte) As Long
RGB = Red + Green * 256 + Blue * 65536
End Function

'将一种颜色分为三色
Public Function GetRGB(ByVal Color As Long,ByRef Red As Integer,ByRef Green As Integer,ByRef Blue As Integer) As Boolean
Red = Color And &HFF '拆分颜色
Green = (Color And 65280) \ 256
Blue = (Color And &HFF0000) \ 65536
End Function

'将RGB颜色转换成ARGB格式
Public Function RGBToARGB(ByVal Color As Long,Optional ByVal Alpha As Long = &HFF000000) As Long
'RGB 颜色 = B*256*256+G*256+R,=00BbGgRr
'Argb颜色 =A*256*256*256+R*256*256+G*256+B,=AaRrGgBb
RGBToARGB = Alpha Or ((Color And &HFF0000) \ &H10000) Or (Color And &HFF00&) Or ((Color And &HFF&) * &H10000)
End Function

'-----------ARGB转32位色。写法1--------------------
Private Function ARGB(ByVal Alpha As Byte,ByVal Red As Byte,ByVal Blue As Byte) As Long
Dim RGBColor As Long,NewAlpha As Long
RGBColor = Red + Green * 256 + Blue * 65536
NewAlpha = "&H" & Hex(Alpha) & "000000"
ARGB1 = NewAlpha Or ((RGBColor And &HFF0000) \ &H10000) Or (RGBColor And &HFF00&) Or ((RGBColor And &HFF&) * &H10000)
End Function
'-----------ARGB转32位色。写法2--------------------
Private Function ARGB(ByVal Alpha As Byte,NewAlpha As Long,i As Long,lMask As Long
RGBColor = Red + Green * 256 + Blue * 65536
NewAlpha = Alpha
'--------------------进行移位运算，左移24位----------------------
For i = 1 To 24
lMask = 0
If (NewAlpha And &H40000000) <> 0 Then lMask = &H80000000
NewAlpha = (NewAlpha And &H3FFFFFFF) * 2 Or lMask
Next
ARGB = NewAlpha Or ((RGBColor And &HFF0000) \ &H10000) Or (RGBColor And &HFF00&) Or ((RGBColor And &HFF&) * &H10000)
End Function

'-----------ARGB转32位色。写法3--------------------
Private Function ARGB(ByVal Alpha As Byte,ByVal Blue As Byte) As Long
Dim A As String,R As String,G As String,B As String
If Len(Hex(Alpha)) < 2 Then A = 0 & Hex(Alpha) Else A = Hex(Alpha)
If Len(Hex(Red)) < 2 Then R = 0 & Hex(Red) Else R = Hex(Red)
If Len(Hex(Green)) < 2 Then G = 0 & Hex(Green) Else G = Hex(Green)
If Len(Hex(Blue)) < 2 Then B = 0 & Hex(Blue) Else B = Hex(Blue)
ARGB = "&H" & A & R & G & B
End Function

'取得任意颜色的反色
Public Function OppColor(ByVal Color As Long) As Long

Dim Red As Integer,Green As Integer,Blue As Integer
Red = Color And &HFF '拆分颜色
Green = (Color And 65280) \ 256
Blue = (Color And &HFF0000) \ 65536

Red = 255 - Red
Green = 255 - Green
Blue = 255 - Blue

If Red < 0 Then Red = 0
If Red > 255 Then Red = 255

If Green < 0 Then Green = 0
If Green > 255 Then Green = 255

If Blue < 0 Then Blue = 0 If Blue > 255 Then Blue = 255 OppColor = RGB(Red,Green,Blue) '得到反色 End Function