Visual Basic System Services
OleTranslateColor: Translate System/RGB Colours into R, G and B Components
     
Posted:   Sunday July 07, 2002
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None.
Author:   VBnet - Randy Birch
     

Related:  

OleTranslateColor: Inverting RGB and System Colors
     
 Prerequisites
None.

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.

 BAS Module Code
None.

 Form Code
To a form, add a label (Label1(0)) and a textbox (Text1(0)) set as control arrays. Code in the Load event creates the required labels and text boxes from the array. Add two command buttons (Command1, Command2), and a picture box (any size) containing any image, along with the following code. The picture box is only used in the demo's Command1 event to extract a pixel colour via the Point method - you could easily skip that and assign an known value directly to the dwOleColor variable as is done in Command2.

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
 Comments
 

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter