Converts RGB color to / from HTML format
As bonus, functions RGB_ExtractColor and HTML_ExtractColor to extract certain color from RGB or HTML format, in addition HTMLColor to combine Red, green and blue into HTML color format
Public Const RedPart = 0
Public Const GreenPart = 1
Public Const BluePart = 2
Public Function RGB2HTML(RGBCol As Long) As String
RGB2HTML = HTMLColor(RGB_ExtractColor(RGBCol, RedPart), RGB_ExtractColor(RGBCol, GreenPart), RGB_ExtractColor(RGBCol, BluePart))
End Function
Public Function HTML2RGB(HTMLCol) As Long
HTML2RGB = RGB(HTML_ExtractColor(HTMLCol, RedPart), HTML_ExtractColor(HTMLCol, GreenPart), HTML_ExtractColor(HTMLCol, BluePart))
End Function
Public Function HTMLColor(Red As Integer, Green As Integer, Blue As Integer) As String
HTMLColor = ""
If Len(Hex$(Red)) = 1 Then
HTMLColor = HTMLColor & "0" & Hex$(Red)
Else
HTMLColor = HTMLColor & Hex$(Red)
End If
If Len(Hex$(Green)) = 1 Then
HTMLColor = HTMLColor & "0" & Hex$(Green)
Else
HTMLColor = HTMLColor & Hex$(Green)
End If
If Len(Hex$(Blue)) = 1 Then
HTMLColor = HTMLColor & "0" & Hex$(Blue)
Else
HTMLColor = HTMLColor & Hex$(Blue)
End If
End Function
Public Function RGB_ExtractColor(RGBCol As Long, Part As Integer) As Integer
'Part: 0=Red, 1=Green, 2=Blue
Select Case Part
Case 0
RGB_ExtractColor = RGBCol And &HFF
' mask 000000000000000011111111 and shift bits right
Case 1
RGB_ExtractColor = (RGBCol And &HFF00) / &HFF
' mask 000000001111111100000000 and shift bits right
Case 2
RGB_ExtractColor = (RGBCol And &HFF0000) / &HFFFF
' mask 111111110000000000000000 and shift bits right
End Select
End Function
Public Function HTML_ExtractColor(HTMLCol, Part As Integer) As Integer
' Part: 0=Red, 1=Green, 2=Blue
Select Case Part
Case 0
HTML_ExtractColor = (CLng("&H" & HTMLCol) And &HFF0000) / &HFFFF
' mask 111111110000000000000000 and shift bits right
Case 1
HTML_ExtractColor = (CLng("&H" & HTMLCol) And &HFF00) / &HFF
' mask 000000001111111100000000 and shift bits right
Case 2
HTML_ExtractColor = CLng("&H" & HTMLCol) And &HFF
' mask 000000000000000011111111 and shift bits right
End Select
End Function
Public Const GreenPart = 1
Public Const BluePart = 2
Public Function RGB2HTML(RGBCol As Long) As String
RGB2HTML = HTMLColor(RGB_ExtractColor(RGBCol, RedPart), RGB_ExtractColor(RGBCol, GreenPart), RGB_ExtractColor(RGBCol, BluePart))
End Function
Public Function HTML2RGB(HTMLCol) As Long
HTML2RGB = RGB(HTML_ExtractColor(HTMLCol, RedPart), HTML_ExtractColor(HTMLCol, GreenPart), HTML_ExtractColor(HTMLCol, BluePart))
End Function
Public Function HTMLColor(Red As Integer, Green As Integer, Blue As Integer) As String
HTMLColor = ""
If Len(Hex$(Red)) = 1 Then
HTMLColor = HTMLColor & "0" & Hex$(Red)
Else
HTMLColor = HTMLColor & Hex$(Red)
End If
If Len(Hex$(Green)) = 1 Then
HTMLColor = HTMLColor & "0" & Hex$(Green)
Else
HTMLColor = HTMLColor & Hex$(Green)
End If
If Len(Hex$(Blue)) = 1 Then
HTMLColor = HTMLColor & "0" & Hex$(Blue)
Else
HTMLColor = HTMLColor & Hex$(Blue)
End If
End Function
Public Function RGB_ExtractColor(RGBCol As Long, Part As Integer) As Integer
'Part: 0=Red, 1=Green, 2=Blue
Select Case Part
Case 0
RGB_ExtractColor = RGBCol And &HFF
' mask 000000000000000011111111 and shift bits right
Case 1
RGB_ExtractColor = (RGBCol And &HFF00) / &HFF
' mask 000000001111111100000000 and shift bits right
Case 2
RGB_ExtractColor = (RGBCol And &HFF0000) / &HFFFF
' mask 111111110000000000000000 and shift bits right
End Select
End Function
Public Function HTML_ExtractColor(HTMLCol, Part As Integer) As Integer
' Part: 0=Red, 1=Green, 2=Blue
Select Case Part
Case 0
HTML_ExtractColor = (CLng("&H" & HTMLCol) And &HFF0000) / &HFFFF
' mask 111111110000000000000000 and shift bits right
Case 1
HTML_ExtractColor = (CLng("&H" & HTMLCol) And &HFF00) / &HFF
' mask 000000001111111100000000 and shift bits right
Case 2
HTML_ExtractColor = CLng("&H" & HTMLCol) And &HFF
' mask 000000000000000011111111 and shift bits right
End Select
End Function
HTMLCol
Or
RGBCol
Or
Red, Green, Blue
Or
RGBCol, Part
Or
HTMLCol, Part
Or
RGBCol
Or
Red, Green, Blue
Or
RGBCol, Part
Or
HTMLCol, Part
Views 4,649
Downloads 1,397
CodeID
DB ID
ANmarAmdeen
602
Revisions
v1.0
Monday
July
9
2018