Option Explicit

'Tova e v modul

Declare Function ChangeDisplaySettings Lib "user32.dll" _

Alias "ChangeDisplaySettingsA" _

(lpDevMode As Any, ByVal dwFlags As Long) As Long

Public Declare Function EnumDisplaySettings Lib "user32.dll" _

Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, _

ByVal iModeNum As Long, lpDevMode As DEVMODE) As Long



Public Type DEVMODE

  dmDeviceName As String * 32

  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 * 32

  dmUnusedPadding As Integer

  dmBitsPerPixel As Integer

  dmPelsWidth As Long

  dmPelsHeight As Long

  dmDisplayFlags As Long

  dmDisplayFrequency As Long

  dmICMMethod As Long

  dmICMIntent As Long

  dmMediaType As Long

  dmDitherType As Long

  dmReserved1 As Long

  dmReserved2 As Long

  dmPanningWidth As Long

  dmPanningHeight As Long

End Type



Const CDS_UPDATEREGISTRY = &H1

Const CDS_TEST = &H2

Const CDS_FULLSCREEN = &H4

Const CDS_GLOBAL = &H8

Const CDS_SET_PRIMARY = &H10

Const CDS_RESET = &H40000000

Const CDS_SETRECT = &H20000000

Const CDS_NORESET = &H10000000

Const DISP_CHANGE_SUCCESSFUL = 0

Const DISP_CHANGE_RESTART = 1

Const DISP_CHANGE_FAILED = -1

Const DISP_CHANGE_BADMODE = -2

Const DISP_CHANGE_NOTUPDATED = -3

Const DISP_CHANGE_BADFLAGS = -4

Const DISP_CHANGE_BADPARAM = -5

Public Const ENUM_CURRENT_SETTINGS = -1

Public dm As DEVMODE



Public Sub ChangeResolution(ByVal Wdth As Long, ByVal Hght As Long)

  Dim Lrst As Long

  If Wdth <> 0 And Hght <> 0 Then

    Lrst = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, dm)

    With dm

      .dmPelsWidth = Wdth

      .dmPelsHeight = Hght

    End With

    Lrst = ChangeDisplaySettings(dm, CDS_RESET)

    If Lrst <> 0 Then

      Select Case Lrst

        Case DISP_CHANGE_RESTART

          MsgBox "System restart!", vbInformation, "System Message"

        Case DISP_CHANGE_FAILED

          MsgBox "Change Resolution Failed!", vbCritical, "System Message"

        Case DISP_CHANGE_BADMODE

          MsgBox "Bad Mode", vbCritical, "System Message"

        Case DISP_CHANGE_NOTUPDATED

          MsgBox "Bad Mode", vbCritical, "System Message"

        Case DISP_CHANGE_BADPARAM

          MsgBox "Bad Parameters", vbCritical, "System Message"

      End Select

    End If

  Else

    Exit Sub

  End If

End Sub

Редактирано от Щиpлиц на 25.03.04 00:31.