Option Compare Database
Option Explicit

'空耳工房(http://www.est.hi-ho.ne.jp/soramimi/)さんのソースです。
'設定可能なディスプレイモードを列挙する
Declare Function EnumDisplaySettings Lib "User32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, lpDevMode As DEVMODE) As Long
'画面解像度を変更する
Declare Function ChangeDisplaySettings Lib "User32.dll" Alias "ChangeDisplaySettingsA" (lpDevMode As DEVMODE, ByVal dwflags As Long) As Long
Declare Function ChangeDisplaySettingsByRegistry Lib "User32.dll" Alias "ChangeDisplaySettingsA" (ByVal lpDevMode As Long, ByVal dwflags As Long) As Long

Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32

Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    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 * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer '色数(Bit)
    dmPelsWidth As Long '幅(Pixcel)
    dmPelsHeight As Long '高さ(Pixcel)
    dmDisplayFlags As Long 'フラグ
    dmDisplayFrequency As Long '垂直周波数（リフレッシュレート）
End Type

'ChangeDisplaySettings dmFields 変更する項目
Public Const DM_BITSPERPEL = &H40000 'Bits per pixel
Public Const DM_PELSWIDTH = &H80000 'Pixel width
Public Const DM_PELSHEIGHT = &H100000 'Pixel height
Public Const DM_DISPLAYFLAGS = &H200000 'Mode flags
Public Const DM_DISPLAYFREQUENCY = &H400000 'Mode frequency

'ChangeDisplaySettings Flgs
Public Const CDS_NOUPDATEREGISTRY = &H0 'レジストリを更新しない
Public Const CDS_UPDATEREGISTRY = &H1 'レジストリに更新
Public Const CDS_TEST = &H2 '正しく更新出来るかテストする

'ChangeDisplaySettings戻り値
Public Const DISP_CHANGE_SUCCESSFUL = 0 '即時更新成功
Public Const DISP_CHANGE_RESTART = 1 '再起動の必要あり
Public Const DISP_CHANGE_FAILED = -1 '失敗
Public Const DISP_CHANGE_BADMODE = -2 'サポートされていないディスプレイモード
Public Const DISP_CHANGE_NOTUPDATED = -3 'レジストリ更新失敗
Public Const DISP_CHANGE_BADFLAGS = -4 'フラグにエラー

Public DModeList() As DEVMODE

'---------------------------------------------------------------------------------------------------------------------------------------------------
'Windowsをログオフ／シャットダウン／再起動する
'戻り値     正常終了 = 0以外
'           異常終了 = 0
'---------------------------------------------------------------------------------------------------------------------------------------------------
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
    
Public Const EWX_LOGOFF = 0&    'ログオフ
Public Const EWX_SHUTDOWN = 1&  'シャットダウン
Public Const EWX_REBOOT = 2&    '再起動
Public Const EWX_FORCE = 4&     'プロセスの強制終了
Public Const EWX_POWEROFF = 8&  'シャットダウン後に電源を切る

Public Function Y_EnumDisplaySetting() As Long
'***********************************************************
'機能 : 設定可能なディスプレイモードを列挙する
'戻り値: 件数,DModeList配列にDEVMODEをセット
'***********************************************************

    Dim longret As Long
    Dim strDeviceName As String
    Dim cnt As Long
    Dim DMode As DEVMODE

    DMode.dmSize = Len(DMode)

    cnt = 0
    Do
        longret = EnumDisplaySettings(strDeviceName, cnt, DMode)
        If longret = 0 Then
            Exit Do
        Else
            ReDim Preserve DModeList(cnt)
            DModeList(cnt) = DMode
        End If
        cnt = cnt + 1
    Loop
    Y_EnumDisplaySetting = cnt

End Function


Public Function Y_TestDisplayChange(DMode As DEVMODE) As Long
'***********************************************************
'機能 : 指定した画面解像度が有効かテストする
'引数 : DMode = DEVMODEの構造体
'戻り値: テスト結果
'***********************************************************

    Dim longret As Long

    DMode.dmFields = DM_BITSPERPEL + DM_PELSWIDTH + DM_PELSHEIGHT

    longret = ChangeDisplaySettings(DMode, CDS_TEST)

    Y_TestDisplayChange = longret

End Function


Public Function Y_ChangeDisplayMode(DMode As DEVMODE, SW As Integer) As Long
'***********************************************************
'機能 : 指定した画面解像度に変更する
'引数 : DMode = DEVMODEの構造体
'　　　　SW = 0:レジストリを更新しない 1:する
'戻り値: 実行結果
'***********************************************************

    Dim longret As Long
    Dim flg As Long

    DMode.dmFields = DM_BITSPERPEL + DM_PELSWIDTH + DM_PELSHEIGHT

'設定可能かテストする
    longret = Y_TestDisplayChange(DMode)
    If longret >= 0 Then
        If SW = 1 Then
            flg = CDS_UPDATEREGISTRY
        Else
            flg = CDS_NOUPDATEREGISTRY
        End If

      '解像度変更
        longret = ChangeDisplaySettings(DMode, flg)
    End If
    Y_ChangeDisplayMode = longret

End Function


Public Function Y_ChangeDisplayModeByRegistry() As Long
'***********************************************************
'機能 : レジストリで設定している画面解像度に戻す
'戻り値: 実行結果
'***********************************************************

    Dim longret As Long
    Dim flg As Long

'レジストリで設定している解像度に戻す
'第１引数にNullをセットすると、レジストリ情報に記録されている解像度に変更出来ます。
     longret = ChangeDisplaySettingsByRegistry(ByVal 0&, CDS_NOUPDATEREGISTRY)
    Y_ChangeDisplayModeByRegistry = longret

End Function