この発言は
#00804　佐藤　充男　　　さんの画面解像度の動的変更
に対するコメントです



#804 佐藤　充男 さん




☆説明
以前のサンプルではWin95/98 でリフレッシュレートが元に戻らないのを修正
しました。また、サンプルプログラムを使いやすく書き換えています。

nifty:FDELPHI/MES/16/460 Satobeさんサンプルを元に、動的変更に改良
しました。
Button1 を押すと解像度を６４０×４８０へ、
Button2 を押すと元の解像度に戻ります。
Button3 を押すと元の解像度に戻しフォームを閉じます。

☆準備
　１．フォームにButton1、Button2、Button3 を置く。
　２．フォームの OnCreate、OnCloseQuery イベントとButtonの OnClick
　　　イベントに以下のコードを記述。

☆補足
　・Delphi4で作成、Windows95/98、NT4.0WSで動作確認。
　・解像度切り替えを連続して行うとディスプレイが壊れる危険性があります。
　　パチパチ切りかえるのはやめましょう(^^;

======================================================================
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    procedure GetScreenInfo;
    procedure ChangeVGAScreen;
    procedure ChangeDefaultScreen;
  end;

var
  Form1: TForm1;

implementation

const
  ENUM_CURRENT_SETTINGS  = DWORD(-1);
  ENUM_REGISTRY_SETTINGS = DWORD(-2);
var
  ScrW: Integer;     // Screen Width
  ScrH: Integer;     // Screen Height
  ScrC: Integer;     // Screen Color (Bit/Pixel)
  RRate: Integer;    // Refresh Rate
  ChgFlag: Boolean;  // 変更フラグ
  OSVer: TOSVersionInfo;  // OSバージョン情報

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  GetScreenInfo;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  ChangeDefaultScreen;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ChangeVGAScreen;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ChangeDefaultScreen;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Close;
end;

//----------------------------------------------------------------------
(* 現在の画面情報を得る *)
procedure TForm1.GetScreenInfo;
var
  hDC: THandle;
  DevMode: TDeviceModeA;
begin
  ChgFlag := False;  // 変更なし

  // OSバージョンチェック
  OSVer.dwOSVersionInfoSize := Sizeof(TOSVersionInfo);
  GetVersionEx(OSVer);

  // 画面情報を得る
  hDC := GetDC( 0 );
  try
    ScrW := GetDeviceCaps( hDC, HORZRES );
    ScrH := GetDeviceCaps( hDC, VERTRES );
    ScrC := GetDeviceCaps( hDC, BITSPIXEL ) *
              GetDeviceCaps( hDC, PLANES );
    if OSVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
      // NTなら、現在の垂直リフレッシュレートを得る
      RRate := GetDeviceCaps( hDC, VREFRESH )
    else
    begin
      RRate := 0;
      if (OSVer.dwMajorVersion = 4) and
         (OSVer.dwMinorVersion >= 10 ) then
      begin
        // Win98
        // ENUM_CURRENT_SETTINGS ではリフレッシュレートが'0' に
        // なるのでENUM_REGISTRY_SETTINGS  を使う。
        // HKEY_LOCAL_MACHINE\Config\0001\Display\Settings
        // の RefreshRate  の値を返しているらしい(^^;?
        DevMode.dmSize := Sizeof(TDeviceModeA);
        EnumDisplaySettings(nil, ENUM_REGISTRY_SETTINGS, DevMode);
        RRate := DevMode.dmDisplayFrequency;
      end;
    end;
  finally
    ReleaseDC( 0, hDC );
  end;
end;

(* 解像度をＶＧＡ（６４０ｘ４８０）に変更 *)
procedure TForm1.ChangeVGAScreen;
var
  DevMode: TDeviceModeA;
begin
  // ・VGA はどのパソコンでも存在するモードなので直接値を代入している
  // ・垂直リフレッシュレートについては、現在の解像度とVGA で同じレート
  // 　を持ってない場合があるので、defaultを採用している。
  //   きっちり処理を行いたいのであれば、EnumDisplaySettings API で
  //   各種解像度の情報を得る必要性がある。
  DevMode.dmSize := Sizeof(TDeviceModeA);
  DevMode.dmBitsPerPel := ScrC;
  DevMode.dmPelsWidth  := 640;
  DevMode.dmPelsHeight := 480;
  if OSVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
    // WinNT
    DevMode.dmDisplayFrequency := 0;  // 面倒なのでdefaultを採用
    DevMode.dmFields := DM_PELSWIDTH or
                        DM_PELSHEIGHT or
                        DM_BITSPERPEL or
                        DM_DISPLAYFREQUENCY;
  end
  else
  begin
    // Win95/98
    DevMode.dmFields := DM_PELSWIDTH or
                        DM_PELSHEIGHT or
                        DM_BITSPERPEL;
  end;
  ChangeDisplaySettings(DevMode,0);

  ChgFlag := True;  // 変更あり
end;

(* 元の解像度に戻す *)
procedure TForm1.ChangeDefaultScreen;
var
  DevMode: TDeviceModeA;
begin
  if ChgFlag = False then
    Exit;

  DevMode.dmSize := Sizeof(TDeviceModeA);
  DevMode.dmBitsPerPel := ScrC;
  DevMode.dmPelsWidth  := ScrW;
  DevMode.dmPelsHeight := ScrH;
  if OSVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
    // WinNT
    DevMode.dmDisplayFrequency := RRate;
    DevMode.dmFields := DM_PELSWIDTH or
                        DM_PELSHEIGHT or
                        DM_BITSPERPEL or
                        DM_DISPLAYFREQUENCY;
  end
  else
  begin
    // Win95/98
    DevMode.dmFields := DM_PELSWIDTH or
                        DM_PELSHEIGHT or
                        DM_BITSPERPEL;
  end;
  ChangeDisplaySettings(DevMode,0);
end;

end.
======================================================================

【参考】
nifty:FDELPHI/MES/16/460
　Satobeさんの「画面のモード（解像度や色数）変更」
nifty:FDELPHI/MES/11/4315
　miniminiさん、tacさんの「色数と解像度の変更」
Microsoft Visual Studio6.0 Pro版付属
　MSDNライブラリ
Delphi4 Pro版付属
　Win32SDK ヘルプ


問題点がありましたら、フォローをお願いします。
                              99/2/8(月) 09:35am  LDM03756 佐藤　充男

Original document by 佐藤　充男　　　氏 ID:(LDM03756)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。