VB - Get R,G,B Values from Long Color

VB Code:

Public Type RGB
    r as Byte
    g as Byte
    b as Byte
End Type
 
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
 
 
'usage
Sub Main()
    Dim rndColor as Long,rgbVals as RGB
    Randomize
    rndColor=RGB(Rnd*255,Rnd*255,Rnd*255)
    rgbVals = GetRGB(rndColor)
    Msgbox "Red = " & rgbVals.r & VbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b
    End
End Sub

Here are 4 more ways of getting the color values.

Two are similar to the solution posted by snakeeyes1000. They use bit-shifting like the original post, but use the And operator rather than Mod. One shifts and then Ands, the other Ands and then shifts. The other two use the CopyMemory API. One moves the values to a UDT, the other moves them to a byte array.

In both cases, the differences are quite trivial. Just different ways of looking at a problem.

I used the original code and added the 4 additional routines. I also added numerous comments to help explain anything that might not be clear.

VB Code:

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

Stop me if I'm getting carried away with this. Here is another way to get at those bytes that I didn't think of earlier.

Add the following subroutine to the code that I posted earlier.

VB Code:

Public Function GetRGB4(lColor As Long) As RGB
    Dim tmpVar As RGB, lptr As Long, uptr As Long, i As Integer
    ' uses quasi pointer arithmetic to access the desired bytes.
    
    lptr = VarPtr(lColor)
    uptr = VarPtr(tmpVar)
    For i = 0 To 2
        CopyMemory ByVal uptr + i, ByVal lptr + i, 1
    Next i
    GetRGB4 = tmpVar
    
End Function

And add the following to the Sub Main.

VB Code:

' the next method demonstrates the use of VB's limited pointer capabilities
    rgbVals = GetRGB4(rndColor)
    MsgBox "GetRGB4 method" & vbCrLf & "Red = " & rgbVals.r & vbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b

There's no need for any API calls...

VB Code:

Private Type tLong
    Value As Long
End Type
 
Private Type tRGBA
    Red As Byte
    Green As Byte
    Blue As Byte
    Alpha As Byte
End Type
 
Public Function GetColorRGB(iColor As Long, R As Byte, G As Byte, B As Byte)
    Dim Color As tLong
    Dim Parts As tRGBA
    
    'Get color parts
    Color.Value = iColor
    LSet Parts = Color
    
    'Return parts
    R = Parts.Red
    G = Parts.Green
    B = Parts.Blue
    'A = Parts.Alpha
End Function

Usage:

VB Code:

'Sample color
    Dim Color as Long
    Color = RGB(102, 188, 1)
    
    Dim R as Byte
    Dim G as Byte
    Dim B as Byte
    
    'Fill color components from Color into R, G and B
    GetColorRGB Color, R, G, B

Is the performance-difference between an API call and direct VB code big?

...Just adding another RGB extraction code:

Code:

---

Sub obtainRGB(cValue, varRed, varGreen, varBlue)

varBlue = Int(cValue / 65536)
cValue = cValue Mod 65536
varGreen = Int(cValue / 256)
cValue = cValue Mod 256
varRed = cValue

End Sub

---

Usage:
Call obtainRGB(theLongValue, redVariable, greenVariable, blueVariable)

cjqp

Quote:

---

Is the performance-difference between an API call and direct VB code big?

---

In this case LSet is about twice as fast as the API. The fastest method overall by the way is the math without types:

VB Code:

Public Sub SplitRGB(ByVal iColor As Long, _
    ByRef R As Long, ByRef G As Long, ByRef B As Long)
 
    R= (iColor And &HFF)
    G= (iColor And &HFF00&) \ &H100&
    B= (iColor And &HFF0000) \ &H10000
End Sub