The new vbAccelerator Site - more VB and .NET Code and Controls

Detecting Display Size or System Colour Depth Changes

Author:

Steve McMahon(steve@vbaccelerator.com)

Keywords:

API,Subclassing,Windows

Updated:

18/08/99

Other Tips
All Tips
By Date
By Subject


API (33)
Bit
Manipulation (3)

Clipboard (3)
Combo
Box (5)

Desktop (3)
GDI (13)
Graphics (13)
Internet (2)
Interprocess
Comms (3)

Keyboard (2)
Mouse (1)
Shell (1)
Sprites (1)
Subclassing (3)
Text
Box (2)

Windows (11)
Windows
Controls (10)



Submit


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 SSubTmr.DLL, 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)" in the references list. If it is there, select it and click ok. If it isn't, choose Browse, locate SSubTmr.DLL 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.


&nbsp

Related Tips and Articles:

&nbsp

AboutContributeSend FeedbackPrivacy

Copyright 1998-1999, Steve McMahon ( steve@vbaccelerator.com). All Rights Reserved.
Last updated: 18/08/99