Einfache Funktion für Hex2RGB?

[Delle]

Hallo,

kennt jemand vielleicht eine einfachere/kürzere Version als die untenstehende?

Code: Alles auswählen

Procedure.l _Hex2Dec(hex.s) 
    For r=1 To Len(hex.s) 
        d<<4 : a.s=Mid(hex.s,r,1) 
        If Asc(a.s)>60 
            d+Asc(a.s)-55 
        Else 
            d+Asc(a.s)-48 
        EndIf 
    Next 
    ProcedureReturn d 
EndProcedure 

Procedure.s _Hex2RGB(hex.s,ret.s) 
    hex.s = UCase(hex.s) 
    For i=1 To (6-Len(hex.s)) 
        hexa.s = hexa.s+"0" 
    Next 
    hex.s=hexa.s+hex.s 
    r.l = _Hex2Dec(Mid(hex.s,1,2)) 
    g.l = _Hex2Dec(Mid(hex.s,3,2)) 
    b.l = _Hex2Dec(Mid(hex.s,5,2)) 
    If UCase(ret.s) = "A" 
        ProcedureReturn Str(r.l)+","+Str(g.l)+","+Str(b.l) 
    ElseIf UCase(ret.s) = "R" 
        ProcedureReturn Str(r.l) 
    ElseIf UCase(ret.s) = "G" 
        ProcedureReturn Str(g.l) 
    ElseIf UCase(ret.s) = "B" 
        ProcedureReturn Str(b.l) 
    EndIf 
EndProcedure 
 

Color.s = "AACC77"
Debug Hex(170) + Hex(204) + Hex(119)
Debug _Hex2RGB(Color,"R")  ; red part
Debug _Hex2RGB(Color,"G")  ; green part
Debug _Hex2RGB(Color,"B")  ; blue part

[STARGÅTE]

_Hex2RGB(hex.s,ret.s)

kannst du dir doch sparen

wenn du den Dec von einem Hex hast, dann ist das doch schon die Farbe:
Dann kannst du doch mit den normalen PB Befhelen die Farbwerte auslesen.

Code: Alles auswählen

Procedure.l HexDec(Hex$) 
 l = Len(Hex$)-1
 For i = 0 To l
  Wert * 16
  Ascii = PeekB(@Hex$+i) 
  If Ascii > 60 
   Wert + (Ascii-55)
  Else 
   Wert + (Ascii-48) 
  EndIf 
 Next 
 ProcedureReturn Wert 
EndProcedure

Debug Red(HexDec("0080FF"))
Debug Green(HexDec("0080FF"))
Debug Blue(HexDec("0080FF"))

[hjbremer]

vielleicht so ?

Code: Alles auswählen

Procedure Hex2RGB(hexwert.s, rgb.s)

;Großschrift 
hexwert = UCase(hexwert): rgb = UCase(rgb)

;ist ein $ davor ?
If PeekC(@hexwert) = '$': hexwert = Mid(hexwert,2,99): EndIf

;auf Long bringen = 8 Bytes, sehr wichtig, denn $FF = $000000FF
wert.s = RSet(hexwert,8,"0")

If rgb = "R": ab = 6: EndIf 
If rgb = "G": ab = 4: EndIf
If rgb = "B": ab = 2: EndIf

x.c = PeekC(@wert+ab) ! 48    ;Bit 5+6 löschen
If x.c > 9: x.c - 103: EndIf ;A-F = Bit 7 gesetzt, geht so am einfachsten

y.c = PeekC(@wert+ab+1) ! 48
If y.c > 9: y.c - 103: EndIf

ProcedureReturn x.c * 16 + y.c

EndProcedure

Color.s = "AaCC77"  ;Achtung BGR
Debug Hex(170) + Hex(204) + Hex(119) 

Debug Hex2RGB(Color,"r")  ; red part 
Debug Hex2RGB(Color,"G")  ; green part 
Debug Hex2RGB(Color,"B")  ; blue part