-
Mar 8th, 2003, 03:00 PM
#1
Thread Starter
Hyperactive Member
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
If I agree with you today, don't get used to it.
-
May 15th, 2003, 03:17 PM
#2
Frenzied Member
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
Last edited by ccoder; May 15th, 2003 at 03:30 PM.
-
May 16th, 2003, 05:25 PM
#3
Frenzied Member
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
-
May 17th, 2003, 09:53 AM
#4
PowerPoster
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
-
May 18th, 2003, 11:17 AM
#5
Addicted Member
Is the...
Is the performance-difference between an API call and direct VB code big?
-
May 31st, 2003, 10:18 PM
#6
Hyperactive Member
...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
-
Jul 2nd, 2003, 11:05 AM
#7
PowerPoster
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|