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

#define CCHDEVICENAME 32                'デバイス名の長さを示す定数
#define CCHFORMNAME 32                  'フォーム名の長さを示す定数
#define ENUM_CURRENT_SETTINGS -1        'ディスプレイ解像度の現在の設定値を求める
#define DM_BITSPERPEL &H40000           '
#define DM_PELSWIDTH &H80000            '
#define DM_PELSHEIGHT &H100000          '

Type DEVMODE
    dmDeviceName       As String * 32   'ドライバがサポートするデバイス名
    dmSpecVersion      As Integer       '構造体の基準になった初期化データ仕様のバージョン番号
    dmDriverVersion    As Integer       'プリンタドライバのバージョン番号
    dmSize             As Integer       'この構造体のサイズ(バイト単位)
    dmDriverExtra      As Integer       'この構造体に続くドライバ データのバイト数
    dmFields           As Long          '
    dmOrientation      As Integer       'DMORIENT_PORTRAIT(縦置き)、DMORIENT_LANDSCAPE(横置き)
    dmPaperSize        As Integer       '用紙サイズ
    dmPaperLength      As Integer       'dmPaperSizeメンバで指定した用紙の長さをオーバーライド
    dmPaperWidth       As Integer       'dmPaperSizeメンバで指定した用紙の幅をオーバーライド
    dmScale            As Integer       '印刷出力をスケーリングするときの、スケーリング係数
    dmCopies           As Integer       'デバイスが複数の部数に対応する場合、印刷する部数
    dmDefaultSource    As Integer       '予約済み(0)
    dmPrintQuality     As Integer       'プリンタの解像度(ドット/インチ)
    dmColor            As Integer       'カラープリンタの場合(DMCOLOR_COLOR･DMCOLOR_MONOCHROME)
    dmDuplex           As Integer       '両面印刷が可能なプリンタ(DMDUP_SIMPLEX･DMDUP_HORIZONTAL･DMDUP_VERTICAL)
    dmYResolution      As Integer       'プリンタのy方向の解像度(ドット/インチ)
    dmTTOption         As Integer       'TrueTypeフォントの印刷方法
    dmCollate          As Integer       '複数部数を印刷するときにページ順にそろえるかどうか
    dmFormName         As String * 32   'フォーム名を指定
    dmUnusedPadding    As Integer       '使用しない
    dmBitsPerPixel     As Long          'ディスプレイ デバイスの解像度をピクセルあたりのビット数で指定
    dmPelsWidth        As Long          '可視のデバイスの表面の幅をピクセル単位で指定
    dmPelsHeight       As Long          '可視のデバイスの表面の高さをピクセル単位で指定
    dmDisplayFlags     As Long          'デバイスのディスプレイ モードを指定
    dmDisplayFrequency As Long          'ディスプレイデバイスのリフレッシュレート(垂直同期周波数)を1秒当たりのサイクル数(Hz)で指定
End Type

' ディスプレイデバイスのいずれかのグラフィックスモードに関する情報を取得
Declare Function Api_EnumDisplaySettings& Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName$, ByVal dwModeNum&,lpDevMode As DEVMODE)

' ディスプレイの解像度を変更
Declare Function Api_ChangeDisplaySettings& Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As DEVMODE, ByVal dwFlags&)

Var shared List1 As Object
Var shared Text1 As Object
Var shared Button1 As Object

List1.Attach GetDlgItem("List1") : List1.SetFontSize 14
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var shared  dm As DEVMODE
Var shared  ColorBit As Long
Var shared  DspWidth As Long
Var shared  DspHeight As Long
Var shared  LngNow As Long

'================================================================
'=
'================================================================
Declare Sub Info_Get edecl ()
Sub Info_Get()
    LngNow = Api_EnumDisplaySettings&(ByVal 0 , ENUM_CURRENT_SETTINGS , dm)

    If dm.dmFields And DM_BITSPERPEL Then ColorBit = dm.dmBitsPerPixel
    If dm.dmFields And (DM_PELSWIDTH Or DM_PELSHEIGHT) Then DspWidth = dm.dmPelsWidth : DspHeight = dm.dmPelsHeight

    Text1.SetWindowText "現在の解像度：" & Trim$(str$(DspWidth)) & " x " & Trim$(str$(DspHeight)) & " " & str$(ColorBit) & " ﾋﾞｯﾄ" & str$(dm.dmDisplayFrequency) & "Hz"
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var i As Integer

    For i = 0 To 64
        If Api_EnumDisplaySettings(ByVal 0, i, dm) = 1 Then
            ZD1$ = Format$(i, "##  ")
            ZD2$ = Format$(dm.dmPelsWidth, "#### × ")
            ZD3$ = Format$(dm.dmPelsHeight, "####  ")
            ZD4$ = Format$(dm.dmBitsPerPixel, "## ﾋﾞｯﾄ  ")
            ZD5$ = Format$(dm.dmDisplayFrequency, "### Hz")
            List1.ADDSTRING ZD1$ & ZD2$ & ZD3$ & ZD4$ & ZD5$
        End If
    Next

    Info_Get
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    If Api_EnumDisplaySettings(ByVal 0, List1.GetCursel, dm) = 1 Then
        RC = Api_ChangeDisplaySettings(dm, 0)
    End If

    Info_Get
End Sub

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