Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0456: HTML-Farbwerte in Long-Werte umrechnen und umgekehrt

VB 5/6-Tipp 0456: HTML-Farbwerte in Long-Werte umrechnen und umgekehrt

 von Benjamin Wilger

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory (CopyMemory), OleTranslateColor

Download: Download des Beispielprojektes [2,34 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Code von Benjamin Wilger
' Benjamin@ActiveVB.de
' Copyright (C) 2001
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" _
                    Alias "RtlMoveMemory" ( _
                    pDest As Any, _
                    pSrc As Any, _
                    ByVal ByteLen As Long)
                    
Private Declare Sub OleTranslateColor Lib "oleaut32.dll" ( _
                    ByVal clr As Long, _
                    ByVal hpal As Long, _
                    ByRef lpcolorref As Long)
                    
Private Sub Form_Load()

    Me.AutoRedraw = True
    Me.Print "Der HTML-Code von vbRed ist: " & Long2Hexcode(vbRed)
    Me.Print "Der HTML-Code von vbGreen ist: " & Long2Hexcode(vbGreen)
    Me.Print "Der HTML-Code von vbYellow ist: " & Long2Hexcode(vbYellow)
    Me.Print "Der HTML-Code von vbBlue ist: " & Long2Hexcode(vbBlue)
    Me.Print "Der HTML-Code von vbMagenta ist: " & Long2Hexcode(vbMagenta)
    Me.Print "Der HTML-Code von vbButtonFace ist: " & Long2Hexcode(vbButtonFace)
    Me.Print "-"
    Me.Print "Der Long-Wert von #FFCC00 ist: " & Hexcode2Long("#FFCC00")
    
End Sub

Private Function Hexcode2Long(Hexcode As String) As Long

    Dim R As Integer
    Dim G As Integer
    Dim B As Integer
    Dim T As String
    
    T = Replace(Hexcode, "#", "")
    R = Val("&H" & Mid(T, 1, 2))
    G = Val("&H" & Mid(T, 3, 2))
    B = Val("&H" & Mid(T, 5, 2))
    Hexcode2Long = RGB(R, G, B)
    
End Function

Private Function Long2Hexcode(RGBColor As Long) As String

    Dim Bytes(0 To 3) As Byte
    Dim R As String, G As String, B As String
    
    ' Ggf. eine Systemfarbe umwandeln.
    If RGBColor < 0 Then OleTranslateColor RGBColor, 0&, RGBColor
    
    ' Einfach den Farbwert in ein Byte-Array pusten,
    ' dann können ganz einfach deren Bestandteile ausgelesen werden.
    CopyMemory Bytes(0), RGBColor, 4
    Long2Hexcode = "#" & toHex(Bytes(0), 2) & toHex(Bytes(1), 2) & toHex(Bytes(2), 2)
    
End Function

' Gibt einen Hex-String mit führenden Nullen zurück.
Private Function toHex(ByVal Number As Long, ByVal NumLen As Integer, _
    Optional ByVal UpperCase As Boolean) As String
    
    Dim C As String
    
    C = Hex(Number)
    
    If Len(C) < NumLen Then
    
        C = String(NumLen - Len(C), "0") & C
        
    End If
    
    If Not UpperCase Then
    
        toHex = LCase(C)
        
    Else
    
        toHex = C
        
    End If
    
End Function


'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 5 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.