7,762
社区成员
发帖
与我相关
我的任务
分享例子代码：颜色转换函数(VB->RGB/HTML/HEX)
◇仅供参考
◇Beta 1
Public Enum ColorType
ctLong = 1
ctRGB = 2
ctHTML = 3
ctHex = 4
ctUnknow = 99
End Enum
Public Function FormatColor(ByVal strColor As String, _
ByVal udeColorType As ColorType, _
ByRef vntColor As Variant) As Boolean
If LenB(strColor) <> 0 Then
Select Case udeColorType
Case ctLong
vntColor = CLng(Val(strColor))
Case ctRGB
vntColor = RGBColor(CLng(Val(strColor)))
Case ctHTML
vntColor = HTMLColor(CLng(Val(strColor)))
Case ctHex
vntColor = HexColor(CLng(Val(strColor)))
Case ctUnknow
Case Else
End Select
Else
vntColor = vbNullString
FormatColor = False
End If
End Function
Private Function GetRedColor(ByVal lngColor As Long) As Long
GetRedColor = (lngColor And &HFF&)
End Function
Private Function GetGreenColor(ByVal lngColor As Long) As Long
GetGreenColor = (lngColor And &HFF00&) / &H100
End Function
Private Function GetBlueColor(ByVal lngColor As Long) As Long
GetBlueColor = (lngColor And &HFF0000) / &H10000
End Function
Private Function RGBColor(ByVal lngColor As Long) As String
RGBColor = "RGB(" & CStr(GetRedColor(lngColor)) & "," _
& CStr(GetGreenColor(lngColor)) & "," _
& CStr(GetBlueColor(lngColor)) & ")"
End Function
Private Function HexColor(ByVal lngColor As Long) As String
Dim o_strHexColor As String
o_strHexColor = Hex(lngColor)
If Len(o_strHexColor) < 6 Then
o_strHexColor = String(6 - Len(o_strHexColor), "0") & o_strHexColor
Else
End If
HexColor = "&H" & o_strHexColor & "&"
End Function
Private Function HTMLColor(ByVal lngColor As Long) As String
Dim o_strHexColor As String
o_strHexColor = Hex(lngColor)
If Len(o_strHexColor) < 6 Then
o_strHexColor = String(6 - Len(o_strHexColor), "0") & o_strHexColor
Else
End If
HTMLColor = "#" & Right$(o_strHexColor, 2) & _
Mid$(o_strHexColor, 3, 2) & _
Left$(o_strHexColor, 2)
End Function
◇Beta 1
Public Enum ColorType
ctLong = 1
ctRGB = 2
ctHTML = 3
ctHex = 4
ctUnknow = 99
End Enum
Public Function FormatColor(ByVal strColor As String, _
ByVal udeColorType As ColorType, _
ByRef vntColor As Variant) As Boolean
If LenB(strColor) <> 0 Then
Select Case udeColorType
Case ctLong
vntColor = CLng(Val(strColor))
Case ctRGB
vntColor = RGBColor(CLng(Val(strColor)))
Case ctHTML
vntColor = HTMLColor(CLng(Val(strColor)))
Case ctHex
vntColor = HexColor(CLng(Val(strColor)))
Case ctUnknow
Case Else
End Select
Else
vntColor = vbNullString
FormatColor = False
End If
End Function
Private Function GetRedColor(ByVal lngColor As Long) As Long
GetRedColor = (lngColor And &HFF&)
End Function
Private Function GetGreenColor(ByVal lngColor As Long) As Long
GetGreenColor = (lngColor And &HFF00&) / &H100
End Function
Private Function GetBlueColor(ByVal lngColor As Long) As Long
GetBlueColor = (lngColor And &HFF0000) / &H10000
End Function
Private Function RGBColor(ByVal lngColor As Long) As String
RGBColor = "RGB(" & CStr(GetRedColor(lngColor)) & "," _
& CStr(GetGreenColor(lngColor)) & "," _
& CStr(GetBlueColor(lngColor)) & ")"
End Function
Private Function HexColor(ByVal lngColor As Long) As String
Dim o_strHexColor As String
o_strHexColor = Hex(lngColor)
If Len(o_strHexColor) < 6 Then
o_strHexColor = String(6 - Len(o_strHexColor), "0") & o_strHexColor
Else
End If
HexColor = "&H" & o_strHexColor & "&"
End Function
Private Function HTMLColor(ByVal lngColor As Long) As String
Dim o_strHexColor As String
o_strHexColor = Hex(lngColor)
If Len(o_strHexColor) < 6 Then
o_strHexColor = String(6 - Len(o_strHexColor), "0") & o_strHexColor
Else
End If
HTMLColor = "#" & Right$(o_strHexColor, 2) & _
Mid$(o_strHexColor, 3, 2) & _
Left$(o_strHexColor, 2)
End Function
...全文
请发表友善的回复…
发表回复
wgku 2002-04-02
- 打赏
- 举报
：）
xxlroad 2002-03-29
- 打赏
- 举报
好货
enmity 2002-03-29
- 打赏
- 举报
例子代码：颜色转换函数(RGB、HSB、CMYK、Lab)
http://www.csdn.net/expert/topic/608/608813.xml?temp=.475857
http://www.csdn.net/expert/topic/608/608813.xml?temp=.475857
enmity 2002-03-29
- 打赏
- 举报
to:zyl910(910：分儿，我来了！)
你好，这个代码也有，我今天晚上贴上来，因为我快要上班了，呵呵
你好，这个代码也有，我今天晚上贴上来，因为我快要上班了，呵呵
happybeyond 2002-03-29
- 打赏
- 举报
收藏！
zyl910 2002-03-29
- 打赏
- 举报
RGB、HSB、CMYK、Lab怎样相互转化？
water_j 2002-03-28
- 打赏
- 举报
好东东！收藏！
enmity 2002-03-28
- 打赏
- 举报
to:288794()
◇首先，我是为了以后使用方便，把它封装成类模块；
◇请把相同的功能实现，然后比较两者的代码量。
◇首先，我是为了以后使用方便，把它封装成类模块；
◇请把相同的功能实现，然后比较两者的代码量。
288794 2002-03-28
- 打赏
- 举报
很简单的吗！用得了这么多代码吗？
Mike_sun 2002-03-28
- 打赏
- 举报
兄弟，看看我的问题：
http://www.csdn.net/Expert/TopicView1.asp?id=604970
http://www.csdn.net/Expert/TopicView1.asp?id=604970
enmity 2002-03-28
- 打赏
- 举报
已经封装成类，请任意传播使用 :-)
网络咖啡 2002-03-28
- 打赏
- 举报
收藏
lihonggen0 2002-03-28
- 打赏
- 举报
good
shawls 2002-03-28
- 打赏
- 举报
继续收藏！
