Divide CommonDialog.color into R,G,B

[orenKul]

Hi,

I need to pull the R,G,B factors from a CommonDialog's returned Color property.

it's like this:

CommonDialog.ShowColor
Color = CommonDialog.Color

Now, I want to seperate Color into R,G & B values.


Thanks in advance. : )

Oren.

[Alan777]

Here is a module that I made for that purpose:

'----------------------------------------------------------
'                    Long to RGB Module
'----------------------------------------------------------
'Author Alan777
'
'Purpose:
'        To convert a long number to Red, Green, and Blue
'        values.
'
'
'
'
'Syntax:
'        rVal = LongToRGB.R(########)
'        gVal = LongToRGB.G(########)
'        bVal = LongToRGB.B(########)
'
'
'----------------------------------------------------------
Option Explicit

Public Function R(lColor As Long) As Byte

 R = XXX(lColor, 1)
 
End Function

Public Function G(lColor As Long) As Byte

 G = XXX(lColor, 2)
 
End Function

Public Function B(lColor As Long) As Byte

 B = XXX(lColor, 3)
 
End Function

Private Function XXX(lColor As Long, Clr As Byte) As Byte

 Dim HexVal As String
 Dim xVal As String
 Dim n As Byte
 
 HexVal = Hex(lColor)
 
 If Len(HexVal) < 6 Then
  HexVal = Space$(6 - Len(HexVal)) + HexVal
 End If
 
 Select Case Clr
  Case 1
   HexVal = Right$(HexVal, 2)
  Case 2
   HexVal = Mid$(HexVal, 3, 2)
  Case 3
   HexVal = Left$(HexVal, 2)
 End Select
 
 xVal = Left$(HexVal, 1)
 n = Dec(xVal)
 xVal = Right$(HexVal, 1)
 
 XXX = (n * 16) + Dec(xVal)
  
End Function

Private Function Dec(HexChar As String) As Byte

 Select Case HexChar
  Case "A", "B", "C", "D", "E", "F"
   Dec = Asc(HexChar) - 55
  Case " "
   Dec = 0
  Case Else
   Dec = Asc(HexChar) - 48
 End Select
 
End Function

[Shrog]

Dim R As Byte
Dim G As Byte
Dim B As Byte

R = Color And &hFF&
G = Int(Color / &h100&) And &hFF&
B = Int(Color / &h10000&) And &hFF&

During a little test, I found that using the Hex values as in the example above was actually faster (over LOTS of itterations), but I'll test it again some time just to make sure.

Shrog

[Alan777]

Shrog! Very cool!!
Wish I had that ages ago!!

[kedaman]

Another way of doing it without bugging the cpu with math operations, each color component is represent as a byte in the long for a rgb value so why not just copy over?

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub Form_Load()
    Dim a As Long, r(3) As Byte
    a = RGB(255, 22, 43) 'some terrible color
    CopyMemory r(0), a, 4
    MsgBox r(0) & "," & r(1) & "," & r(2)
End Sub

lRed = lColor Mod &H100
lGreen = Int(lColor / &H100) Mod &H100
lBlue = Int(lColor / &H10000) Mod &H10

[kedaman]

ehm, if you want to go with the operators, you should use integer division instead:

lRed = lColor Mod &H100
lGreen = lColor \ &H100 Mod &H100
lBlue = lColor \ &H10000 Mod &H100

But as i said, it'll just slow down cpu

[orenKul]

Thanks guys,

A great forum !!!