problem, there may be other *more favorable* solutions, in a differing context.
In below code snippets, the Union solution appears to be somewhat clumsy, on its own.
However, in the context of a library (where the Union is external to procedures) it may
be the best solution.
Similar, to the pointer method, in cases where only one channel is needed (but could
also be done, by a simple #Define ... depending on context).
Last but not least, the Macro method which may look familiar to those, having roots in
assembly programming (shifting & masking), which is probably fastest, on its own.
All 3 of them are capable of being made reversible, however some might need additio-
nal temp. variables (namely the pointer method). The first code (with demo) shows
the Getter's, while the second (without demo), shows the Setter's (inverted process).
[edit] new title, to better reflect the main purpose [/edit]
first:
Code: Select all
' 3-Methods_sameResult.bas -- 2018-07-20, by MrSwiss
'
' compile: -s console
'
Sub Get_ChanU( _ ' get individual channels from color32 (ULong)
ByVal clr As ULong, _ ' color to be split into channels (input)
ByRef a As UByte = 0, _ ' alpha-channel (return)
ByRef r As UByte = 0, _ ' red-channel (return)
ByRef g As UByte = 0, _ ' green-channel (return)
ByRef b As UByte = 0 _ ' blue-channel (return)
)
Union cl_ ' define the union itself
As ULong c
Type
As UByte b, g, r, a ' LSB to MSB (little endian)
End Type
End Union
' below: use of the union
Dim As cl_ ret ' define one instance of union
ret.c = clr ' load it with input color
a = ret.a ' get & assign results ...
r = ret.r
g = ret.g
b = ret.b
End Sub
Sub Get_ChanP( _ ' get individual channels from color32 (ULong)
ByVal clr As ULong, _ ' color to be split into channels (input)
ByRef a As UByte = 0, _ ' alpha-channel (return)
ByRef r As UByte = 0, _ ' red-channel (return)
ByRef g As UByte = 0, _ ' green-channel (return)
ByRef b As UByte = 0 _ ' blue-channel (return)
)
a = CPtr(UByte Ptr, @clr)[3] ' MSB
r = CPtr(UByte Ptr, @clr)[2]
g = CPtr(UByte Ptr, @clr)[1]
b = CPtr(UByte Ptr, @clr)[0] ' LSB
End Sub
Sub Get_ChanM( _ ' get individual channels from color32 (ULong)
ByVal clr As ULong, _ ' color to be split into channels (input)
ByRef a As UByte = 0, _ ' alpha-channel (return)
ByRef r As UByte = 0, _ ' red-channel (return)
ByRef g As UByte = 0, _ ' green-channel (return)
ByRef b As UByte = 0 _ ' blue-channel (return)
)
a = clr Shr 24 And 255 ' MSB (255 = &hFF = &b11111111)
r = clr Shr 16 And 255
g = clr Shr 8 And 255
b = clr And 255 ' LSB
End Sub
Const As ULong red = &hFFFF0000, green = &h7F00FF00, blue = &h3F0000FF
' variables used ...
Dim As UByte ac = 0, rc = 0, gc = 0, bc = 0
Dim As String sa(1 To 6) => { "color in HEX: ", "alpha-channel: ", _
"red-channel: ", "green-channel: ", _
"blue-channel: ", " aarrggbb" }
'Get_ChanM(red, ac, rc, gc, bc) ' macro method (ASM like: shift & mask)
'Get_ChanP(red, ac, rc, gc, bc) ' pointer casting method
Get_ChanU(red, ac, rc, gc, bc) ' union method
Print sa(1); Hex(red, 8); sa(6)
Print sa(2); ac; ", "; Hex(ac, 2)
Print sa(3); rc; ", "; Hex(rc, 2)
Print sa(4); gc; ", "; Hex(gc, 2)
Print sa(5); bc; ", "; Hex(bc, 2)
Print
ac = 0 : rc = 0 : gc = 0 : bc = 0 ' reset channel-UByte's
'Get_ChanM(green, ac, rc, gc, bc)
Get_ChanP(green, ac, rc, gc, bc)
'Get_ChanU(green, ac, rc, gc, bc)
Print sa(1); Hex(green, 8); sa(6)
Print sa(2); ac; ", "; Hex(ac, 2)
Print sa(3); rc; ", "; Hex(rc, 2)
Print sa(4); gc; ", "; Hex(gc, 2)
Print sa(5); bc; ", "; Hex(bc, 2)
Print
ac = 0 : rc = 0 : gc = 0 : bc = 0
Get_ChanM(blue, ac, rc, gc, bc)
'Get_ChanP(blue, ac, rc, gc, bc)
'Get_ChanU(blue, ac, rc, gc, bc)
Print sa(1); Hex(blue, 8); sa(6)
Print sa(2); ac; ", "; Hex(ac, 2)
Print sa(3); rc; ", "; Hex(rc, 2)
Print sa(4); gc; ", "; Hex(gc, 2)
Print sa(5); bc; ", "; Hex(bc, 2)
Print
Erase(sa) ' destroy string array
SleepCode: Select all
' 3-Methods_sameResult_2.bas -- 2018-07-21, by MrSwiss
'
' compile: -s console
'
Function Set_ChanU( _ ' set individual channels to color32 (ULong)
ByVal a As UByte = 255, _ ' alpha-channel (input), default = opaque
ByVal r As UByte = 0, _ ' red-channel (input)
ByVal g As UByte = 0, _ ' green-channel (input)
ByVal b As UByte = 0 _ ' blue-channel (input)
) As ULong ' assembled 32bit color
Union cl_ ' define the union itself
As ULong c
Type
As UByte b, g, r, a ' LSB to MSB (little endian)
End Type
End Union
' below: use of the union
Dim As cl_ ret ' define one instance of union
ret.a = a
ret.r = r
ret.g = g
ret.b = b
Return ret.c
End Function
Function Set_ChanP( _ ' set individual channels to color32 (ULong)
ByVal a As UByte = 255, _ ' alpha-channel (input), default = opaque
ByVal r As UByte = 0, _ ' red-channel (input)
ByVal g As UByte = 0, _ ' green-channel (input)
ByVal b As UByte = 0 _ ' blue-channel (input)
) As ULong ' assembled 32bit color
Dim As ULong clr ' temp. variable needed!
CPtr(UByte Ptr, @clr)[3] = a ' MSB
CPtr(UByte Ptr, @clr)[2] = r
CPtr(UByte Ptr, @clr)[1] = g
CPtr(UByte Ptr, @clr)[0] = b ' LSB
Return clr
End Function
Function Set_ChanM( _ ' set individual channels to color32 (ULong)
ByVal a As UByte = 255, _ ' alpha-channel (input), default = opaque
ByVal r As UByte = 0, _ ' red-channel (input)
ByVal g As UByte = 0, _ ' green-channel (input)
ByVal b As UByte = 0 _ ' blue-channel (input)
) As ULong ' assembled 32bit color
Return (a Shl 24) + (r Shl 16) + (g Shl 8) + b
End Function