 As
anyone who's worked with colours has discovered Windows uses two distinct
types of colors. The first is familiar - colours represented as Long
values such as those returned by the RGB() function, or through the
ShowColor Common Dialog. The second type of colour is referred to
as an OLE_COLOR, and is used to represent system attributes such as
window text, menu color, tool tips and button face, settable through
Windows' Display Properties dialog, or available through VB's OLE colour
constants such as vbWindowText (&H80000008), vbButtonFace (&H8000000F),
vbMenuBar (&H80000004) and others listed both in the property windows
under BackColor, as well as in VB's help under Color Constants.
Colours like those returned from the RGB() function are long values where
the respective R, G and B values can be extracted by either a combination
of division and AND'ing, or via a simple CopyMemory call to return a byte
array. These colors can be thought of as what Windows calls a COLORREF
(color reference).
The main difference between an OLE_COLOR and a COLORREF is that if an
OLE_COLOR has its high-order bit set, the low-order byte is treated as
a system color index, as opposed to an actual color. When
a COLORREF or OLE_COLOR value is passed to the OleTranslateColor()
function, the function determines which type of color value was passed
and, where the value was an OLE_COLOR, the call translates the passed
system color index into the valid COLORREF for that index. When a
COLORREF is passed to the API, that same COLORREF is returned.
Therefore, any color can be passed to OleTranslateColor which one way
or the other will return a valid colour from which the R, G and B
constituent components can be extracted.
The following code illustrates conversion between an OLE_COLOR and a
COLORREF and the extraction of the R, G and B components by both the
AND'ing method and the CopyMemory method. |
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Bytes As Long)
Private Declare Function OleTranslateColor Lib "olepro32.dll" _
(ByVal OLE_COLOR As Long, _
ByVal HPALETTE As Long, _
pccolorref As Long) As Long
Private Sub Form_Load()
Dim cnt As Long
'load 5 controls
For cnt = 0 To 4
If cnt > 0 Then
Load Text1(cnt)
Load Label1(cnt)
End If
With Label1(cnt)
.Move 200, 328 * (cnt + 1), 1000
.Visible = True
End With
With Text1(cnt)
.Move 1200, 325 * (cnt + 1), 1200
.Visible = True
.Text = ""
End With
Next
Label1(0).Caption = "OLE Color"
Label1(1).Caption = "RGB Color"
Label1(2).Caption = "R value"
Label1(3).Caption = "G value"
Label1(4).Caption = "B value"
Command1.Caption = "GetRBGFromOLEColor"
Command2.Caption = "GetRBGFromOLEColour2"
End Sub
Private Sub Command1_Click()
Dim r As Long
Dim g As Long
Dim b As Long
Dim dwOleColor As Long
dwOleColor = Picture1.Point(100, 100)
GetRBGFromOLEColour dwOleColor, r, g, b
Text1(2).Text = r
Text1(3).Text = g
Text1(4).Text = b
End Sub
Private Sub Command2_Click()
Dim dwOleColor As Long
Dim clrs() As Byte
dwOleColor = &H80000018
clrs() = GetRBGFromOLEColour2(dwOleColor)
Text1(2).Text = clrs(1)
Text1(3).Text = clrs(2)
Text1(4).Text = clrs(3)
End Sub
Private Sub GetRBGFromOLEColour(ByVal dwOleColour As Long, r As Long, g As Long, b As Long)
'pass a hex colour, return the rgb components
Dim clrref As Long
'translate OLE color to valid color if passed
OleTranslateColor dwOleColour, 0, clrref
b = (clrref \ 65536) And &HFF
g = (clrref \ 256) And &HFF
r = clrref And &HFF
'debug info from call
Text1(0).Text = dwOleColour
Text1(1).Text = clrref
End Sub
Private Function GetRBGFromOLEColour2(ByVal dwOleColour As Long) As Byte()
'pass a hex colour, return the rgb components
Dim clrref As Long
Dim b(1 To 4) As Byte
'translate OLE color to valid color if passed
OleTranslateColor dwOleColour, 0, clrref
'copy the color into a byte array
'the size of the long (4 bytes)
CopyMemory b(1), clrref, 4
'debug info from call
Text1(0).Text = dwOleColour
Text1(1).Text = clrref
'return the byte array. Note there
'is no value in byte(4).
GetRBGFromOLEColour2 = b()
End Function |
