hex value of system colors

[i3igsh0t]

hi, I was wondering how you can get the settings for windows system colors (such as &H8000000C& for example) so it will give me a hex or rgb value of the color. thanks.

[Chris]

i3igsh0t, Here the sample code on how to get all the Windows System color by using the GetSysColor API.

Option Explicit
Const COLOR_SCROLLBAR = 0
Const COLOR_BACKGROUND = 1
Const COLOR_ACTIVECAPTION = 2
Const COLOR_INACTIVECAPTION = 3
Const COLOR_MENU = 4
Const COLOR_WINDOW = 5
Const COLOR_WINDOWFRAME = 6
Const COLOR_MENUTEXT = 7
Const COLOR_WINDOWTEXT = 8
Const COLOR_CAPTIONTEXT = 9
Const COLOR_ACTIVEBORDER = 10
Const COLOR_INACTIVEBORDER = 11
Const COLOR_APPWORKSPACE = 12
Const COLOR_HIGHLIGHT = 13
Const COLOR_HIGHLIGHTTEXT = 14
Const COLOR_BTNFACE = 15
Const COLOR_BTNSHADOW = 16
Const COLOR_GRAYTEXT = 17
Const COLOR_BTNTEXT = 18
Const COLOR_INACTIVECAPTIONTEXT = 19
Const COLOR_BTNHIGHLIGHT = 20
Const COLOR_3DDKSHADOW = 21
Const COLOR_3DLIGHT = 22
Const COLOR_INFOTEXT = 23
Const COLOR_INFOBK = 24
Const COLOR_HOTLIGHT = 26
Const COLOR_GRADIENTACTIVECAPTION = 27
Const COLOR_GRADIENTINACTIVECAPTION = 28

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 DefaultColor(28) As Long

Private Sub Command1_Click()
    GetSystemColor
End Sub

Private Sub GetSystemColor()
Dim Idx As Long
For Idx = 0 To 28
    DefaultColor(Idx) = GetSysColor(Idx)
Next
End Sub

Cheers!

[i3igsh0t]

Thanks for the help, works great

[Chris]

You're welcome. )

[Alan777]

I made this module to convert the Long color values to RGB.
It may look a bit primative but it works great:
code:
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