this is an attempt to simplify the *workings* with Color (24/32 bit) especially, with what I call:
Color-Channels (the separate UBytes contained in a ULong = *aarrggbb* in HEX).
The range of: 0 to 255 (UByte range) seems to be confusing to some. Mainly to find the correct
math. to go with it (from within: e.g. a loop or similar). This then may go as far, as a program-
crash (worst case scenario) or simply, not work *as expected*.
The idea behind it is really simple:
- reduce the range to: 0 to 100 (percent, being familiar to all)
- put a range check into all the setters (crash prevention!)
- making it as fast as possible (more detail on that below)
- compatible with all of FBC 32/64, independent of OS used
- on multiple set/get and *programmable* single set/get a Union is used
- to get the math. out of Sub's/Function's: *LUT's are used
- on single channel set/get as well as GBR_RGB, Pointer access used
Let's start with the include file (aka: .bi):
Code: Select all
' ColorLUTbyPercent.bi -- 2017-04-30, by MrSwiss
' last update: 2017-04-30 changed: nothing yet
#Ifndef __ColorLUTbyPercent__
#Define __ColorLUTbyPercent__
' FB to WIN: red/blue swap / WIN to FB blue/red swap, works both ways!
Declare Function BGR_RGB ( ByVal As ULong ) As ULong ' for 24/32bit color only!
' multi channel: setters/getters ... using Union access
Declare Function PSetRGB ( ByVal As UByte = 0, ByVal As UByte = 0, ByVal As UByte = 0 ) As ULong
Declare Sub PGetRGB ( ByVal As ULong, ByRef As UByte = 0, ByRef As UByte = 0, ByRef As UByte = 0 )
Declare Function PSetARGB ( ByVal As UByte = 0, ByVal As UByte = 0, ByVal As UByte = 0, ByVal As UByte = 0 ) As ULong
Declare Sub PGetARGB ( ByVal As ULong, ByRef As UByte = 0, ByRef As UByte = 0, ByRef As UByte = 0, ByRef As UByte = 0 )
' single channel setter ... using Union access (any one channel)
Declare Function PSet_Chan ( ByVal As ULong, ByVal As UByte, ByRef As String ) As ULong
' single channel getter ... using Union access (any one channel)
Declare Function PGet_Chan ( ByVal As ULong, ByRef As String ) As UByte
' all remaining: single channel getters/setters ... using Ptr access
Declare Function PSet_A ( ByVal As ULong, ByVal As UByte ) As ULong
Declare Function PSet_R ( ByVal As ULong, ByVal As UByte ) As ULong
Declare Function PSet_G ( ByVal As ULong, ByVal As UByte ) As ULong
Declare Function PSet_B ( ByVal As ULong, ByVal As UByte ) As ULong
Declare Function PGet_A ( ByVal As ULong ) As UByte
Declare Function PGet_R ( ByVal As ULong ) As UByte
Declare Function PGet_G ( ByVal As ULong ) As UByte
Declare Function PGet_B ( ByVal As ULong ) As UByte
#Ifdef __FB_64BIT__
#Inclib "ColorLUTbyPercent64"
#Else
#Inclib "ColorLUTbyPercent32"
#EndIf ' __FB_64BIT__
#EndIf ' __ColorLUTbyPercent__Code: Select all
' ColorLUTbyPercent32.bas -- 2017-04-21, by MrSwiss
' last update: 2017-04-30 changed: nothing yet ...
Union colour ' BE since, AE: Color is a FB-keyword
As ULong clr ' UINT(32), fixed size, 4 x UByte
Type ' we are on 'little endian' CPU's (Intel/AMD etc.)
As UByte b ' LSB - blue channel (= CPtr(UByte Ptr, ULong Ptr)[0]) ' only if ptr exists, else: use below method
As UByte g ' green channel (= CPtr(UByte Ptr, @ULong)[1]) ' no defined Ptr needed here (address of variable)
As UByte r ' red channel (= CPtr(UByte Ptr, @ULong)[2]) ' more often used (than 'Long Ptr' method)
As UByte a ' MSB - alpha channel (= CPtr(UByte Ptr, @ULong)[3])
End Type
End Union
' GLOBAL fixed size arrays used here, to be accessible from all code
Dim Shared As UByte PCCA(100), RCCA(255)' pre computed LUT's [L]ook-[U]p-[T]able
' converts from: percent channel val, to: real channel val
For i As UInteger = 0 To 100
PCCA(i) = CUByte(i * 2.55) ' init LUT1 with values (once only)
Next
' converts from: real channel val, to: percent channel val
For i As UInteger = 0 To 255
RCCA(i) = CUByte(i / 2.55) ' init LUT2 with values (once only)
Next
' multi channel getters/setters
Function BGR_RGB( ByVal clr As ULong ) As ULong ' for 24/32bit color only!
' FB to WIN: red/blue swap / WIN to FB blue/red swap, works both ways!
Swap CPtr(UByte Ptr, @clr)[0], CPtr(UByte Ptr, @clr)[2]
Return clr
End Function
Function PSetRGB( ByVal rpc As UByte = 0, _ ' red chan. (in percent)
ByVal gpc As UByte = 0, _ ' green chan. (as above)
ByVal bpc As UByte = 0 _ ' blue chan. (as above)
) As ULong ' return: color(32bit)
' param. range check: 0..100% (all else => QUIT proc.)
If rpc > 100 OrElse gpc > 100 OrElse bpc > 100 Then Exit Function
Static As colour ret ' using the Union
With ret
.r = PCCA(rpc) ' set red using LUT
.g = PCCA(gpc) ' set green
.b = PCCA(bpc) ' set blue
End With
Return ret.clr
End Function
Sub PGetRGB( ByVal clr As ULong, _ ' param. mandatory: color
ByRef rpc As UByte = 0, _ ' return: red chan. (in percent)
ByRef gpc As UByte = 0, _ ' return: green chan.
ByRef bpc As UByte = 0 ) ' return: blue chan.
Static As colour ret
With ret
.clr = clr ' load current color (all channels)
rpc = RCCA(.r) ' get red using LUT
gpc = RCCA(.g) ' get green ...
bpc = RCCA(.b) ' get blue
End With
End Sub
Function PSetARGB( ByVal apc As UByte = 0, _ ' alpha chan. (in percent)
ByVal rpc As UByte = 0, _ ' all else: as PSetRGB()
ByVal gpc As UByte = 0, _
ByVal bpc As UByte = 0 _
) As ULong ' return: color(32bit)
' param. range check: 0..100% (all else => QUIT proc.)
If apc > 100 OrElse rpc > 100 OrElse gpc > 100 OrElse bpc > 100 Then Exit Function
Static As colour ret
With ret
.a = PCCA(apc) : .r = PCCA(rpc)
.g = PCCA(gpc) : .b = PCCA(bpc)
End With
Return ret.clr
End Function
Sub PGetARGB( ByVal clr As ULong, _ ' see: PGetRGB()
ByRef apc As UByte = 0, _ ' alpha chan. (in percent)
ByRef rpc As UByte = 0, _ ' all else: as PGetRGB()
ByRef gpc As UByte = 0, _
ByRef bpc As UByte = 0 )
Static As colour ret
With ret
.clr = clr ' load current color (all channels)
apc = RCCA(.a)
rpc = RCCA(.r) ' get channels using LUT
gpc = RCCA(.g)
bpc = RCCA(.b)
End With
End Sub
' single channel setter ... using Union access (any one channel)
Function PSet_Chan( ByVal clr As ULong, _ ' color 24/32 bit
ByVal ccv As UByte, _ ' value to set (in percent)
ByRef chn As String _ ' char (a, r, g, b) = channel to set
) As ULong ' return: channel val. in percent
Static As Colour ret
With ret
.clr = clr ' load current color (all channels)
Select Case As Const Asc(UCase(chn), 1) ' we only want to check upper case
Case 65 : .a = PCCA(ccv) ' 65 = Asc("A"), but faster
Case 82 : .r = PCCA(ccv) ' 82 = Asc("R"), as above
Case 71 : .g = PCCA(ccv) ' 71 = Asc("G"), as above
Case 66 : .b = PCCA(ccv) ' 66 = Acs("B"), as above
Case Else
chn = "?" ' error return "?" in chn
Exit Function
End Select
Return .clr
End With
End Function
' single channel getter ... using Union access (any one channel)
Function PGet_Chan( ByVal clr As ULong, _ ' color 24/32 bit
ByRef chn As String _ ' char (a, r, g, b) = channel to get
) As UByte ' return: channel val. in percent
Static As Colour ret
ret.clr = clr
Select Case As Const Asc(UCase(chn), 1) ' we only want to check upper case
Case 65 : Return RCCA(ret.a) ' 65 = Asc("A"), but faster
Case 82 : Return RCCA(ret.r) ' 82 = Asc("R"), as above
Case 71 : Return RCCA(ret.g) ' 71 = Asc("G"), as above
Case 66 : Return RCCA(ret.b) ' 66 = Acs("B"), as above
Case Else
chn = "?" ' error return "?" in chn
Exit Function
End Select
End Function
' all remaining: single channel getter/setter ... using Ptr access
Function PSet_A ( ByVal clr As ULong, _ ' color 32 bit only!
ByVal apc As UByte _ ' ALPHA (in percent)
) As ULong ' return: changed ALPHA (in ULong)
If apc > 100 Then Exit Function ' range check: 0%..100%
CPtr(UByte Ptr, @clr)[3] = PCCA(apc) ' apply using LUT
Return clr
End Function
Function PSet_R ( ByVal clr As ULong, _ ' color 24/32 bit
ByVal rpc As UByte _ ' RED in percent
) As ULong ' all else: as above
If rpc > 100 Then Exit Function
CPtr(UByte Ptr, @clr)[2] = PCCA(rpc)
Return clr
End Function
Function PSet_G ( ByVal clr As ULong, _ ' color 24/32 bit
ByVal gpc As UByte _ ' GREEN in percent
) As ULong
If gpc > 100 Then Exit Function ' all else: as above
CPtr(UByte Ptr, @clr)[1] = PCCA(gpc)
Return clr
End Function
Function PSet_B ( ByVal clr As ULong, _ ' color 24/32 bit
ByVal bpc As UByte _ ' BLUE in percent
) As ULong
If bpc > 100 Then Exit Function ' all else: as above
CPtr(UByte Ptr, @clr)[0] = PCCA(bpc)
Return clr
End Function
Function PGet_A ( ByVal clr As ULong ) As UByte ' color 24/32 bit
Return RCCA(CPtr(UByte Ptr, @clr)[3]) ' Alpha
End Function
Function PGet_R ( ByVal clr As ULong ) As UByte ' color 24/32 bit
Return RCCA(CPtr(UByte Ptr, @clr)[2]) ' red
End Function
Function PGet_G ( ByVal clr As ULong ) As UByte ' color 24/32 bit
Return RCCA(CPtr(UByte Ptr, @clr)[1]) ' green
End Function
Function PGet_B ( ByVal clr As ULong ) As UByte ' color 24/32 bit
Return RCCA(CPtr(UByte Ptr, @clr)[0]) ' blue
End Functionsimply rename it and save it again (the code is identical for both). However from doing DLL's:
it's better to proceed this way, because a simple (later) name-change, doesn't work! This may
not be relevant to static lib's, but I prefer to be *on the safe side*, also called *good practice*.
If you are only using one FBC, save the file once (with correct bit-ness appended):
e.g. ColorLUTbyPercent32.bas or ColorLUTbyPercent64.bas (name is taken over into .a file!).
After compiling the lib (one or two) you'll have to put the files into the correct folders/dirs:
- .bi goes to (all used compilers) <FBC-DIR>/inc/
the libColorLUTbyPercent<nn>.a goes to: <FBC-DIR>/lib/<OS>/
Examples follow in the next post ...