Get and Set System Colors

Category:

System/API

Type:

Snippets

Difficulty:

Intermediate

Author:

Intelligent Solutions Inc.

Version Compatibility:

More information:

See comments for usage/explanation.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit Private Declare Function GetSysColor Lib "user32" _ (ByVal nIndex As Long) As Long Private Declare Function SetSysColors Lib "user32" _ (ByVal nChanges As Long, lpSysColor As Long, _ lpColorValues As Long) As Long Private Type COLORREF RED_VALUE As Byte GREEN_VALUE As Byte BLUE_VALUE As Byte End Type 'This covers most of the system colors 'You will find more in the 'API Text viewer and documentation for 'GetSysColor API Function Public Enum SYS_COLOR_VALUES COLOR_ACTIVEBORDER = 10 COLOR_ACTIVECAPTION = 2 COLOR_APPWORKSPACE = 12 COLOR_BACKGROUND = 1 COLOR_BTNHIGHLIGHT = 20 COLOR_BTNSHADOW = 16 COLOR_CAPTIONTEXT = 9 COLOR_INACTIVEBORDER = 11 COLOR_INACTIVECAPTION = 3 COLOR_INACTIVECAPTIONTEXT = 19 COLOR_MENU = 4 COLOR_MENUTEXT = 7 COLOR_SCROLLBAR = 0 COLOR_WINDOW = 5 COLOR_WINDOWTEXT = 8 End Enum

Code:

Public Function SetSystemColor(SystemElement As _
   SYS_COLOR_VALUES, ByVal Red As Byte, ByVal Green As Byte, _
   ByVal Blue As Byte) As Boolean

'************************
'PURPOSE: Set system colors for a given system element
'PARAMETERS:
'    SystemElement: One of values in SYS_COLOR VALUES.  
'    See Declarations

'    Red:           Red Value (0-255) of new color
'    Green:         Green Value (0-255) of new color
'    Blue:          Blue Value (0-255) of new color
'
'RETURNS: True if successful, false otherwise
'
'NOTE: Does not permanently change color.  Only
'      Changes the color for the session
'*********************************************
Dim lRet As Long

Dim typCr As COLORREF
Dim arrTypCr(0) As COLORREF
Dim arrElements(0) As Long

Dim lElementsPtr As Long
Dim lColorRefPtr As Long
typCr.RED_VALUE = Red
typCr.GREEN_VALUE = Green
typCr.BLUE_VALUE = Blue
arrTypCr(0) = typCr
arrElements(0) = SystemElement

'SetSysColors API Function requires pointers to arrays

lRet = SetSysColors(1, arrElements(0), _
    ByVal (VarPtr(arrTypCr(0))))

SetSystemColor = lRet <> 0
End Function

Public Function GetSystemColor(SystemElement As _
   SYS_COLOR_VALUES) As OLE_COLOR
'************************
'PURPOSE:   Get the system colors for a given system element
'PARAMETER:
'           SystemElement: One of values in SYS_COLOR VALUES.
'           See Declarations
'RETURNS:   Requested Color in OLE_COLOR (Long) format
'EXAMPLE:   Me.BackColor = GetSystemColor(COLOR_MENUTEXT)
'*********************************************
    GetSystemColor = GetSysColor(SystemElement)
End Function