| EnumDisplaySettings, ChangeDisplaySettings |
| |
| |
| Private Declare Function EnumDisplaySettings Lib "user32" Alias _ |
| "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, _ |
| ByVal iModeNum As Long, lpDevMode As Any) As Boolean |
|
| Private Declare Function ChangeDisplaySettings Lib "user32" Alias _ |
| "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long |
| |
| Const CCDEVICENAME = 32 | |
| Const CCFORMNAME = 32 | |
| Const DM_PELSWIDTH = &H80000 | |
| Const DM_PELSHEIGHT = &H100000 | |
| |
| 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 | |
| |
| Dim DevM As DEVMODE | |
| |
| 'Comments : Allows changing of screen resolution in Win95 |
| 'Example: Call ChangeScreenResolution(800,600) |
| 'Parameters: iWidth, iheight: integer values of resolution |
| 'Sets : Requested screen resolution or if screen is already at resolution returns true |
| 'Returns : None |
| |
| Private Sub ChangeScreenResolution(iWidth As Single, iHeight As Single) |
| Dim a As Boolean | |
| Dim i& | |
| Dim b& | |
| i = 0 | |
| Do | |
| a = EnumDisplaySettings(0&, i&, DevM) | |
| i = i + 1 | |
| Loop Until (a = False) | |
| |
| DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT | |
| DevM.dmPelsWidth = iWidth | |
| DevM.dmPelsHeight = iHeight | |
| b = ChangeDisplaySettings(DevM, 0) | |
| End Sub | |
| |
| Sub ChangeTo800() | |
| Call ChangeScreenResolution(800, 600) | |
| End Sub | |
| |
zurück