'========================================
'= 解像度変更
'=    (ChangeDisplaySettingsEx.bas)
'========================================
#include "Windows.bi"

#define CCDEVICENAME 32                 'デバイス名の長さを示す定数
#define CCFORMNAME 32                   'フォーム名の長さを示す定数
#define CDS_TEST &H4                    'テストモードにする

Type DISPLAY_DEVICE
    cb           As Long
    DeviceName   As String * 32
    DeviceString As String * 128
    StateFlags   As Long
    DeviceID     As String * 128
    DeviceKey    As String * 128
End Type

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 Long
    dmPelsWidth        As Long
    dmPelsHeight       As Long
    dmDisplayFlags     As Long
    dmDisplayFrequency As Long
    dmICMMethod        As Long   'NT 4.0
    dmICMIntent        As Long   'NT 4.0
    dmMediaType        As Long   'NT 4.0
    dmDitherType       As Long   'NT 4.0
    dmReserved1        As Long   'NT 4.0
    dmReserved2        As Long   'NT 4.0
    dmPanningWidth     As Long   'Win2000
    dmPanningHeight    As Long   'Win2000
End Type

' ディスプレイの設定を変更
Declare Function Api_ChangeDisplaySettingsEx& Lib "user32" Alias "ChangeDisplaySettingsExA" (lpszDeviceName As Any, lpDevMode As Any, ByVal hWnd&, ByVal dwFlags&, lParam As Any)

' ディスプレイに関する情報を取得
Declare Function Api_EnumDisplayDevices& Lib "user32" Alias "EnumDisplayDevicesA" (Unused As Any, ByVal iDevNum&, lpDisplayDevice As DISPLAY_DEVICE, ByVal dwFlags&)

#define ENUM_CURRENT_SETTINGS -1        'ディスプレイ解像度の現在の設定値を求める
#define DM_BITSPERPEL &H40000           '
#define DM_PELSWIDTH &H80000            '
#define DM_PELSHEIGHT &H100000          '
#define vbCrLf Chr$(13, 10)

Var Shared Edit1 As object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14

Var Shared OldX As Long
Var Shared OldY As Long

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var DD As DISPLAY_DEVICE
    Var DM As DEVMODE
    Var Ret As Long

    DD.cb = Len(DD)

    '解像度を取得しておく
    OldX = GetDeviceCaps(8)
    OldY = GetDeviceCaps(10)

    Ret = Api_EnumDisplayDevices(ByVal 0&, 0, DD, ByVal 0&)

    'ディスプレイに関する情報があるとき
    If Ret <> 0 Then
        txt$ = txt$ & "Device String:" & Left$(DD.DeviceString, InStr(1, DD.DeviceString, Chr$(0)) - 1) & vbCrLf
        txt$ = txt$ & "Device Name  :" & Left$(DD.DeviceName, InStr(1, DD.DeviceName, Chr$(0)) - 1) & vbCrLf
        txt$ = txt$ & "Device Key   :" & Left$(DD.DeviceKey, InStr(1, DD.DeviceKey, Chr$(0)) - 1) & vbCrLf
        txt$ = txt$ & "Device ID    :" & Left$(DD.DeviceID, InStr(1, DD.DeviceID, Chr$(0)) - 1)
        Edit1.SetWindowText txt$
    Else
        Edit1.SetWindowText "エラー"
    End If

    DM.dmSize = Len(DM)

    DM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    DM.dmPelsWidth = 640
    DM.dmPelsHeight = 480

    '解像度を640x480に設定
    Ret = Api_ChangeDisplaySettingsEx(ByVal 0&, DM, ByVal 0&, CDS_TEST, ByVal 0&)

    '5秒後
    Wait 500
    DM.dmPelsWidth = OldX
    DM.dmPelsHeight = OldY

    '起動時の解像度に設定
    Ret = Api_ChangeDisplaySettingsEx(ByVal 0&, DM, ByVal 0&, CDS_TEST, ByVal 0&)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End