| :: Check and Change the current Video Resolution in run time |
Author |
David Costelloe |
Language |
VB5, VB6 |
Operating
Systems |
Windows 95, 98 and NT |
| API
Declarations |
Option Explicit
'Declares:
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32.dll" Alias
"EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long,
lpDevMode As Any) As Boolean
Public Declare Function ChangeDisplaySettings Lib "user32.dll" 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 DevChg As DEVMODE |
| Module |
'place this in a .bas file:
Public Sub ChangeRes(iWidth As Single, iHeight As Single)
Dim a As Boolean
Dim i&
i = 0
Do
a = EnumDisplaySettings(0&, i&, DevChg)
i = i + 1
Loop Until (a = False)
Dim b&
DevChg.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevChg.dmPelsWidth = iWidth
DevChg.dmPelsHeight = iHeight
b = ChangeDisplaySettings(DevChg, 0)
End Sub |
| Usage |
'Usage:
Public Sub CheckRes()
Dim X As Long, Y As Long
Dim MsgTitle As String
Dim MsgStyle As Long
Dim Msg As String
Dim MsgResponse As Long
Y = GetSystemMetrics(0)
X = GetSystemMetrics(1)
If X < 600 And Y < 800 Then
MsgTitle = "Invalid Resolution"
MsgStyle = vbYesNo + vbCritical
Msg = "You current video resolution is:
" & Y & " X " & X & vbCrLf
Msg = Msg & "This program requires a
resolution 800 x 600 or greater." & vbCrLf & vbCrLf
Msg = Msg & "Do you wish me to adjust
your resolution to 800x600?"
MsgResponse = MsgBox(Msg, MsgStyle, MsgTitle)
If MsgResponse = vbYes Then
Call ChangeRes(800,
600)
End
End If
End If
End Sub |
|
 |
|
|
Home
Video, Bitmaps and Colors Tips
Previous Tip
Next Tip
14-11-2007 
11-08-2006 
