-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathhsb.bm
48 lines (46 loc) · 1.88 KB
/
hsb.bm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
$If HSB = UNDEFINED Then
$Let HSB = DEFINED
Function hsb~& (huein As Integer, satin As Integer, brightin As Integer)
Dim hue, sat, bright
Dim redout, greenout, blueout
Dim hueprimary, huesecondary
Dim satprimary, satsecondary, sattertiary
hue = huein Mod 360
If hue < 0 Then hue = hue + 360
sat = satin / 100
bright = brightin / 100
If sat > 1 Then s = 1
If bright > 1 Then b = 1
If bright <= 0 Then hsb = _RGB(0, 0, 0): Exit Function
If sat <= 0 Then hsb = _RGB(b * 255, b * 255, b * 255): Exit Function
If (hue >= 0) And (hue < 120) Then
hueprimary = 1 - (hue / 120)
huesecondary = hue / 120
satprimary = (1 - hueprimary) * (1 - sat)
satsecondary = (1 - huesecondary) * (1 - sat)
sattertiary = 1 - sat
redout = (bright * 255) * (hueprimary + satprimary)
greenout = (bright * 255) * (huesecondary + satsecondary)
blueout = (bright * 255) * sattertiary
ElseIf (hue >= 120) And (hue < 240) Then
hueprimary = 1 - ((hue - 120) / 120)
huesecondary = (hue - 120) / 120
satprimary = (1 - hueprimary) * (1 - sat)
satsecondary = (1 - huesecondary) * (1 - sat)
sattertiary = 1 - sat
redout = (bright * 255) * sattertiary
greenout = (bright * 255) * (hueprimary + satprimary)
blueout = (bright * 255) * (huesecondary + satsecondary)
ElseIf (hue >= 240) And (hue <= 360) Then
hueprimary = 1 - ((hue - 240) / 120)
huesecondary = (hue - 240) / 120
satprimary = (1 - hueprimary) * (1 - sat)
satsecondary = (1 - huesecondary) * (1 - sat)
sattertiary = 1 - sat
redout = (bright * 255) * (huesecondary + satsecondary)
greenout = (bright * 255) * sattertiary
blueout = (bright * 255) * (hueprimary + satprimary)
End If
hsb = _RGB(redout, greenout, blueout)
End Function
$End If