Ну раз уж такая пьянка пошла...
SuperStrict
Module api.color
ModuleInfo "Version: 1.3"
ModuleInfo "Author: Albert G."
ModuleInfo "License: LGPL"
ModuleInfo "Copyright: Dynamic bytes"
ModuleInfo "Modserver: API"
ModuleInfo "History: 1.3 Release"
ModuleInfo "History: Added TColor component"
ModuleInfo "History: 1.2 Release"
ModuleInfo "History: Added Hex2RGB()"
ModuleInfo "History: 1.1 Release"
ModuleInfo "History: Added RGB2HSB()"
ModuleInfo "History: Added HSB2RGB()"
ModuleInfo "History: 1.0 Release"
ModuleInfo "History: Initial release"
Import brl.math
Private
Function Hex:String(val:Int)
Local buf:Short[8]
For Local k:Int = 7 To 0 Step - 1
Local n:Int = (val & 15) + Asc("0")
If n > Asc("9") n = n + (Asc("A") - Asc("9") - 1)
buf[k] = n
val:Shr 4
Next
Return String.FromShorts(buf, 8)
End Function
Function GetValue:Int(v:String, no:Int)
Select v
Case "A" Return 10
Case "B" Return 11
Case "C" Return 12
Case "D" Return 13
Case "E" Return 14
Case "F" Return 15
Default Return no
End Select
End Function
Public
Type TRGB
Field r:Byte
Field g:Byte
Field b:Byte
End Type
Type TARGB Extends TRGB
End Type
Type THSB Extends TRGB
End Type
rem
Type THSB
Field h:Float = 0.0
Field s:Float = 0.0
Field b:Float = 0.0
Method SetRGB(RGB:TRGB)
Local hsb:THSB = RGB.GetHSB()
h = hsb.h
s = hsb.s
b = hsb.b
End Method
Method GetRGB:TRGB()
Local RGB:TRGB = New TRGB
RGB.SetHSB(Self)
Return RGB
End Method
Method SetInt(value:Int)
Local RGB:TRGB = New TRGB
RGB.SetInt(value)
Local hsb:THSB = RGB.GetHSB()
h = hsb.h
s = hsb.s
b = hsb.b
End Method
Method GetInt:Int()
Local RGB:TRGB = New TRGB
RGB.SetHSB(Self)
Return RGB.GetInt()
End Method
Method SetHex(value:String)
Local RGB:TRGB = New TRGB
RGB.SetHex(value)
Local hsb:THSB = RGB.GetHSB()
h = hsb.h
s = hsb.s
b = hsb.b
End Method
Method GetHex:String()
Local RGB:TRGB = New TRGB
RGB.SetHSB(Self)
Return RGB.GetHex()
End Method
End Type
Type TRGB
Field r:Byte = 255
Field g:Byte = 255
Field b:Byte = 255
Method SetInt(value:Int)
r = (value Shr 16) & $FF
g = (value Shr 8) & $FF
b = value & $FF
End Method
Method GetInt:Int()
Return Int Ptr(Varptr r)[0]
End Method
Method SetHex(value:String)
value = value.ToUpper()
If value.Length < 8 Then value = "00" + value
If value.Length < 8 Then Return
Local v1:String, v1no:Int, v2:String, v2no:Int
v1 = value[3..4]
v1no = GetValue(v1, Int(v1))
v2 = value[2..3]
v2no = GetValue(v2, Int(v2)) * 16
r = v2no + v1no
v1 = value[5..6]
v1no = GetValue(v1, Int(v1))
v2 = value[4..5]
v2no = GetValue(v2, Int(v2)) * 16
g = v2no + v1no
v1 = value[7..]
v1no = GetValue(v1, Int(v1))
v2 = value[6..7]
v2no = GetValue(v2, Int(v2)) * 16
b = v2no + v1no
End Method
Method GetHex:String()
Return Hex(GetInt())
End Method
Method SetHSB(hsb:THSB)
Local i:Float, f:Float, p:Float, q:Float, t:Float, r_:Float, g_:Float, b_:Float
If hsb.s = 0.0
r_ = hsb.b * 255.0
g_ = r_
b_ = g_
Else
Local hue:Float = hsb.h / 60.0
i = Floor(hue)
f = hue - i
p = hsb.b * (1.0 - hsb.s)
q = hsb.b * (1.0 - hsb.s * f)
t = hsb.b * (1.0 - hsb.s * (1.0 - f))
Select i
Case 0
r_ = hsb.b
g_ = t
b_ = p
Case 1
r_ = q
g_ = hsb.b
b_ = p
Case 2
r_ = p
g_ = hsb.b
b_ = t
Case 3
r_ = p
g_ = hsb.b
b_ = q
Case 4
r_ = t
g_ = hsb.b
b_ = p
Default
r_ = hsb.b
g_ = p
b_ = q
End Select
r_:*255.0
g_:*255.0
b_:*255.0
End If
r = Max(Min(r_, 0.0), 255.0)
g = Max(Min(g_, 0.0), 255.0)
b = Max(Min(b_, 0.0), 255.0)
End Method
Method GetHSB:THSB()
Local hsb:THSB = New THSB
Local m_min:Byte = Min(Min(r, g), b)
Local m_max:Byte = Max(Max(r, g), b)
Local delta:Byte = m_max - m_min
If m_max <> 0
hsb.s = Float(delta) / Float(m_max)
hsb.b = Float(m_max) / 255.0
If delta <> 0
If r = m_max
hsb.h = Float(g - b) / Float(delta)
ElseIf g = m_max
hsb.h = 2 + (Float(b - r) / Float(delta))
Else
hsb.h = 4 + (Float(r - g) / Float(delta))
EndIf
hsb.h:*60.0
If hsb.h < 0.0 Then hsb.h:+360.0
Return hsb
End If
End If
End Method
End Type
Type TARGB Extends TRGB
Field a:Byte = 255
Method SetInt(value:Int)
a = (value Shr 24) & $FF
Super.SetInt(value)
End Method
Method SetHex(value:String)
value = value.ToUpper()
If value.Length < 8 Then Return
Local a1:String = value[1..2]
Local a1no:Int = GetValue(a1, Int(a1))
Local a2:String = value[..1]
Local a2no:Int = GetValue(a2, Int(a2)) * 16
a = a2no + a1no
Super.SetHex(value)
End Method
End Type