API To Alter Screen Resolution Settings.

[Ed2020]

The following code will alter a user's screen resolution settings. Can be used to ensure a database looks the same on any machine. Read code comments to see what functions to use...........

Option Compare Database
Option Explicit

'Alters the user's desktop screen resolution to best fit the database. Records previous
'settings so they can be reset on database shutdown
'Use AlterDesktopRes procedure to set the user's screen res.
'Use ResetDesktopToDefault procedure to reset screen res. to previos settings
'Ensure any new settings are valid for the user's machine!!
'API source code origin unknown.
'Edited by Ed Metcalfe 16/11/2001.

'Declarations for current desktop settings.
Public Const WM_HORZRES = 8
Public Const WM_VERTRES = 10
Public Declare Function WM_apiGetDesktopWindow Lib "USER32" Alias "GetDesktopWindow" () As Long
Public Declare Function WM_apiGetDC Lib "USER32" Alias "GetDC" (ByVal hWnd As Long) As Long
Public Declare Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public intOrigH As Integer
Public intOrigV As Integer

'Declarations for desktop res. alteration.
Public Declare Function EnumDisplaySettings Lib "USER32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Public Declare Function ChangeDisplaySettings Lib "USER32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
Public Const CCDEVICENAME = 32
Public Const CCFORMNAME = 32
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public DevM As DEVMODE

Public Function GetResH()
'Returns the horizontal screen resolution
'Simplified by J Cunningham 19012000

Dim hDesktopWnd As Long
Dim hDCcaps As Long

hDesktopWnd = WM_apiGetDesktopWindow()
hDCcaps = WM_apiGetDC(hDesktopWnd) 'get display context for desktop

GetResH = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES)

End Function

Public Function GetResV()
'Returns the vertical screen resolution
'Simplified by J Cunningham 19012000

Dim hDesktopWnd As Long
Dim hDCcaps As Long

hDesktopWnd = WM_apiGetDesktopWindow()
hDCcaps = WM_apiGetDC(hDesktopWnd) 'get display context for desktop

GetResV = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES)

End Function

Public Sub AlterDesktopRes(intNewH As Integer, intNewV As Integer)
Dim a As Boolean
Dim i&

intOrigH = GetResH
intOrigV = GetResV

i = 0
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)
Dim b&

DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT

DevM.dmPelsWidth = intNewH
DevM.dmPelsHeight = intNewV

b = ChangeDisplaySettings(DevM, 0)
End Sub

Public Sub ResetDesktopToDefault()
Dim a As Boolean
Dim i&
i = 0
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)
Dim b&

DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT

DevM.dmPelsWidth = intOrigH
DevM.dmPelsHeight = intOrigV

b = ChangeDisplaySettings(DevM, 0)
End Sub