|
Wenn Sie HTML-Seiten oder Stylesheets (CSS) in einem Visual Basic-Programm bearbeiten wollen, werden Sie nicht umhinkommen, Farbangaben von der VB-/Windows-Welt in die HTML-/CSS-Welt (und gegebenenfalls zurück) konvertieren zu müssen. Die einfache Konvertierung eines VB-Farbwertes in einen hexadezimalen String reicht allerdings nicht. Zum einen sind in der HTML-/CSS-Welt die Position der R- und B-Anteile vertauscht. Zum anderen können auf der VB-Seite Systemfarben-Konstanten vorliegen, die nicht so ohne weiteres in HTML-/CSS-Farb-Strings (im Weiteren werde ich der Einfachheit halber nur noch von HTML-Farben sprechen) umgesetzt werden können. Schauen wir uns die vier möglichen Konvertierungen (RGB-Long zu HTML, RGB-Hex-String zu HTML, HMTL zu RGB-Long, HTML zu RGB-Hex-String) einmal näher an - zunächst die Konvertierung eines VB-Farbwerts in einen HTML-Farbstring.
Im einfachsten Fall würde die erwähnte simple Vertauschung der R- und B-Anteile eines in einen Hex-String umgesetzten Long-Farbwertes reichen. Zunächst wird der Hex-String auf 6 Stellen Länge mit führenden Nullen gebracht:
Dim nRGBHex As String
nRGBHex = Right$("000000" & Hex$(RGBColor), 6)
Anschließend erfolgt die Vertauschung der ersten und letzten Hex-Ziffernpaare:
HTMLColor = _
"#" & Right$(nRGBHex, 2) & Mid$(nRGBHex, 3, 2) & Left$(nRGBHex, 2)
Falls der Farbwert jedoch auch durch eine Systemfarben-Konstante angegeben sein kann, gibt es zwei mögliche Alternativen. Zum einen kann statt eines HTML-Hex-Strings auch in HTML ein Systemfarben-Name angegeben werden, der sich für fast alle Systemfarben-Konstanten direkt ermitteln lässt. Zum anderen kann die Systemfarbe zunächst in einen echten RGB-Farbwert und dann wie gehabt in eine HTML-Farbe umgesetzt werden.
Die folgende Funktion RGB2HTML berücksichtigt diese beiden Möglichkeiten. Sie gibt im Normalfall einen HTML-Hex-String mit führendem "#" zurück. Die Umsetzung einer Systemfarben-Konstante in einen HTML-Systemfarben-Namen erfolgt über die Hilfsfunktion SysColorToHTMLSysColor, wenn im optionalen Parameter SysColorStr der Wert True übergeben wird. Die gegebenenfalls notwendige Umsetzung einer Systemfarben-Konstante in einen RGB-Farbwert erfolgt über die API-Funktion OleTranslateColor (verpackt in die Hilfsfunktion OleConvertColor - mehr dazu können Sie im Artikel  "Systemfarben-Dolmetscher" nachlesen).
Declare Function OleTranslateColor Lib "oleaut32.dll" _
(ByVal lOleColor As Long, ByVal lHPalette As Long, _
ByRef lColorRef As Long) As Long
Public Function RGB2HTML(ByVal RGBColor As Long, _
Optional SysColorStr As Boolean) As String
Dim nRGBHex As String
Dim nSysColor As String
If SysColorStr Then
If (RGBColor And &H80000000) = &H80000001 Then
nSysColor = SysColorToHTMLSysColor(RGBColor)
If Len(nSysColor) Then
RGB2HTML = nSysColor
Exit Function
End If
End If
End If
nRGBHex = _
Right$("000000" & Hex$(OleConvertColor(RGBColor)), 6)
RGB2HTML = "#" & Right$(nRGBHex, 2) & Mid$(nRGBHex, 3, 2) _
& Left$(nRGBHex, 2)
End Function
Public Function OleConvertColor(ByVal Color As Long) As Long
Dim nColor As Long
OleTranslateColor Color, 0&, nColor
OleConvertColor = nColor
End Function
Public Function SysColorToHTMLSysColor( _
ByVal SysColor As Long) As String
Select Case SysColor
Case vbActiveBorder
SysColorToHTMLSysColor = "ActiveBorder"
Case vbActiveTitleBar
SysColorToHTMLSysColor = "ActiveCaption"
Case vbApplicationWorkspace
SysColorToHTMLSysColor = "AppWorkspace"
Case vbDesktop
SysColorToHTMLSysColor = "Background"
Case vbButtonFace
SysColorToHTMLSysColor = "ButtonFace"
Case vb3DHighlight
SysColorToHTMLSysColor = "ButtonHighlight"
Case vbButtonShadow
SysColorToHTMLSysColor = "ButtonShadow"
Case vbButtonText
SysColorToHTMLSysColor = "ButtonText"
Case vbActiveTitleBarText
SysColorToHTMLSysColor = "CaptionText"
Case vbGrayText
SysColorToHTMLSysColor = "GrayText"
Case vbHighlight
SysColorToHTMLSysColor = "Highlight"
Case vbHighlightText
SysColorToHTMLSysColor = "HighlightText"
Case vbInactiveBorder
SysColorToHTMLSysColor = "InactiveBorder"
Case vbInactiveTitleBar
SysColorToHTMLSysColor = "InactiveCaption"
Case vbInactiveCaptionText
SysColorToHTMLSysColor = "InactiveCaptionText"
Case vbInfoBackground
SysColorToHTMLSysColor = "InfoBackground"
Case vbInfoText
SysColorToHTMLSysColor = "InfoText"
Case vbMenuBar
SysColorToHTMLSysColor = "Menu"
Case vbMenuText
SysColorToHTMLSysColor = "MenuText"
Case vbScrollBars
SysColorToHTMLSysColor = "Scrollbar"
Case vb3DDKShadow
SysColorToHTMLSysColor = "ThreeDDarkShadow"
Case vb3DFace
SysColorToHTMLSysColor = "ThreeDFace"
Case vb3DHighlight
SysColorToHTMLSysColor = "ThreeDHighlight"
Case vb3DLight
SysColorToHTMLSysColor = "ThreeDLightShadow"
Case vb3DShadow
SysColorToHTMLSysColor = "ThreeDShadow"
Case vbWindowBackground
SysColorToHTMLSysColor = "Window"
Case vbWindowFrame
SysColorToHTMLSysColor = "WindowFrame"
Case vbWindowText
SysColorToHTMLSysColor = "WindowText"
End Select
End Function
Falls der VB-Farbwert nicht als Long-Wert, sondern als HexString vorliegen sollte, kommt die folgende Funktion RGBStr2HTML zum Zuge. Auch sie berücksichtigt wieder beide Möglichkeiten der Umsetzung von Systemfarben. Ihr kann der Hex-Wert sowohl ohne als auch mit führender VB-Hex-Kennung "&H" übergeben werden.
Public Function RGBStr2HTML(RGBColorStr As String, _
Optional SysColorStr As Boolean) As String
Dim nRGBColor As Long
Dim nRGBHex As String
Dim nSysColor As String
If Left$(RGBColorStr, 2) = "&H" Then
nRGBColor = Val(RGBColorStr)
Else
nRGBColor = Val("&H" & RGBColorStr)
End If
If SysColorStr Then
If (nRGBColor And &H80000000) = &H80000001 Then
nSysColor = SysColorToHTMLSysColor(nRGBColor)
If Len(nSysColor) Then
RGBStr2HTML = nSysColor
Exit Function
End If
End If
End If
nRGBHex = _
Right$("000000" & Hex$(OleConvertColor(nRGBColor)), 6)
RGBStr2HTML = "#" & Right$(nRGBHex, 2) & Mid$(nRGBHex, 3, 2) _
& Left$(nRGBHex, 2)
End Function
Bei der Umsetzung einer HTML-Farbe kommt die Möglichkeit hinzu, dass neben der Hex-Angabe und einem Namen für eine Systemfarbe auch noch einer der 16 direkten Farbnamen gegeben sein kann. Die Hilfsfunktion HTMLColorTextToColor versucht daher, einen nicht mit dem Hex-Kennzeichen "#" beginnenden HTML-Farbwert einem RGB-Farbwert oder einer Systemfarben-Konstante zuzuordnen. Gelingt dies nicht, gibt sie den Wert -1 zurück und es wird weiter von einem Hex-Wert ausgegangen. Bei der Umsetzung in einen VB-Hex-String (RGB-Farbe oder Systemfarben-Konstante) sind nach der Vertauschung der R- und B-Anteile gegebenenfalls führende Nullen zu entfernen und es ist die VB-Hex-Kennung "&H" voranzustellen.
Public Function HTML2RGBStr(HTMLColor As String) As String
Dim nRGBColorStr As String
Dim nRGBColor As Long
Dim i As Integer
If Left$(HTMLColor, 1) = "#" Then
nRGBColorStr = Right$(HTMLColor, 2) _
& Mid$(HTMLColor, 4, 2) & Mid$(HTMLColor, 2, 2)
Else
nRGBColor = HTMLColorTextToColor(HTMLColor)
If nRGBColor <> -1 Then
HTML2RGBStr = "&H" & Hex$(nRGBColor)
Exit Function
End If
nRGBColorStr = Right$(HTMLColor, 2) _
& Mid$(HTMLColor, 3, 2) & Left$(HTMLColor, 2)
End If
For i = 1 To Len(nRGBColorStr)
If Mid$(nRGBColorStr, i, 1) = "0" Then
Mid$(nRGBColorStr, i, 1) = " "
Else
Exit For
End If
Next 'i
If Len(nRGBColorStr) = 0 Then
HTML2RGBStr = "&H0"
Else
HTML2RGBStr = "&H" & LTrim$(nRGBColorStr)
End If
End Function
Public Function HTMLColorTextToColor( _
ByVal HTMLColorText As String) As Long
Select Case LCase$(HTMLColorText)
Case "aqua"
HTMLColorTextToColor = &HFFFF00
Case "black"
HTMLColorTextToColor = 0&
Case "blue"
HTMLColorTextToColor = &HFF0000
Case "fuchsia"
HTMLColorTextToColor = &HFF00FF
Case "gray"
HTMLColorTextToColor = &H808080
Case "green"
HTMLColorTextToColor = &H8000
Case "lime"
HTMLColorTextToColor = &HFF00
Case "maroon"
HTMLColorTextToColor = &H80
Case "navy"
HTMLColorTextToColor = &H800000
Case "olive"
HTMLColorTextToColor = &H8080
Case "purple"
HTMLColorTextToColor = &H800080
Case "red"
HTMLColorTextToColor = &HFF
Case "silver"
HTMLColorTextToColor = &HC0C0C0
Case "teal"
HTMLColorTextToColor = &H808000
Case "white"
HTMLColorTextToColor = &HFFFFFF
Case "yellow"
HTMLColorTextToColor = &HFFFF
Case "activeborder"
HTMLColorTextToColor = vbActiveBorder
Case "activecaption"
HTMLColorTextToColor = vbActiveTitleBar
Case "appworkspace"
HTMLColorTextToColor = vbApplicationWorkspace
Case "background"
HTMLColorTextToColor = vbDesktop
Case "buttonface"
HTMLColorTextToColor = vbButtonFace
Case "buttonhighlight"
HTMLColorTextToColor = vb3DHighlight
Case "buttonshadow"
HTMLColorTextToColor = vbButtonShadow
Case "buttontext"
HTMLColorTextToColor = vbButtonText
Case "captiontext"
HTMLColorTextToColor = vbActiveTitleBarText
Case "graytext"
HTMLColorTextToColor = vbGrayText
Case "highlight"
HTMLColorTextToColor = vbHighlight
Case "highlighttext"
HTMLColorTextToColor = vbHighlightText
Case "inactiveborder"
HTMLColorTextToColor = vbInactiveBorder
Case "inactivecaption"
HTMLColorTextToColor = vbInactiveTitleBar
Case "inactivecaptiontext"
HTMLColorTextToColor = vbInactiveCaptionText
Case "infobackground"
HTMLColorTextToColor = vbInfoBackground
Case "infotext"
HTMLColorTextToColor = vbInfoText
Case "menu"
HTMLColorTextToColor = vbMenuBar
Case "menutext"
HTMLColorTextToColor = vbMenuText
Case "scrollbar"
HTMLColorTextToColor = vbScrollBars
Case "threeddarkshadow"
HTMLColorTextToColor = vb3DDKShadow
Case "threedface"
HTMLColorTextToColor = vb3DFace
Case "threedhighlight"
HTMLColorTextToColor = vb3DHighlight
Case "threedlightshadow"
HTMLColorTextToColor = vb3DLight
Case "threedshadow"
HTMLColorTextToColor = vb3DShadow
Case "window"
HTMLColorTextToColor = vbWindowBackground
Case "windowframe"
HTMLColorTextToColor = vbWindowFrame
Case "windowtext"
HTMLColorTextToColor = vbWindowText
Case Else
HTMLColorTextToColor = -1
End Select
End Function
Genau so verfährt auch die letzte der Konvertierungsfunktionen HTML2RGB, die einen VB-Long-Wert zurückgibt - entweder als RGB-Farbwert oder als Systemfarben-Konstante.
Public Function HTML2RGB(HTMLColor As String) As Long
Dim nRGBColor As Long
If Left$(HTMLColor, 1) = "#" Then
HTML2RGB = Val("&H" & Right$(HTMLColor, 2) _
& Mid$(HTMLColor, 4, 2) & Mid$(HTMLColor, 2, 2))
Else
nRGBColor = HTMLColorTextToColor(HTMLColor)
If nRGBColor <> -1 Then
HTML2RGB = nRGBColor
Exit Function
End If
HTML2RGB = Val("&H" & Right$(HTMLColor, 2) _
& Mid$(HTMLColor, 3, 2) & Left$(HTMLColor, 2))
End If
End Function
|