Public Type RGB
r As Byte
g As Byte
b As Byte
End Type
Public Declare Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" (hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long)
Public Function GetRGB(lColor As Long) As RGB
Dim tmpVar As RGB
tmpVar.r = lColor Mod &H100
tmpVar.g = (lColor \ &H100) Mod &H100
tmpVar.b = ((lColor \ &H10000)) Mod &H100
GetRGB = tmpVar
End Function
Public Function GetRGB2(lColor As Long) As RGB
Dim tmpVar As RGB
' use And to isolate the desired byte and
' shift result (if necessary) to the low-order byte
' get byte 0 - low order byte of intermediate result
tmpVar.r = lColor And &HFF
' get byte 1 and right shift the intermediate result 8 bits
tmpVar.g = (lColor And &HFF00&) \ &H100
' get byte 2 and right shift the intermediate result 16 bits
tmpVar.b = (lColor And &HFF0000) \ &H10000
GetRGB2 = tmpVar
End Function
Public Function GetRGB3(lColor As Long) As RGB
Dim tmpVar As RGB
' shift desired byte (if necessary) to low-order byte and
' use And to get the value of that byte
' get byte 0 - low order byte of intermediate result
tmpVar.r = lColor And &HFF
' right shift 8 bits and get the low order byte of the intermediate result
tmpVar.g = (lColor \ &H100) And &HFF
' right shift 16 bits and get the low order byte of the intermediate result
tmpVar.b = (lColor \ &H10000) And &HFF
GetRGB3 = tmpVar
End Function
'usage
Sub Main()
Dim rndColor As Long, rgbVals As RGB, ColorsArray(2) As Byte
' create the Long RGB value
Randomize
rndColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
' get the colors using the original method posted above
rgbVals = GetRGB(rndColor)
MsgBox "Original post method" & vbCrLf & "Red = " & rgbVals.r & vbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b
' the next 2 methods are similar to the original method, but they use combinations
' of And and right shifts rather than shifts and Mod.
' Right shifts are accomplished by dividing by 2^n where n = number of bits to shift.
' 2^8 = 256 = &H100
' 2^16 = 65536 = &H10000
' get the colors using And to isolate the desired byte and shifting it to the low-order byte
rgbVals = GetRGB2(rndColor)
MsgBox "GetRGB2 method" & vbCrLf & "Red = " & rgbVals.r & vbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b
' get the colors by shifting it to the low-order byte and using And to get the byte
rgbVals = GetRGB3(rndColor)
MsgBox "GetRGB3 method" & vbCrLf & "Red = " & rgbVals.r & vbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b
' the next 2 methods use the CopyMemory API.
' the values are stored in the first 3 (low-order) bytes and since Integers & Longs are stored little-endian,
' we can easily copy the 3 bytes to either a UDT or a byte array
' get the colors using the CopyMemory API call and a UDT
CopyMemory rgbVals, rndColor, 3 ' we only need the lower 3 bytes of the Long
MsgBox "CopyMemory/UDT method" & vbCrLf & "Red = " & rgbVals.r & vbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b
' get the colors using the CopyMemory API call and a byte array
CopyMemory ColorsArray(0), rndColor, 3 ' we only need the lower 3 bytes of the Long
MsgBox "CopyMemory/byte array method" & vbCrLf & "Red = " & ColorsArray(0) & vbCrLf & "Green = " & ColorsArray(1) & vbCrLf & "Blue = " & ColorsArray(2)
End
End Sub