'File source from Holyguard.net
'CONSTANTS
'------------------ Useful Colours ------------------
CONST sbRED = RGB(255,0,0)
CONST sbGREEN = RGB(0,255,0)
CONST sbBLUE = RGB(0,0,255)
CONST sbDARKRED = RGB(127,0,0)
CONST sbDARKGREEN = RGB(0,127,0)
CONST sbDARKBLUE = RGB(0,0,127)
CONST sbMAGENTA = RGB(255,0,255)
CONST sbYELLOW = RGB(255,255,0)
CONST sbCYAN = RGB(0,255,255)
CONST sbDARKMAGENTA = RGB(127,0,127)
CONST sbDARKYELLOW = RGB(127,127,0)
CONST sbDARKCYAN = RGB(0,127,127)
CONST sbWHITE = RGB(255,255,255)
CONST sbGRAY = RGB(127,127,127)
CONST sbBLACK = RGB(0,0,0)
'NEW TYPES
'------------------ SB_COLOR ------------------
TYPE SB_COLOR EXTENDS QOBJECT
Private:
'HSL Stuff
lit! AS SINGLE
sat! AS SINGLE
hue! AS SINGLE
v! AS SINGLE
y! AS SINGLE
x! AS SINGLE
z! AS SINGLE
'Hex stuff
bit AS LONG
Valuex AS INTEGER
HexV(2) AS STRING
wRR AS STRING
wGG AS STRING
wBB AS STRING
FUNCTION HexGet (Red AS INTEGER, Green AS INTEGER, Blue AS INTEGER) AS STRING
IF Red < 16 THEN
SB_COLOR.wRR = "0" + CONVBASE$(STR$(Red),10,16)
ELSE
SB_COLOR.wRR = CONVBASE$(STR$(Red),10,16)
END IF
IF Green < 16 THEN
SB_COLOR.wGG = "0" + CONVBASE$(STR$(Green),10,16)
ELSE
SB_COLOR.wGG = CONVBASE$(STR$(Green),10,16)
END IF
IF Blue < 16 THEN
SB_COLOR.wBB = "0" + CONVBASE$(STR$(Blue),10,16)
ELSE
SB_COLOR.wBB = CONVBASE$(STR$(Blue),10,16)
END IF
IF Red = 0 THEN wRR = "00"
IF Green = 0 THEN wGG = "00"
IF Blue = 0 THEN wBB = "00"
result = SB_COLOR.wRR + SB_COLOR.wGG + SB_COLOR.wBB
END FUNCTION
Count% AS INTEGER
Num% AS INTEGER
least! AS SINGLE
FUNCTIONI MAX (...) AS INTEGER
WITH SB_COLOR
.Count% = ParamValCount
.Num% = 1
.least! = ParamVal(.Num%)
DO
.Num% = .Num% + 1
IF ParamVal(.Num%) > .least! THEN
.least! = ParamVal(.Num%)
END IF
LOOP UNTIL .Num% = .Count%
result = .least!
END WITH
END FUNCTIONI
FUNCTIONI MIN (...) AS INTEGER
WITH SB_COLOR
.Count% = ParamValCount
.Num% = 1
.least! = ParamVal(.Num%)
DO
.Num% = .Num% + 1
IF ParamVal(.Num%) < .least! THEN
.least! = ParamVal(.Num%)
END IF
LOOP UNTIL .Num% = .Count%
result = .least!
END WITH
END FUNCTIONI
Public:
'RGB
Value AS LONG PROPERTY SET SetColor
Red AS BYTE PROPERTY SET SetRed
Green AS BYTE PROPERTY SET SetGreen
Blue AS BYTE PROPERTY SET SetBlue
Hex AS STRING PROPERTY SET SetHex
'CMYK
Cyan AS BYTE PROPERTY SET SetCyan
Magenta AS BYTE PROPERTY SET SetMagenta
Yellow AS BYTE PROPERTY SET SetYellow
Black AS BYTE PROPERTY SET SetBlack
'HLS
Hue AS INTEGER PROPERTY SET SetHue
Lightness AS BYTE PROPERTY SET SetLit
Saturation AS BYTE PROPERTY SET SetSat
Private:
red! AS SINGLE
green! AS SINGLE
blue! AS SINGLE
maximum! AS SINGLE
minimum! AS SINGLE
SUB RGBtoHSL : WITH SB_COLOR
.red! = .red / 255
.green! = .green / 255
.blue! = .blue / 255
.maximum! = .MAX(.red!,.green!,.blue!)
.minimum! = .MIN(.red!,.green!,.blue!)
.lit! = (.Maximum! + .Minimum!) / 2
IF .maximum! = .minimum! THEN
.sat! = 0
.hue! = 6
GOTO Finish
END IF
IF .Lit! < 0.5 THEN .Sat! = (.maximum! - .minimum!) / (.maximum! + .minimum!)
IF .Lit! >= 0.5 THEN .Sat! = (.maximum! - .minimum!) / (2.0 - .maximum! - .minimum!)
IF .red! = .maximum! THEN
.Hue! = (.green! - .blue!) / (.maximum! - .minimum!)
ELSEIF .green! = .maximum! THEN
.Hue! = 2.0 + (.blue! - .red!) / (.maximum! - .minimum!)
ELSEIF .blue! = .maximum! THEN
.Hue! = 4.0 + (.red! - .green!) / (.maximum! - .minimum!)
END IF
Finish:
.Hue! = .Hue! * 60
IF .Hue! < 0 THEN .Hue! = .Hue! + 360
.Saturation = ROUND(.Sat! * 100)
.Lightness = ROUND(.Lit! * 100)
.Hue = ROUND(.Hue!)
END WITH : END SUB
SUB HSLConvert : WITH SB_COLOR
.lit! = .lightness / 100
.sat! = .saturation / 100
.hue! = .hue / 360
IF .lit! <= 0.5 THEN
.v! = .lit! * (1.0 + .sat!)
ELSE
.v! = .lit! + .sat! - .lit! * .sat!
END IF
IF .v! = 0 THEN
.Red = 0
.Green = 0
.Blue = 0
EXIT SUB
END IF
IF .hue! = 1.0 THEN .hue! = 0.0
.hue! = .hue! * 6.0
.y! = 2.0 * .lit! - .v!
.x! = .y! + (.v! - .y!) * (.hue! - FLOOR(.hue!))
.z! = .v! - (.v! - .y!) * (.hue! - FLOOR(.hue!))
.x! = ROUND(.x! * 255)
.y! = ROUND(.y! * 255)
.z! = ROUND(.z! * 255)
.v! = ROUND(.v! * 255)
SELECT CASE FLOOR(.hue!)
CASE 0
.red = .v!
.green = .x!
.blue = .y!
CASE 1
.red = .z!
.green = .v!
.blue = .y!
CASE 2
.red = .y!
.green = .v!
.blue = .x!
CASE 3
.red = .y!
.green = .z!
.blue = .v!
CASE 4
.red = .x!
.green = .y!
.blue = .v!
CASE 5
.red = .v!
.green = .y!
.blue = .z!
CASE ELSE
.red = .v!
.green = .x!
.blue = .y!
END SELECT
END WITH : END SUB
Public:
SUB Websafe : WITH SB_COLOR
.Red = ROUND((.Red) / 51) * 51
.Green = ROUND((.Green) / 51) * 51
.Blue = ROUND((.Blue) / 51) * 51
END WITH : END SUB
PROPERTY SET SetColor (Col AS LONG)
WITH SB_COLOR
.Value = Col
.Red = Col \ 256 ^ 0 AND 255
.Green = Col \ 256 ^ 1 AND 255
.Blue = Col \ 256 ^ 2 AND 255
.Hex = .HexGet(.Red, .Green, .Blue)
.Cyan = 255 - .Red
.Magenta = 255 - .Green
.Yellow = 255 - .Blue
.Black = .MIN(.Cyan, .Magenta, .Yellow)
IF .Black <> 255 THEN
.cyan = ((.cyan - .black) / (255 - .black)) * 255
.magenta = ((.magenta - .black) / (255 - .black)) * 255
.yellow = ((.yellow - .black) / (255 - .black)) * 255
ELSE
.cyan = 255
.magenta = 255
.yellow = 255
END IF
.RGBtoHSL
END WITH
END PROPERTY
PROPERTY SET SetRed (Red AS BYTE)
WITH SB_COLOR
.Red = Red
'.Green = Col \ 256 ^ 1 AND 255
'.Blue = Col \ 256 ^ 2 AND 255
.Value = RGB(.Red, .Green, .Blue)
.Hex = .HexGet(.Red, .Green, .Blue)
.Cyan = 255 - .Red
.Magenta = 255 - .Green
.Yellow = 255 - .Blue
.Black = .MIN(.Cyan, .Magenta, .Yellow)
IF .Black <> 255 THEN
.cyan = ((.cyan - .black) / (255 - .black)) * 255
.magenta = ((.magenta - .black) / (255 - .black)) * 255
.yellow = ((.yellow - .black) / (255 - .black)) * 255
ELSE
.cyan = 255
.magenta = 255
.yellow = 255
END IF
.RGBtoHSL
END WITH
END PROPERTY
PROPERTY SET SetGreen (Green AS BYTE)
WITH SB_COLOR
'.Red = Col \ 256 ^ 0 AND 255
.Green = Green
'.Blue = Col \ 256 ^ 2 AND 255
.Value = RGB(.Red, .Green, .Blue)
.Hex = .HexGet(.Red, .Green, .Blue)
.Cyan = 255 - .Red
.Magenta = 255 - .Green
.Yellow = 255 - .Blue
.Black = .MIN(.Cyan, .Magenta, .Yellow)
IF .Black <> 255 THEN
.cyan = ((.cyan - .black) / (255 - .black)) * 255
.magenta = ((.magenta - .black) / (255 - .black)) * 255
.yellow = ((.yellow - .black) / (255 - .black)) * 255
ELSE
.cyan = 255
.magenta = 255
.yellow = 255
END IF
.RGBtoHSL
END WITH
END PROPERTY
PROPERTY SET SetBlue (Blue AS BYTE)
WITH SB_COLOR
'.Red = Col \ 256 ^ 0 AND 255
'.Green = Col \ 256 ^ 1 AND 255
.Blue = Blue
.Value = RGB(.Red, .Green, .Blue)
.Hex = .HexGet(.Red, .Green, .Blue)
.Cyan = 255 - .Red
.Magenta = 255 - .Green
.Yellow = 255 - .Blue
.Black = .MIN(.Cyan, .Magenta, .Yellow)
IF .Black <> 255 THEN
.cyan = ((.cyan - .black) / (255 - .black)) * 255
.magenta = ((.magenta - .black) / (255 - .black)) * 255
.yellow = ((.yellow - .black) / (255 - .black)) * 255
ELSE
.cyan = 255
.magenta = 255
.yellow = 255
END IF
.RGBtoHSL
END WITH
END PROPERTY
PROPERTY SET SetHex (HexStr AS STRING)
WITH SB_COLOR
HexStr = HexStr - "#" 'Don't want that
.HexV(0) = MID$(HexStr, 1, 2)
.HexV(1) = MID$(HexStr, 3, 2)
.HexV(2) = MID$(HexStr, 5, 2)
FOR X = 0 TO 2
.HexV(X) = REVERSE$(.HexV(X))
.bit = 1
.valuex = 0
FOR i = 1 TO LEN(.hexV(X))
SELECT CASE MID$(.hexV(X),i,1)
CASE "A"
.valuex = .valuex + (10 * .bit)
CASE "B"
.valuex = .valuex + (11 * .bit)
CASE "C"
.valuex = .valuex + (12 * .bit)
CASE "D"
.valuex = .valuex + (13 * .bit)
CASE "E"
.valuex = .valuex + (14 * .bit)
CASE "F"
.valuex = .valuex + (15 * .bit)
CASE ELSE
.valuex = .valuex + (VAL(MID$(.hexV(X), i, 1)) * .bit)
END SELECT
IF (.bit * 16) < 2147483647 THEN .bit = .bit * 16
NEXT i
SELECT CASE X
CASE 0
.Red = value
CASE 1
.Green = value
CASE 2
.Blue = value
END SELECT
NEXT X
.Value = RGB(.Red, .Green, .Blue)
.Hex = HexStr
.Cyan = 255 - .Red
.Magenta = 255 - .Green
.Yellow = 255 - .Blue
.Black = .MIN(.Cyan, .Magenta, .Yellow)
IF .Black <> 255 THEN
.cyan = ((.cyan - .black) / (255 - .black)) * 255
.magenta = ((.magenta - .black) / (255 - .black)) * 255
.yellow = ((.yellow - .black) / (255 - .black)) * 255
ELSE
.cyan = 255
.magenta = 255
.yellow = 255
END IF
.RGBtoHSL
END WITH
END PROPERTY
PROPERTY SET SetCyan (Cyan AS BYTE)
WITH SB_COLOR
.Cyan = Cyan
.red = 255 - .MIN(255,((.Cyan/255) * (255 - .black) + .black))
.green = 255 - .MIN(255,((.magenta/255) * (255 - .black) + .black))
.blue = 255 - .MIN(255,((.yellow/255) * (255 - .black) + .black))
.Value = RGB(.Red, .Green, .Blue)
.Hex = .HexGet(.Red, .Green, .Blue)
.RGBtoHSL
END WITH
END PROPERTY
PROPERTY SET SetMagenta (Magenta AS BYTE)
WITH SB_COLOR
.Magenta = Magenta
.red = 255 - .MIN(255,((.Cyan/255) * (255 - .black) + .black))
.green = 255 - .MIN(255,((.magenta/255) * (255 - .black) + .black))
.blue = 255 - .MIN(255,((.yellow/255) * (255 - .black) + .black))
.Value = RGB(.Red, .Green, .Blue)
.Hex = .HexGet(.Red, .Green, .Blue)
.RGBtoHSL
END WITH
END PROPERTY
PROPERTY SET SetYellow (Yellow AS BYTE)
WITH SB_COLOR
.Yellow = Yellow
.red = 255 - .MIN(255,((.Cyan/255) * (255 - .black) + .black))
.green = 255 - .MIN(255,((.magenta/255) * (255 - .black) + .black))
.blue = 255 - .MIN(255,((.yellow/255) * (255 - .black) + .black))
.Value = RGB(.Red, .Green, .Blue)
.Hex = .HexGet(.Red, .Green, .Blue)
.RGBtoHSL
END WITH
END PROPERTY
PROPERTY SET SetBlack (Black AS BYTE)
WITH SB_COLOR
.Black = Black
.red = 255 - .MIN(255,((.Cyan/255) * (255 - .black) + .black))
.green = 255 - .MIN(255,((.magenta/255) * (255 - .black) + .black))
.blue = 255 - .MIN(255,((.yellow/255) * (255 - .black) + .black))
.Value = RGB(.Red, .Green, .Blue)
.Hex = .HexGet(.Red, .Green, .Blue)
.RGBtoHSL
END WITH
END PROPERTY
PROPERTY SET SetHue (Hue AS INTEGER)
WITH SB_COLOR
.Hue = Hue
.HSLConvert
.Value = RGB(.Red, .Green, .Blue)
.Hex = .HexGet(.Red, .Green, .Blue)
.Cyan = 255 - .Red
.Magenta = 255 - .Green
.Yellow = 255 - .Blue
.Black = .MIN(.Cyan, .Magenta, .Yellow)
IF .Black <> 255 THEN
.cyan = ((.cyan - .black) / (255 - .black)) * 255
.magenta = ((.magenta - .black) / (255 - .black)) * 255
.yellow = ((.yellow - .black) / (255 - .black)) * 255
ELSE
.cyan = 255
.magenta = 255
.yellow = 255
END IF
END WITH
END PROPERTY
PROPERTY SET SetLit (Lit AS BYTE)
WITH SB_COLOR
.Lightness = Lit
.HSLConvert
.Value = RGB(.Red, .Green, .Blue)
.Hex = .HexGet(.Red, .Green, .Blue)
.Cyan = 255 - .Red
.Magenta = 255 - .Green
.Yellow = 255 - .Blue
.Black = .MIN(.Cyan, .Magenta, .Yellow)
IF .Black <> 255 THEN
.cyan = ((.cyan - .black) / (255 - .black)) * 255
.magenta = ((.magenta - .black) / (255 - .black)) * 255
.yellow = ((.yellow - .black) / (255 - .black)) * 255
ELSE
.cyan = 255
.magenta = 255
.yellow = 255
END IF
END WITH
END PROPERTY
PROPERTY SET SetSat (Sat AS BYTE)
WITH SB_COLOR
.Saturation = Sat
.HSLConvert
.Value = RGB(.Red, .Green, .Blue)
.Hex = .HexGet(.Red, .Green, .Blue)
.Cyan = 255 - .Red
.Magenta = 255 - .Green
.Yellow = 255 - .Blue
.Black = .MIN(.Cyan, .Magenta, .Yellow)
IF .Black <> 255 THEN
.cyan = ((.cyan - .black) / (255 - .black)) * 255
.magenta = ((.magenta - .black) / (255 - .black)) * 255
.yellow = ((.yellow - .black) / (255 - .black)) * 255
ELSE
.cyan = 255
.magenta = 255
.yellow = 255
END IF
END WITH
END PROPERTY
CONSTRUCTOR
Red = 0
Green = 0
Blue = 0
Cyan = 255
Magenta = 255
Yellow = 255
Value = 0
Hex = "000000"
Black = 255
Hue = 360
Saturation = 0
Lightness = 0
END CONSTRUCTOR
END TYPE