VB kleuren

Een paar VB-functies voor het omrekenen van kleuren. 

Ik garandeer niet dat zij 100% foutloos zijn. Niet voor professioneel gebruik.

 

Function myRGB(r, g, b)
‘ kleurt een cel van het spreadsheet met de kleur r,g, b

Dim clr As Long, src As Range, sht As String, f, v

If IsEmpty(r) Or IsEmpty(g) Or IsEmpty(b) Then
clr = vbWhite
Else
clr = RGB(r, g, b)
End If

Set src = Application.ThisCell
sht = src.Parent.Name

f = “Changeit(“”” & sht & “””,””” & _
src.Address(False, False) & “””,” & clr & “)”
src.Parent.Evaluate f
myRGB = “”
End Function

Sub ChangeIt(sht, C, clr As Long)
ThisWorkbook.Sheets(sht).Range(C).Interior.Color = clr
End Sub

Function Red(H, S, L) As Double
‘berekent R van RGB op basis van HSL. H in graden, S en L tussen 0 en 1
Dim C, x As Double
Dim C, x As Double
C = Cvalue(H, S, L)
x = Xvalue(H, S, L)
m = mValue(H, S, L)

 

Select Case H
Case 0 To 60
Red = (C + m) * 255
Case 60 To 120
Red = (x + m) * 255
Case 120 To 180
Red = m * 255
Case 180 To 240
Red = m * 255
Case 240 To 300
Red = (x + m) * 255
Case 300 To 360
Red = (C + m) * 255
End Select

End Function

Function Green(H, S, L) As Double
‘berekent G van RGB op basis van HSL. H in graden, S en L tussen 0 en 1
Dim C, x As Double
C = Cvalue(H, S, L)
x = Xvalue(H, S, L)
m = mValue(H, S, L)

Select Case H
Case 0 To 60
Green = (x + m) * 255
Case 60 To 120
Green = (C + m) * 255
Case 120 To 180
Green = (C + m) * 255
Case 180 To 240
Green = (x + m) * 255
Case 240 To 300
Green = m * 255
Case 300 To 360
Green = m * 255
End Select

End Function

 

Function Blue(H, S, L) As Double
‘berekent B van RGB op basis van HSL. H in graden, S en L tussen 0 en 1
Dim C, x As Double
C = Cvalue(H, S, L)
x = Xvalue(H, S, L)
m = mValue(H, S, L)

Select Case H
Case 0 To 60
Blue = m * 255
Case 60 To 120
Blue = m * 255
Case 120 To 180
Blue = (x + m) * 255
Case 180 To 240
Blue = (m + C) * 255
Case 240 To 300
Blue = (C + m) * 255
Case 300 To 360
Blue = (x + m) * 255
End Select

 

End Function

 

Function Xvalue(H, S, L) As Double
Dim C, x, m, hulp, hulp2, hulprest As Double

hulp = H / 60
hulp2 = Int(hulp / 2)
hulprest = hulp – 2 * hulp2
hulp = Abs(hulprest – 1)
Xvalue = Cvalue(H, S, L) * (1 – hulp)

 

End Function

Function Cvalue(H, S, L)
‘hulpfunctie voor Hue
Dim C, x, m As Double
C = (1 – Abs(2 * L – 1)) * S

Cvalue = C

End Function
Function mValue(H, S, L)
Dim C As Double
‘hulpfunctie voor Hue
C = Cvalue(H, S, L)
mValue = L – C / 2

End Function

Function Mod2(xx)
Dim hulp As Double
‘hulpfunctie voor Hue
hulp = xx / 2
Mod2 = hulp – Int(hulp)

End Function

Function Hue(r, g, b)
‘berekent H in graden voor gegeven RGB
Dim Mx, mn, C, H2 As Double

Mx = Maxi(r, g, b)
mn = Mini(r, g, b)
C = Mx – mn

Select Case Mx
Case r
H2 = restzes(((g – b) / C))
Case g
H2 = 2 + (b – r) / C
Case b
H2 = 4 + (r – g) / C
End Select
H2 = H2 * 60
If H2 < 0 Then H2 = H2 + 360
Hue = H2

End Function

