- PR -

ChangeDisplaySettingsで解像度の変更

1
投稿者投稿内容
あーちゃん
会議室デビュー日: 2008/09/22
投稿数: 2
投稿日時: 2008-09-22 19:12
Access2007で開発を行っています。

API関数「ChangeDisplaySettings」を使って、解像度の変更を行いたいのですが、
必ず、DISP_CHANGE_FAILED(設定に失敗しました)が返ってきてしまいます。
その原因がわからず、途方に暮れております。

以下が、私が記述した解像度変更部分のプログラムの内容です。

Option Compare Database
Option Explicit

'解像度の変更
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const CDS_UPDATEREGISTRY = &H1&
Private Const CDS_TEST = &H4&
Private Const DISP_CHANGE_SUCCESSFUL = 0&
Private Const DISP_CHANGE_RESTART = 1&

Private Type DEVMODE '定義を簡略化しています。
dmDeviceName(0 To 7) As Long
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dummy(0 To 29) As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" ( _
ByVal lpszDeviceName As Long, _
ByVal iModeNum As Long, _
ByRef lpDevMode As Any) As Long

Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" ( _
ByRef lpDevMode As Any, _
ByVal dwFlags As Long) As Long

Public Sub JSyoriStart(MENU_TAG As String)
'解像度の変更(800*600 32bit)
Call Com_ChangeDisplay(1)
End Sub

Public Function Com_EnumDisplaySetting()
'***********************************************************
'機能 : 設定可能なディスプレイモードを列挙する
'戻り値: DModeList配列にDEVMODEをセット
'***********************************************************
Dim dm As DEVMODE
Dim i As Long
i = 0
Do Until EnumDisplaySettings(0, i, dm) = 0
i = i + 1
Loop

End Function

Sub Com_ChangeDisplay(p_Flag As Long)
'***********************************************************
'機能 : 指定した画面解像度に変更する
'引数 : p_Flag = 変更する解像度のパターン№
'戻り値: 実行結果
'***********************************************************
Dim p_Width As Long
Dim p_Height As Long
Dim p_BitsPerPel As Integer
Dim p_Ret As Long
Dim dm As DEVMODE

Select Case p_Flag
Case 1
p_Width = 800
p_Height = 600
Case 2
p_Width = 1280
p_Height = 1024
End Select

p_BitsPerPel = 32

'解像度の変更
dm.dmSize = Len(dm)
dm.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
dm.dmPelsWidth = p_Width
dm.dmPelsHeight = p_Height
dm.dmBitsPerPel = p_BitsPerPel
p_Ret = ChangeDisplaySettings(dm, CDS_TEST)

Select Case p_Ret
Case DISP_CHANGE_SUCCESSFUL
i = MsgBox("OK", vbOKOnly)
Case Else
i = MsgBox("NG", vbOKOnly)
End Select

End Sub

どなたかご教授下さい。
　よろしくお願い致します。
1

スキルアップ／キャリアアップ（JOB@IT）