Results 1 to 7 of 7

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

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Jun 2002
    Posts
    299

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

    VB Code:
    1. Public Type RGB
    2.     r as Byte
    3.     g as Byte
    4.     b as Byte
    5. End Type
    6.  
    7. Public Function GetRGB(lColor as Long) as RGB
    8.     Dim tmpVar as RGB
    9.     tmpVar.r = lColor Mod &H100
    10.     tmpVar.g = (lColor \ &H100) Mod &H100
    11.     tmpVar.b = ((lColor \ &H10000)) Mod &H100
    12.     GetRGB = tmpVar
    13. End Function
    14.  
    15.  
    16. 'usage
    17. Sub Main()
    18.     Dim rndColor as Long,rgbVals as RGB
    19.     Randomize
    20.     rndColor=RGB(Rnd*255,Rnd*255,Rnd*255)
    21.     rgbVals = GetRGB(rndColor)
    22.     Msgbox "Red = " & rgbVals.r & VbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b
    23.     End
    24. End Sub
    If I agree with you today, don't get used to it.

  2. #2
    Frenzied Member
    Join Date
    Aug 2000
    Location
    O!
    Posts
    1,177
    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:
    1. Public Type RGB
    2.     r As Byte
    3.     g As Byte
    4.     b As Byte
    5. End Type
    6. Public Declare Sub CopyMemory Lib "KERNEL32" _
    7.                    Alias "RtlMoveMemory" (hpvDest As Any, _
    8.                                           hpvSource As Any, _
    9.                                           ByVal cbCopy As Long)
    10.  
    11. Public Function GetRGB(lColor As Long) As RGB
    12.     Dim tmpVar As RGB
    13.     tmpVar.r = lColor Mod &H100
    14.     tmpVar.g = (lColor \ &H100) Mod &H100
    15.     tmpVar.b = ((lColor \ &H10000)) Mod &H100
    16.     GetRGB = tmpVar
    17. End Function
    18.  
    19. Public Function GetRGB2(lColor As Long) As RGB
    20.     Dim tmpVar As RGB
    21.     ' use And to isolate the desired byte and
    22.     ' shift result (if necessary) to the low-order byte
    23.    
    24.     ' get byte 0 - low order byte of intermediate result
    25.     tmpVar.r = lColor And &HFF
    26.     ' get byte 1 and right shift the intermediate result 8 bits
    27.     tmpVar.g = (lColor And &HFF00&) \ &H100
    28.     ' get byte 2 and right shift the intermediate result 16 bits
    29.     tmpVar.b = (lColor And &HFF0000) \ &H10000
    30.    
    31.     GetRGB2 = tmpVar
    32.    
    33. End Function
    34.  
    35. Public Function GetRGB3(lColor As Long) As RGB
    36.     Dim tmpVar As RGB
    37.     ' shift desired byte (if necessary) to low-order byte and
    38.     ' use And to get the value of that byte
    39.    
    40.     ' get byte 0 - low order byte of intermediate result
    41.     tmpVar.r = lColor And &HFF
    42.     ' right shift 8 bits and get the low order byte of the intermediate result
    43.     tmpVar.g = (lColor \ &H100) And &HFF
    44.     ' right shift 16 bits and get the low order byte of the intermediate result
    45.     tmpVar.b = (lColor \ &H10000) And &HFF
    46.    
    47.     GetRGB3 = tmpVar
    48.    
    49. End Function
    50.  
    51.  
    52. 'usage
    53. Sub Main()
    54.     Dim rndColor As Long, rgbVals As RGB, ColorsArray(2) As Byte
    55.    
    56.     ' create the Long RGB value
    57.     Randomize
    58.     rndColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
    59.    
    60.     ' get the colors using the original method posted above
    61.     rgbVals = GetRGB(rndColor)
    62.     MsgBox "Original post method" & vbCrLf & "Red = " & rgbVals.r & vbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b
    63.    
    64.     ' the next 2 methods are similar to the original method, but they use combinations
    65.     ' of And and right shifts rather than shifts and Mod.
    66.     ' Right shifts are accomplished by dividing by 2^n where n = number of bits to shift.
    67.     ' 2^8 = 256 = &H100
    68.     ' 2^16 = 65536 = &H10000
    69.    
    70.     ' get the colors using And to isolate the desired byte and shifting it to the low-order byte
    71.     rgbVals = GetRGB2(rndColor)
    72.     MsgBox "GetRGB2 method" & vbCrLf & "Red = " & rgbVals.r & vbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b
    73.    
    74.     ' get the colors by shifting it to the low-order byte and using And to get the byte
    75.     rgbVals = GetRGB3(rndColor)
    76.     MsgBox "GetRGB3 method" & vbCrLf & "Red = " & rgbVals.r & vbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b
    77.    
    78.     ' the next 2 methods use the CopyMemory API.
    79.     ' the values are stored in the first 3 (low-order) bytes and since Integers & Longs are stored little-endian,
    80.     ' we can easily copy the 3 bytes to either a UDT or a byte array
    81.    
    82.     ' get the colors using the CopyMemory API call and a UDT
    83.     CopyMemory rgbVals, rndColor, 3 ' we only need the lower 3 bytes of the Long
    84.     MsgBox "CopyMemory/UDT method" & vbCrLf & "Red = " & rgbVals.r & vbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b
    85.    
    86.     ' get the colors using the CopyMemory API call and a byte array
    87.     CopyMemory ColorsArray(0), rndColor, 3 ' we only need the lower 3 bytes of the Long
    88.     MsgBox "CopyMemory/byte array method" & vbCrLf & "Red = " & ColorsArray(0) & vbCrLf & "Green = " & ColorsArray(1) & vbCrLf & "Blue = " & ColorsArray(2)
    89.    
    90.     End
    91. End Sub
    Last edited by ccoder; May 15th, 2003 at 03:30 PM.

  3. #3
    Frenzied Member
    Join Date
    Aug 2000
    Location
    O!
    Posts
    1,177
    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:
    1. Public Function GetRGB4(lColor As Long) As RGB
    2.     Dim tmpVar As RGB, lptr As Long, uptr As Long, i As Integer
    3.     ' uses quasi pointer arithmetic to access the desired bytes.
    4.    
    5.     lptr = VarPtr(lColor)
    6.     uptr = VarPtr(tmpVar)
    7.     For i = 0 To 2
    8.         CopyMemory ByVal uptr + i, ByVal lptr + i, 1
    9.     Next i
    10.     GetRGB4 = tmpVar
    11.    
    12. End Function
    And add the following to the Sub Main.
    VB Code:
    1. ' the next method demonstrates the use of VB's limited pointer capabilities
    2.     rgbVals = GetRGB4(rndColor)
    3.     MsgBox "GetRGB4 method" & vbCrLf & "Red = " & rgbVals.r & vbCrLf & "Green = " & rgbVals.g & vbCrLf & "Blue = " & rgbVals.b

  4. #4
    PowerPoster Fox's Avatar
    Join Date
    Jan 2000
    Location
    *afk*
    Posts
    2,088
    There's no need for any API calls...

    VB Code:
    1. Private Type tLong
    2.     Value As Long
    3. End Type
    4.  
    5. Private Type tRGBA
    6.     Red As Byte
    7.     Green As Byte
    8.     Blue As Byte
    9.     Alpha As Byte
    10. End Type
    11.  
    12. Public Function GetColorRGB(iColor As Long, R As Byte, G As Byte, B As Byte)
    13.     Dim Color As tLong
    14.     Dim Parts As tRGBA
    15.    
    16.     'Get color parts
    17.     Color.Value = iColor
    18.     LSet Parts = Color
    19.    
    20.     'Return parts
    21.     R = Parts.Red
    22.     G = Parts.Green
    23.     B = Parts.Blue
    24.     'A = Parts.Alpha
    25. End Function

    Usage:

    VB Code:
    1. 'Sample color
    2.     Dim Color as Long
    3.     Color = RGB(102, 188, 1)
    4.    
    5.     Dim R as Byte
    6.     Dim G as Byte
    7.     Dim B as Byte
    8.    
    9.     'Fill color components from Color into R, G and B
    10.     GetColorRGB Color, R, G, B

  5. #5
    Addicted Member CodeRonin's Avatar
    Join Date
    Jul 2002
    Location
    Vienna, Austria
    Posts
    233

    Is the...

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

  6. #6
    Hyperactive Member
    Join Date
    Nov 2002
    Location
    Someplace 'ore the rainbow
    Posts
    392
    ...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

  7. #7
    PowerPoster Fox's Avatar
    Join Date
    Jan 2000
    Location
    *afk*
    Posts
    2,088
    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:
    1. Public Sub SplitRGB(ByVal iColor As Long, _
    2.     ByRef R As Long, ByRef G As Long, ByRef B As Long)
    3.  
    4.     R= (iColor And &HFF)
    5.     G= (iColor And &HFF00&) \ &H100&
    6.     B= (iColor And &HFF0000) \ &H10000
    7. End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width