Function Light(r, g, b)
‘berekent de lightness L voor gegeven RGB. L tussen 0 en 1
grootste = WorksheetFunction.Max(r, g, b)
kleinste = WorksheetFunction.Min(r, g, b)
Light = (grootste + kleinste) / 2
Light = Light / 255

 

End Function

Function Sat(r, g, b)
‘berekent de verzadiging S voor gegeven RGB. S tussen 0 en 1.

r2 = r / 255
g2 = g / 255
b2 = b / 255
grootste = WorksheetFunction.Max(r2, g2, b2)
kleinste = WorksheetFunction.Min(r2, g2, b2)
Delta = grootste – kleinste

If Delta = 0 Then Sat = 0
If Delta > 0 Then
L = Light(r, g, b)
hulp = 1 – Abs(2 * L – 1)
Sat = Delta / hulp
End If

End Function

Function restzes(y)
restzes = y – 6 * Int(y / 6)

End Function

Function Maxi(x, y, z)
‘berekent het maximum van drie waarden
Dim hulp As Double
hulp = x
If y > hulp Then hulp = y
If z > hulp Then hulp = z
Maxi = hulp

End Function

Function Mini(x, y, z)
‘berekent het minimum van drie waarden
Dim hulp As Double
hulp = x
If y < hulp Then hulp = y
If z < hulp Then hulp = z
Mini = hulp

End Function

Function hexValue(r, g, b) As String
‘berekent de hexadecimale string voor RGB
hexValue = hex2(r) + hex2(g) + hex2(b)
End Function

Function hex2(x)
Dim hulp As String

hulp = Hex(x)
If Len(hulp) = 1 Then hulp = “0” + hulp
hex2 = hulp

 

End Function

Function RvanHEX(hvalue As String) As Integer
‘haalt de R uit de hexidecimale string
Dim hulp As String
Dim i As Integer
hulp = “&H” + Mid(hvalue, 1, 2)
RvanHEX = hulp

End Function

Function GvanHEX(hvalue As String) As Integer
‘haalt de G uit de hexidecimale string
Dim hulp As String
Dim i As Integer
hulp = “&H” + Mid(hvalue, 3, 2)
GvanHEX = hulp

End Function

Function BvanHEX(hvalue As String) As Integer
‘haalt de B uit de hexidecimale string
Dim hulp As String
Dim i As Integer
hulp = “&H” + Mid(hvalue, 5, 2)
BvanHEX = hulp

End Function

 

Function RGBfromRYB(hvalue As String) As String
Dim r, g, b, r2, y2, b2, ratio As Double
Dim hulp As String

‘deze functie rekent uitsluitend voor verzadigde RYB-kleuren (minstens één van RYB = 0 en minstens één van RYB = 255)
‘input is de hexadecimale string voor de RYB-kleur
‘outpunt is de hexadecimale string voor de RGB-kleur

r2 = RvanHEX(hvalue)
y2 = GvanHEX(hvalue)
b2 = BvanHEX(hvalue)
hulp = “niets gevonden”

If r2 = 255 Then
‘ gebied 1
If y2 >= 0 And b2 = 0 Then
r = 255
g = (255 / (255 + y2)) * y2
b = 0
hulp = hexValue(r, g, b)
End If
If y2 = 0 And b2 > 0 Then
r = r2
g = 0
b = b2
hulp = hexValue(r, g, b)
End If

End If

If y2 = 255 Then
‘gebied 2
If r2 >= 0 And b2 = 0 Then
r = 255
g = 255 + r2
ratio = 255 / g
g = ratio * r
r = 255

hulp = hexValue(r, g, b)
‘gebied 3

End If
If r2 = 0 And b2 > 0 Then
r = 255 – b2
g = 255
b = 0
hulp = hexValue(r, g, b)

End If
End If

If b2 = 255 Then
‘gebied 6
If r2 >= 0 And y2 = 0 Then
r = r2
g = 0
b = b2
hulp = hexValue(r, g, b)
End If

‘gebied 5
If r2 = 0 And y2 > 0 Then
If y2 <= 128 Then

ratio = 255 / (255 – y2)
‘If ratio > 2 Then ratio = 2
b = 255
g = y2 * ratio
‘omdat 128 niet precies de helft van 255 soms correctie nodig
If g > 255 Then g = 255
hulp = hexValue(r, g, b)
End If
If y2 > 128 Then
‘gebied 4
ratio = 255 / y2

