Divide CommonDialog.color into R,G,B

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.

Here is a module that I made for that purpose:

Code:

---

'----------------------------------------------------------
'                    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

---

Code:

---

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

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

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?

Code:

---

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

---

Code:

---

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

---

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

Code:

---

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

---

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

Thanks guys,

A great forum !!!