Detecting Display Size or System Colour Depth Changes

This tip demonstrates how to detect Windows display setting changes (i.e. screen size and display colour depth) from Visual Basic. You will need to have installed and registered the Subclassing and Timer Assistant (SSubTmr.DLL for VB5 and SSubTmr6.DLL for VB6), available from this site at Subclassing without the crashes to run this sample.

Start a new project and choose Project->References. Look for "Subclassing and Timer Assistant (with multiple control support and timer bug fix)" if you're using VB5 or "VB6 Subclassing and Timer Assistant" if you're using VB6 in the references list. If it is there, select it and click ok. If it isn't, choose Browse, locate SSubTmr.DLL for VB5 or SSubTmr6.DLL for VB6 on your disk, then select that.

Once that is done, add a Class module. Rename the Class module to cDisplayChange and then add the following code:

Private Const WM_DISPLAYCHANGE = &H7E&
Private Const WM_DESTROY = &H2

Private Declare Function GetDeviceCaps Lib "gdi32" _
   (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const BITSPIXEL = 12 ' Number of bits per pixel
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
   (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" _
    (ByVal lpDriverName As String, _
    lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Implements ISubclass

Public Event ColourDepthChange( _
   ByVal lNewBitsPixel As Long, ByVal lOldBitsPixel As Long)
Public Event WindowSizeChange( _
   ByVal lNewWidth As Long, ByVal lNewHeight As Long, _
   ByVal lOldWidth As Long, ByVal lOldHeight As Long)

Private m_hWnd As Long
Private m_lBitsPixel As Long
Private m_lWidth As Long
Private m_lHeight As Long

Public Sub Attach(ByVal hWndA As Long)
   Dim hdc As Long

   Detach
   m_hWnd = hWndA
   AttachMessage Me, m_hWnd, WM_DISPLAYCHANGE
   AttachMessage Me, m_hWnd, WM_DESTROY
   hdc = GetDC(m_hWnd)
   m_lBitsPixel = GetDeviceCaps(hdc, BITSPIXEL)
   m_lWidth = Screen.Width \ Screen.TwipsPerPixelX
   m_lHeight = Screen.Height \ Screen.TwipsPerPixelY
   ReleaseDC hdc, m_hWnd

End Sub
Public Sub Detach()
   If Not m_hWnd = 0 Then
      DetachMessage Me, m_hWnd, WM_DISPLAYCHANGE
      DetachMessage Me, m_hWnd, WM_DESTROY
      m_hWnd = 0
   End If
End Sub

Public Property Get ColourDepth() As Long
   Dim hdc As Long
   If m_hWnd = 0 Then
      hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
      m_lBitsPixel = GetDeviceCaps(hdc, BITSPIXEL)
      DeleteDC hdc
   End If
   ColourDepth = m_lBitsPixel
End Property
Public Property Get DisplayWidth() As Long
   If m_hWnd = 0 Then
      m_lWidth = Screen.Width \ Screen.TwipsPerPixelX
   End If
   DisplayWidth = m_lWidth
End Property
Public Property Get DisplayHeight() As Long
   If m_hWnd = 0 Then
      m_lHeight = Screen.Height \ Screen.TwipsPerPixelY
   End If
   DisplayHeight = m_lHeight
End Property

Private Sub Class_Terminate()
   Detach
End Sub

Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer.EMsgResponse)
   '
End Property

Private Property Get ISubclass_MsgResponse() As SSubTimer.EMsgResponse
   ISubclass_MsgResponse = emrPreprocess
End Property

Private Function ISubclass_WindowProc( _
      ByVal hwnd As Long, ByVal iMsg As Long, _
      ByVal wParam As Long, ByVal lParam As Long) As Long
   Select Case iMsg
   Case WM_DISPLAYCHANGE
      Dim lOldBitsPixel As Long
      Dim lWidth As Long, lHeight As Long
      Dim lOldWidth As Long, lOldHeight As Long

      lWidth = lParam And &HFFFF&
      lHeight = (lParam And &H7FFF0000) \ &H10000

      If Not wParam = m_lBitsPixel Then
         lOldBitsPixel = m_lBitsPixel
         m_lBitsPixel = wParam
         RaiseEvent ColourDepthChange(m_lBitsPixel, lOldBitsPixel)
      End If
      If Not ((lWidth = m_lWidth) And (lHeight = m_lHeight)) Then
         lOldWidth = m_lWidth
         lOldHeight = m_lHeight
         m_lWidth = lWidth
         m_lHeight = lHeight
         RaiseEvent WindowSizeChange(m_lWidth, m_lHeight, lOldWidth, lOldHeight)
      End If

   Case WM_DESTROY
      Detach
   End Select
End Function

To test out the project, add a Label control to your project's form.

Private WithEvents m_c As cDisplayChange

Private Sub DisplayInfo()
   Label1.AutoSize = True
   Label1.Caption = "Colour Depth: " & m_c.ColourDepth & _
         vbCrLf & "Size: " & m_c.DisplayWidth & " x " & m_c.DisplayHeight
End Sub

Private Sub Form_Load()
   Set m_c = New cDisplayChange
   m_c.Attach Me.hwnd
   DisplayInfo
End Sub

Private Sub m_c_ColourDepthChange( _
      ByVal lNewBitsPixel As Long, _
      ByVal lOldBitsPixel As Long)
   DisplayInfo
End Sub

Private Sub m_c_WindowSizeChange( _
      ByVal lNewWidth As Long, ByVal lNewHeight As Long, _
      ByVal lOldWidth As Long, ByVal lOldHeight As Long)
   DisplayInfo
End Sub

Run the project. Choose the Windows Display settings setup box. Whenever you change the colour depth or size, and event will fire and the Label on the form will be updated with the new colour depth and screen size.