g = 255
b = ratio * (255 – y2)
r = 0

hulp = hexValue(r, g, b)
End If
End If
End If

RGBfromRYB = hulp

End Function

 

Function RYBfromRGB(hvalue As String) As String
Dim r, y, b, r2, g2, b2, ratio As Double
Dim hulp As String

‘deze functie rekent uitsluitend voor verzadigde RGB-kleuren (minstens één van RGB = 0 en minstens één van RGB = 255
‘input is de hexadecimale string voor de RGB-kleur
‘outpunt is de hexadecimale string voor de RYB-kleur
‘voor onverzadigde kleuren met willekeurige lichtheid moet de functie RYB_RGB_all worden gebruikt

r2 = RvanHEX(hvalue)
g2 = GvanHEX(hvalue)
b2 = BvanHEX(hvalue)
hulp = “niets gevonden”
‘ gebied 1
If r2 = 255 And g2 <= 128 And b2 = 0 Then
v = g2 * (255 / (255 – g2))
r = 255
y = v
b = 0
hulp = hexValue(r, y, b)
‘hulp = hexValue(r2, g2, b2)
‘hulp = “gebied1”
End If
‘gebied 2
If r2 = 255 And g2 >= 128 And b2 = 0 Then

v = 255 * (255 – g2) / g2
r = v
y = 255
b = 0
hulp = hexValue(r, y, b)
‘hulp = “gebied 2”
‘hulp = v

End If
‘gebied 3
If g2 = 255 And b2 = 0 Then
v = 255 – r2
r = 0
y = 255
b = v

hulp = hexValue(r, y, b)
‘hulp = “gebied 3”

End If
‘gebied 4
If r2 = 0 And g2 = 255 And b2 > 0 Then

r = 0
y = 255 * (255 / (255 + b2))
b = 255

‘hulp = v
‘hulp = “GEBIED 4”
hulp = hexValue(r, y, b)

End If

‘gebied 5
If r2 = 0 And b2 = 255 And g2 > 0 Then

r = 0
y = 255 * (g2 / (255 + g2))
b = 255

‘hulp = “GEBIED 5”
hulp = hexValue(r, y, b)

End If

‘gebied REST
If g2 = 0 Then
r = r2
y = 0
b = b2

hulp = hexValue(r, y, b)
End If

 

RYBfromRGB = hulp

End Function

Function Hryb(H As Double) As Double
‘deze functie berekent uit de H-waarde in het RGB-systeem de H-waaarde in het RYB-systeem
Dim RGB As String
Dim RYB As String
r = Red(H, 1, 0.5)
g = Green(H, 1, 0.5)
b = Blue(H, 1, 0.5)
RGB = hexValue(r, g, b)
RYB = RYBfromRGB(RGB)
r = RvanHEX(RYB)
y = GvanHEX(RYB)
b = BvanHEX(RYB)
Hryb = Hue(r, y, b)

End Function

Function RYB_RGB_all(hvalue As String) As String
‘getest 18-3-2025
‘deze funcite rekent een RGB kleur om naar een RYB kleur via de H-waarde van de RGB-kleur.
‘eerst wordt de H voor RGB berekend en omgezet in een H-waarde in het RYB-systeem
‘de S en L waarden van de RGB kleur worden weer toegepast op de RYB kleur

Dim KleurRGB, KleurRYB, S, L, hulp As Double
r = RvanHEX(hvalue)
g = GvanHEX(hvalue)
b = BvanHEX(hvalue)

‘Omzetten in HSL voor RGB
KleurRGB = Hue(r, g, b)
S = Sat(r, g, b)
L = Light(r, g, b)

‘de kleur in de RYB-cirkel
hulp = KleurRGB
KleurRYB = Hryb(hulp)
‘de samenstellende kleuren R, Y en B berekenen met ongewijzigde verzadiging en lichtheid
r2 = Red(KleurRYB, S, L)
y2 = Green(KleurRYB, S, L)
b2 = Blue(KleurRYB, S, L)

RYB_RGB_all = hexValue(r2, y2, b2)

 

End Function