Use this code to read or set the current desktop color settings.

Module

Option Explicit

Private Declare Function GetSysColor Lib "user32.dll" (ByVal nindex As Long) As Long
Private Declare Function SetSysColors Lib "user32.dll" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long

Public Enum WindowsItem
    COLOR_ACTIVEBORDER = 10
    COLOR_ACTIVECAPTION = 2
    COLOR_APPWORKSPACE = 12
    COLOR_BACKGROUND = 1
    COLOR_BTNFACE = 15
    COLOR_BTNHIGHLIGHT = 20
    COLOR_BTNSHADOW = 16
    COLOR_BTNTEXT = 18
    COLOR_CAPTIONTEXT = 9
    COLOR_GRAYTEXT = 17
    COLOR_HIGHLIGHT = 13
    COLOR_HIGHLIGHTTEXT = 14
    COLOR_INACTIVEBORDER = 11
    COLOR_INACTIVECAPTION = 3
    COLOR_INACTIVECAPTIONTEXT = 19
    COLOR_MENU = 4
    COLOR_MENUTEXT = 7
    COLOR_SCROLLBAR = 0
    COLOR_WINDOW = 5
    COLOR_WINDOWFRAME = 6
    COLOR_WINDOWTEXT = 8
End Enum

Public Function GetWindowsColor(Item As WindowsItem) As OLE_COLOR
    GetWindowsColor = GetSysColor(Item)
End Function

Public Sub SetWindowsColor(Item As WindowsItem, Color As OLE_COLOR)
    SetSysColors 1, Item, Color
End Sub

Date:2019-10-02

Migrated:Not Migrated

Video Settings

Get the current Video settings: Colors, Resolution and Pixels per Inch

Module

Option Explicit

Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Const HORZRES = 8 ' Horizontal size in pixels
Private Const VERTRES = 10 ' Vertical size in pixels
Private Const BITSPIXEL = 12 ' Bits per Pixel
Private Const LOGPIXELSX = 88 ' Pixel/inch in X
Private Const LOGPIXELSY = 90 ' Pixel/inch in Y

Public Sub GetVideoCaps(hDC As Long, Colors As Long, XResolution As Long, YResolution As Long)
    Dim i As Integer
    Dim BitsPerPixel As Long

    BitsPerPixel = GetDeviceCaps(hDC, BITSPIXEL)
    Colors = 1
    For i = 1 To BitsPerPixel
        Colors = Colors * 2
    Next
    XResolution = GetDeviceCaps(hDC, HORZRES)
    YResolution = GetDeviceCaps(hDC, VERTRES)
End Sub

Public Sub GetPixelsInch(hDC As Long, PX As Long, PY As Long)
    PX = GetDeviceCaps(hDC, LOGPIXELSX)
    PY = GetDeviceCaps(hDC, LOGPIXELSY)
End Sub

Usage

Private Sub Form_Load()
    Dim c As Long
    Dim x As Long
    Dim y As Long

    GetVideoCaps Form1.hDC, c, x, y
    MsgBox x & "x" & y & " - " & c & " colors"
    GetPixelsInch Form1.hDC, x, y
    MsgBox x & " Pixels/Inch in X" & vbCrLf & y & " Pixels/Inch in Y"
End Sub