Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2013年09月19日] [更新 2016年04月08日] Delphi サンプルプログラム集
   
020_画面 ( ディスプレイ ) の解像度の取得と変更
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
020_DisplayResolution.zip [6,612 KB] 2016年04月08日版(EXE同梱)



  • 2013年09月27日
  • 画面の解像度等を取得コードの間違いを修正.TMonitorInfoEx 構造体の初期化の前にメンバーに値を代入してしまっていた
  • 2013年11月07日
  • WMI を使用した方法の記事と,画面サイズを mm 単位で取得するサンプルを追加
  • 2016年04月09日
  • 実際にマルチモニタを構成した結果と,そのためのコード修正変更.記事も更新




画面 ( ディスプレイ・モニタ ) の解像度


ディスプレイあるいはモニタの解像度の取得と設定,変更のサンプルです.Windows 7 では「画面の解像度」の設定のことになります.
解像度の変更時に設定可能な項目は,幅と高さ,つまり,横方向と縦方向の解像度 (ピクセル数),ビット数での色深度,リフレッシュレートの周波数ですが,ビット数とリフレッシュレートを指定すると画面が乱れる場合がありました.

[備考 1]
MSDN オンラインの最近の記事は,Minimum supported client (サポートする Windows の最低バージョン) の項が Windows XP (場合によっては 2000) になっていますが,実際には Windows 9X でも使用可能な関数類は多くあります.
本ページの,画面解像度取得と設定の関数も,必要があって,Windows 98 の時代に使用したことがあります.今回,コミュニティの場で,関連発言を見つけたので記事にしてみましたが,Windows 98 の時とは少し動作仕様が異なっているようです.

[備考 2]
本ページの記事では単に「解像度」と書いていますが,「画面解像度」のことです.
画像等の解像度は,DPI,インタ当たりのピクセル数 (画素数) を意味することが多いのですが,ディスプレイの「画面解像度」は,画面のピクセル数の意味で使用されています.もちろん (ピクセル数で表した) サイズと言うこともあります.
ディスプレイの場合,DPI は画素密度ということになります.画像の DPI も画素密度であることは間違いありません.




01_画面の解像度等の取得とマルチモニタ関係の関数


Button1クリックは,仮想画面のサイズを取得するサンプルです.
仮想画面とは,全てのモニタの画面を含む画面のことです.GetSystemMetrics 関数を使用すると取得できます.シングルモニタの場合の仮想画面のサイズは,そのモニタのサイズです.


図1
シングルモニタの場合

下図は,プライマリモニタ (プライマリディスプレイ) の右側に別のモニタを配置した場合です.
プライマリモニタの左上が座標 (0, 0) となります.マルチモニタの構成では,プライマリモニタの左上が,常に (0, 0) となります.プライマリモニタは,[画面の解像度] の設定ダイアログで 1 と表示されているモニタです.
下図に示すモニタの配置では,横のサイズ (横方向の解像度) は 2 つのモニタの合計となります.


図2
プライマリモニタの右に別モニタを配置

別のモニタを左側に配置した場合です.
仮想画面のサイズは上の場合と同じです.プライマリモニタの左上が常に (0, 0) ですから,下図のモニタの配置では,左側のモニタの X 座標値は常に負の値となります.

プライマリモニタの左端より左側の X 座標値は負の値になります.また,プライマリモニタの上端より上側の Y 座標の値は負の値になります.



図3
プライマリモニタの左に別モニタを配置
  • プライマリモニタの左上は常に (0, 0)
  • 左のモニタの X 座標値は負の値になる

下図は,Button2 クリックの実行結果です.
各モニタのデバイスコンテキストから GetDeviceCaps でモニタの情報を取得します.GetDeviceCaps 関数を使用すると,ディスプレイの現在の色深度 (ビット数),リフレッシュレートを取得することができます.
モニタ数 (ディスプレイの数) は,TScreen の MonitorCount プロパティから取得しています.


[備考]
Button2 クリック以降では,TScreen を使用しています.
TScreen は,実行中に,モニタの解像度やモニタ数,モニタの配置に変更があると,その状態を正常に検出してくれません.この現象を回避するには,以下の方法が考えられます.
本サンプルでは,TScreen のインスタンスを実行時に生成して回避していますが,TScreen のグローバル変数 Screen はアプリケーション全体に対してグローバルです.影響があるかも知れません.
  • (1) EXE を一度終了し,再度起動する
  • (2) TScreen のインスタンスを実行時に生成する
  • (3) TScreen を使用しないで,EnumDisplayDevices 関数を使用する
  • (4) TApplicationEvents の OnSettingChange イベントで SPI_SETWORKAREA を検出する
  • (5) WM_DISPLAYCHANGE メッセージで処理する (筆者はテストしていない)
(4) (5) は,モニタ数やモニタの位置,あるいはモニタの解像度に変化があった場合に何かしらの操作が必要な場合に有効な方法です.単にモニタの情報を取得して操作する場合は主に (2) の方法となると思われます.


CreateDC の第 2 引数の値を nil にすると,仮想画面に相当するモニタのデバイスコンテキストが取得できます.ただし,このデバイスコンテキストの値を使用しても, GetDeviceCaps 関数ではプライマリモニタの情報しか取得できません.

      LMonitorDC := CreateDC('DISPLAY', nil, nil, nil);



図4
モニタの色深度等の取得

下図は,各モニタのハンドルから TMonitorInfoEx 構造体のメンバの値を取得した結果です.
モニタごとの位置やサイズの値は TMonitorInfoEx 構造体のメンバから取得できます.


図5
TMonitorInfoEx 構造体のメンバから取得
  • プライマリモニタの左側にモニタを追加したので,2 番目のモニタの X 座標値は負の値となる

TScreen には Monitors プロパティあります.このプロパティのメンバからも各モニタの解像度等が取得することができます.下図はその結果です.結果は TMonitorInfoEx 構造体から取得した値と全く同じになります.


図6
TScreen.Monitors を使用した結果

リスト1
画面 (ディスプレイ) の解像度等を取得
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  MultiMon;

{$R *.dfm}

//=============================================================================
//  画面(ディスプレイ)の解像度等を取得
//  GetSystemMetricst関数を使用して,仮想画面全体のサイズを取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMonitorCnt     : Integer;
  LDeskTop_Top    : Integer;
  LDeskTop_Left   : Integer;
  LDeskTop_Width  : Integer;
  LDeskTop_Height : Integer;
  LDeskTop_Right  : Integer;
  LDeskTop_Bottom : Integer;
  LText           : string;
begin
  //仮想画面全体(全てのモニタ画面)サイズを取得
  LMonitorCnt     := GetSystemMetrics(SM_CMONITORS);
  LDeskTop_Top    := GetSystemMetrics(SM_YVIRTUALSCREEN);
  LDeskTop_Left   := GetSystemMetrics(SM_XVIRTUALSCREEN);
  LDeskTop_Width  := GetSystemMetrics(SM_CXVIRTUALSCREEN);
  LDeskTop_Height := GetSystemMetrics(SM_CYVIRTUALSCREEN);
  LDeskTop_Right  := LDeskTop_Left + LDeskTop_Width;
  LDeskTop_Bottom := LDeskTop_Top  + LDeskTop_Height;

  LText := 'モニタの数 : ' + IntToStr(LMonitorCnt)  + sLineBreak
         + '横ピクセル : ' + IntToStr(LDeskTop_Width)  + sLineBreak
         + '縦ピクセル : ' + IntToStr(LDeskTop_Height) + sLineBreak
         + '左上座標   : ' + '( ' + IntToStr(LDeskTop_Left) + ', '
                                  + IntToStr(LDeskTop_Top) + ' )' + sLineBreak
         + '右下座標   : ' + '( ' + IntToStr(LDeskTop_Right) + ', '
                                  + IntToStr(LDeskTop_Bottom) + ' )';

  MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
end;

//=============================================================================
//  画面(ディスプレイ)の解像度等を取得
//  各ディスプレイ(モニタ)のデバイスコンテキストから取得するサンプル
//
//  TScreenでは,モニタの数や位置,解像度が変化した場合に正しく取得できない
//  本サンプルでは,その現象を回避するためにTScreenを実行時に生成している
//
//  TMonitorInfoExの使用には,usesにMultiMonが必要
//  i番目のモニタのハンドルはScreen.Monitors[i].Handleで取得する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LScreen        : TScreen;
  LMonitorCnt    : Integer;
  LMonitorInfoEx : TMonitorInfoEx;
  LMonitorDC     : HDC;
  LXResolution   : Integer;
  LYResolution   : Integer;
  LColorsBits    : Integer;
  LRefresh       : Integer;
  LText         : string;
  i              : Integer;
begin
  LScreen := TScreen.Create(Self);
  try
    LMonitorCnt := LScreen.MonitorCount;

    for i := 0 to LMonitorCnt - 1 do begin
      //TMonitorInfoExレコードの初期化
      FillChar(LMonitorInfoEx, SizeOf(TMonitorInfoEx), #0);
      LMonitorInfoEx.cbSize := SizeOf(LMonitorInfoEx);

      //モニターのデバイスコンテキストを取得
      LMonitorDC := CreateDC('DISPLAY', LMonitorInfoEx.szDevice, nil, nil);
      try
        //横と縦の解像度と色ビット数とリフレッシュレートを取得
        LXResolution := GetDeviceCaps(LMonitorDC, HORZRES);
        LYResolution := GetDeviceCaps(LMonitorDC, VERTRES);
        LColorsBits  := GetDeviceCaps(LMonitorDC, BITSPIXEL);
        LRefresh     := GetDeviceCaps(LMonitorDC, VREFRESH);

        LText := 'ディスプレイ ' + IntToStr(i) + sLineBreak
               + '横ピクセル : ' + IntToStr(LXResolution) + sLineBreak
               + '縦ピクセル : ' + IntToStr(LYResolution) + sLineBreak
               + '色ビット数 : ' + IntToStr(LColorsBits) + sLineBreak
               + 'リフレッシュレート : ' + IntToStr(LRefresh);

        MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
      finally
        DeleteDC(LMonitorDC);
      end;
    end;
  finally
    FreeAndNil(LScreen);
  end;
end;

//=============================================================================
//  画面(ディスプレイ)の解像度を取得
//  TMonitorInfoExのプロパティを使用するコード
//  各モニタのデバイスコンテキストの値が必要ない
//  各モニタのハンドルを使用する
//
//  TScreenでは,モニタの数や位置,解像度が変化した場合に正しく取得できない
//  本サンプルでは,その現象を回避するためにTScreenを実行時に生成している
//
//  TMonitorInfoExの使用には,usesにMultiMonが必要
//  i番目のモニタの情報はScreen.Monitors[i]で取得する
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LScreen        : TScreen;
  LMonitorCnt    : Integer;
  LMonitorInfoEx : TMonitorInfoEx;
  LXResolution   : Integer;
  LYResolution   : Integer;
  LText          : string;
  i              : Integer;
begin
  LScreen := TScreen.Create(Self);
    try
    LMonitorCnt := LScreen.MonitorCount;

    for i := 0 to LMonitorCnt - 1 do begin
      //TMonitorInfoExレコードの初期化
      FillChar(LMonitorInfoEx, SizeOf(TMonitorInfoEx), #0);
      LMonitorInfoEx.cbSize := SizeOf(LMonitorInfoEx);

      //モニタの情報を取得
      GetMonitorInfo(LScreen.Monitors[i].Handle, @LMonitorInfoEx);

      LXResolution := LMonitorInfoEx.rcMonitor.Right  - LMonitorInfoEx.rcMonitor.Left;
      LYResolution := LMonitorInfoEx.rcMonitor.Bottom - LMonitorInfoEx.rcMonitor.Top;

      LText := 'ディスプレイ '  + IntToStr(i) + sLineBreak
             + '横ピクセル : '  + IntToStr(LXResolution) + sLineBreak
             + '縦ピクセル : '  + IntToStr(LYResolution) + sLineBreak
             + '左端 X 座標 : ' + IntToStr(LMonitorInfoEx.rcMonitor.Left) + sLineBreak
             + '上端 Y 座標 : ' + IntToStr(LMonitorInfoEx.rcMonitor.Top) + sLineBreak
             + '右端 X 座標 : ' + IntToStr(LMonitorInfoEx.rcMonitor.Right) + sLineBreak
             + '下端 Y 座標 : ' + IntToStr(LMonitorInfoEx.rcMonitor.Bottom);

      MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
    end;
  finally
    FreeAndNil(LScreen);
  end;
end;

//=============================================================================
//  画面(ディスプレイ)の解像度を取得
//  TScreen変数の関数やプロパティだけを使用した例
//
//  TScreenでは,モニタの数や位置,解像度が変化した場合に正しく取得できない
//  その現象を回避するには以下の方法がある
//  (1) EXEを一度終了し,再度起動する
//  (2) TScreen変数を実行時に生成する
//  (3) WM_DISPLAYCHANGEメッセージで処理する(筆者は動作確認していない)
//
//  以下のコードは(2)の方法を使用したサンプル
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  LScreen     : TScreen;
  LMonitorCnt : Integer;
  LMonitor    : TMonitor;
  LText       : string;
  i           : Integer;
begin
  LScreen := TScreen.Create(Self);
  try
    LMonitorCnt := LScreen.MonitorCount;
    for i := 0 to LMonitorCnt - 1 do begin
      LMonitor := LScreen.Monitors[i];

      LText := 'ディスプレイ '  + IntToStr(i) + sLineBreak
             + '横ピクセル : '  + IntToStr(LMonitor.Width) + sLineBreak
             + '縦ピクセル : '  + IntToStr(LMonitor.Height) + sLineBreak
             + '左端 X 座標 : ' + IntToStr(LMonitor.Left) + sLineBreak
             + '上端 Y 座標 : ' + IntToStr(LMonitor.Top)  + sLineBreak
             + '右端 X 座標 : ' + IntToStr(LMonitor.Left  + LMonitor.Width) + sLineBreak
             + '下端 Y 座標 : ' + IntToStr(LMonitor.Top   + LMonitor.Height);

      MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
    end;
  finally
    FreeAndNil(LScreen);
  end;
end;

end.


マルチモニタの場合,ウィンドウハンドル,マウスカーソルの位置,あるいは,矩形領域からモニタを取得する関数が Windows API があります.以下のリンクを参考にしてください.
下のコードは,現在マウスカーソルがあるモニタのハンドルを取得し,モニタの情報が格納されている TMonitorInfoEx レコード型の値と,モニタのデバイスコンテキストの値を取得する例です.


リスト2
procedure TForm1.Button1Click(Sender: TObject);
var
  LCurPos        : TPoint;
  LMonitorHandle : HMONITOR;
  LMonitorInfoEx : TMonitorInfoEx;
  LMonitorDC     : HDC;
begin
  GetCursorPos(LCurPos);
  LMonitorHandle := MonitorFromPoint(LCurPos, MONITOR_DEFAULTTONEAREST);

  //TMonitorInfoExレコードの初期化
  FillChar(LMonitorInfoEx, SizeOf(TMonitorInfoEx), #0);
  LMonitorInfoEx.cbSize := SizeOf(LMonitorInfoEx);
  //モニタの情報を取得
  GetMonitorInfo(LMonitorHandle, @LMonitorInfoEx);

  //モニターのデバイスコンテキストを取得
  LMonitorDC := CreateDC('DISPLAY', LMonitorInfoEx.szDevice, nil, nil);
  try
    //モニターのデバイスコンテキストを使用するコード
  finally
    DeleteDC(LMonitorDC);
  end;
end;


Delphi には,上記の Windows API と同じ名前の関数類が TScreen 変数にあります.デバイスコンテキスト等が必要なければ,こちらの方が便利です.
次のコードは,現在マウスカーソルがあるモニタの左端の X 座標値を取得して表示します. TScreenは,EXE の実行中にモニタの数や位置,解像度が変化した場合に正しく取得できません.上のサンプルの記事を参考にしてください.

TForm の Monitor プロパティを使用すると,対象フォームを表示しているモニタの情報を取得することができます.



リスト3
procedure TForm1.Button2Click(Sender: TObject);
var
  LScreen  : TScreen;
  LCurPos  : TPoint;
  LMonitor : TMonitor;
begin
  LScreen := TScreen.Create(Self);
  try
    GetCursorPos(LCurPos);
    LMonitor := LScreen.MonitorFromPoint(LCurPos, mdNearest);

    //モニタの左端X座標値を取得
    MessageBox(Handle, PChar(IntToStr(LMonitor.Left)), '情報', MB_ICONINFORMATION);
  finally
    FreeAndNil(LScreen);
  end;
end;


フォームを表示しているモニタの情報は,以下のように,TForm.Monotor.Handle を使用して,このモニタのハンドルからもむ取得できます.


procedure TForm1.Button5Click(Sender: TObject);
var
  LMonitorInfoEx : TMonitorInfoEx;
begin
  //TMonitorInfoExレコードの初期化
  FillChar(LMonitorInfoEx, SizeOf(TMonitorInfoEx), #0);
  LMonitorInfoEx.cbSize := SizeOf(LMonitorInfoEx);

  GetMonitorInfo(Self.Monitor.Handle, @LMonitorInfoEx);
  ShowMessage(IntToStr(LMonitorInfoEx.rcMonitor.Left));
end;




02_設定可能な解像度の一覧を取得


EnumDisplaySettingsEx 関数または EnumDisplaySettings 関数で,設定可能な解像度を列挙します.
結果はどちらも同じでした.
これらの関数の第 1 引数には対象モニタのディスプレイデバイス名を与えますが,nil にすると現在の [メインディスプレイ] のモニタが対象となります.

後述の WMI でも,CIM_VideoControllerResolution クラスを使用すると,ビデオコントローラがサポートする解像度を列挙できます.

プライマリモニタ以外のモニタの解像度のリストは,以下のように,第 1 引数にディスプレイデバイス名を指定します.ディスプレイデバイスの名前は,後述の EnumDisplayDevices 関数を使用すると,その一覧を取得できます.下のコードは,2 番目のモニタの場合です.プライマリモニタの数字は 1 です.

  while EnumDisplaySettingsEx('\\.\DISPLAY2', i, DevMode, EDS_RAWMODE) do begin

  while EnumDisplaySettings('\\.\DISPLAY2', i, DevMode) do begin




図7
設計時画面
図8
実行結果


リスト4
EnumDisplaySettingsEx または EnumDisplaySettings を使用して,設定可能な解像度をリスト
メインディスプレイ用のコード
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

function EnumDisplaySettingsEx(
  lpszDeviceName: PChar;
  iModeNum: DWORD;
  var lpDevMode: TDeviceMode;
  dwFlags: DWORD): BOOL; stdcall; external 'user32.dll' name 'EnumDisplaySettingsExW';

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := '設定可能な解像度一覧';

  ListBox1.Font.Size := 10;
  ListBox1.Font.Name := 'MS ゴシック';
end;

//=============================================================================
//  設定可能な画面(ディスプレイ)の解像度の一覧を取得
//  EnumDisplaySettingsEx関数を使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
//  Microsoft Windows SDK 7.1 より抜粋
//  /* Flags for EnumDisplaySettingsEx */
//  #define EDS_RAWMODE                   0x00000002
//  #define EDS_ROTATEDMODE               0x00000004
const
  EDS_RAWMODE = 2;
  EDS_ROTATEDMODE = 4;
var
  LDevMode : TDeviceMode;
  i        : Integer;
begin
  ListBox1.Items.Clear;
  ListBox1.Items.BeginUpdate;

  //DevMode構造体の初期化

  FillChar(LDevMode, SizeOf(TDeviceMode), 0);
  LDevMode.dmSize := SizeOf(TDeviceMode);

  //列挙
  i := 0;
  while EnumDisplaySettingsEx(nil, i, LDevMode, EDS_RAWMODE) do begin
    ListBox1.Items.Add(Format('%3d:   %4d x %4d   %2d bits  %2d Hz  %2d',
                              [i,
                               LDevMode.dmPelsWidth,
                               LDevMode.dmPelsHeight,
                               LDevMode.dmBitsPerPel,
                               LDevMode.dmDisplayFrequency,
                               LDevMode.dmDisplayFlags]));
    inc(i);
  end;

  ListBox1.Items.EndUpdate;
end;

//=============================================================================
//  設定可能な画面(ディスプレイ)の解像度の一覧を取得
//  EnumDisplaySettings関数を使用
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDevMode : TDeviceMode;
  i        : Integer;
begin
  ListBox1.Items.Clear;
  ListBox1.Items.BeginUpdate;

  //DevMode構造体の初期化
  FillChar(LDevMode, SizeOf(TDeviceMode), 0);
  LDevMode.dmSize := SizeOf(TDeviceMode);

  //列挙
  i := 0;
  while EnumDisplaySettings(nil, i, LDevMode) do begin
    ListBox1.Items.Add(Format('%3d:   %4d x %4d   %2d bits  %2d Hz  %2d',
                              [i,
                               LDevMode.dmPelsWidth,
                               LDevMode.dmPelsHeight,
                               LDevMode.dmBitsPerPel,
                               LDevMode.dmDisplayFrequency,
                               LDevMode.dmDisplayFlags]));
    inc(i);
  end;

  ListBox1.Items.EndUpdate;
end;

end.




03_設定可能な解像度のリストから選択して解像度を変更


設定可能な解像度のリストを作成し,その中から選択した解像度に変更するサンプルです.
EnumDisplaySettings 関数で検出した DevMode 構造体を ChangeDisplaySettings 関数に渡すことで設定できます.
ここで設定変更した解像度は,コンピュータを再起動すると,設定前の値に戻ります.永続的に解像度を変更する場合は,ChangeDisplaySettingsEx 関数の第 4 引数に CDS_UPDATEREGISTRY を含めて,レジストリの値を書き換えます.


[備考 1]
プライマリモニタ以外のモニタの解像度を変更するには,EnumDisplaySettings 関数の第 1 引数と,ChangeDisplaySettingsEx 関数の第 1 引数に,ディスプレイデバイス名を指定します.
ディスプレイデバイスの名前は,後述の EnumDisplayDevices 関数を使用すると,その一覧を取得できます.

[備考 2]
シングルモニタの場合は,ディスプレイデバイスの指定が必要ない ChangeDisplaySettings 関数で解像度等の変更ができます.その場合,EnumDisplaySettings 関数の第 1 引数を nil にします.



図9
設計時画面
図10
変更前の画面
  • 反転表示は現在の設定値 (自動検出)
  • 解像度は 1024 X 768
図11
変更後の画面
  • 解像度を 640 X 480 にした結果


リスト5
設定可能な解像度のリストから選択して解像度を変更
プライマリモニタ用のコード
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    FDispDevName : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := '画面の解像度を変更';

  ListBox1.Font.Size := 10;
  ListBox1.Font.Name := 'MS ゴシック';

  //変更対象のディスプレイデバイス名
  //プライマリモニタの場合
  FDispDevName := '\\.\DISPLAY1';
end;

//=============================================================================
//  設定可能な画面(ディスプレイ)の解像度の一覧を取得
//  EnumDisplaySettings関数で現在の設定を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
//  Microsoft Windows SDK 7.1 より抜粋
//  #define ENUM_CURRENT_SETTINGS       ((DWORD)-1)
//  #define ENUM_REGISTRY_SETTINGS      ((DWORD)-2)
const
  ENUM_CURRENT_SETTINGS = DWORD(-1);

var
  LDevMode    : TDeviceMode;
  LDevModeNow : TDeviceMode;
  LIndex      : Integer;
  i           : Integer;
begin
  ListBox1.Items.Clear;
  ListBox1.Items.BeginUpdate;

  //DevMode構造体の初期化
  FillChar(LDevMode, SizeOf(TDevMode), 0);
  LDevMode.dmSize := SizeOf(TDevMode);
  FillChar(LDevModeNow, SizeOf(TDevMode), 0);
  LDevModeNow.dmSize := SizeOf(TDevMode);

  //現在の設定値を取得
  EnumDisplaySettings(PChar(FDispDevName), ENUM_CURRENT_SETTINGS, LDevModeNow);

  //列挙開始
  i      := 0;
  LIndex := 0;
  while EnumDisplaySettings(PChar(FDispDevName), i, LDevMode) do begin

    //現在の設定値と比較して,同じだったらインデックスをLIndexに代入
    if (LDevModeNow.dmPelsHeight       = LDevMode.dmPelsHeight) and
       (LDevModeNow.dmPelsWidth        = LDevMode.dmPelsWidth)  and
       (LDevModeNow.dmBitsPerPel       = LDevMode.dmBitsPerPel) and
       (LDevModeNow.dmDisplayFrequency = LDevMode.dmDisplayFrequency) then begin
      LIndex := i;
    end;

    ListBox1.Items.Add(Format('%3d:   %4d x %4d   %2d bits  %2d Hz  %2d',
                              [i,
                               LDevMode.dmPelsWidth,
                               LDevMode.dmPelsHeight,
                               LDevMode.dmBitsPerPel,
                               LDevMode.dmDisplayFrequency,
                               LDevMode.dmDisplayFlags]));
    inc(i);
  end;

  //現在の設定値を選択状態にする
  ListBox1.ItemIndex := LIndex;

  ListBox1.Items.EndUpdate;
end;

//=============================================================================
//  画面(ディスプレイ)の解像度を変更
//  ChangeDisplaySettingsExを使用
//  ListBox1で選択中の解像度に変更
//
//  古いWindowsの場合,HWND_BROADCASTに対してWM_DISPLAYCHANGEメッセージを送信
//  する必要がある(wParamにSPI_SETNONCLIENTMETRICSを指定)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDevMode : TDeviceMode;
  LIndex   : Integer;
  LRet     : Integer;
begin
  LIndex := ListBox1.ItemIndex;
  if LIndex < 0 then exit;

  //DevMode構造体の初期化
  FillChar(LDevMode, SizeOf(TDevMode), 0);
  LDevMode.dmSize := SizeOf(TDevMode);

  //LIndex番目(0ベース)の設定のDevMode構造体を取得
  if EnumDisplaySettings(PChar(FDispDevName), LIndex, LDevMode) then begin
    //そのDevMode構造体の値で解像度を設定
    LRet := ChangeDisplaySettingsEx(PChar(FDispDevName), LDevMode, 0, 0, nil);

    if LRet = DISP_CHANGE_SUCCESSFUL then begin
      MessageBox(Handle, '設定の変更に成功しました', '情報', MB_ICONINFORMATION);
    end else begin
      MessageBox(Handle, '設定の変更に失敗しました', '情報', MB_ICONINFORMATION);
    end;
  end;
end;

//=============================================================================
//  元の解像度に戻す
//  コンピュータを再起動しても元の解像度に戻る
//  (ChangeDisplaySettingsExの第4引数にCDS_UPDATEREGISTRYの指定がある場合は不可)
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LpDevMode : PDeviceMode;
begin
  LpDevMode := nil;
  ChangeDisplaySettingsEx(PChar(FDispDevName), LpDevMode^, 0, 0, nil);
end;

end.




04_指定した解像度の変更可否を確認して解像度を変更


解像度等の値を DevMode 構造体のメンバーに直接セットして解像度を変更するサンプルです.
指定した値が設定可能なリストにあるかを確認してから実際の設定を実行します.
このサンプルも,設定変更した解像度は,コンピュータを再起動すると,設定前の値に戻ります.永続的に解像度を変更する場合は,ChangeDisplaySettingsEx 関数の第 4 引数に CDS_UPDATEREGISTRY を含めて,レジストリの値を書き換えます.


[備考 1]
プライマリモニタ以外のモニタの解像度を変更するには,EnumDisplaySettings 関数の第 1 引数と,ChangeDisplaySettingsEx 関数の第 1 引数に,ディスプレイデバイス名を指定します.
ディスプレイデバイスの名前は,後述の EnumDisplayDevices 関数を使用すると,その一覧を取得できます.

[備考 2]
シングルモニタの場合は,ディスプレイデバイスの指定が必要ない ChangeDisplaySettings 関数で解像度等の変更ができます.その場合,EnumDisplaySettings 関数の第 1 引数を nil にします.



図12
設計時画面
図13
EXE 起動直後の画面


リスト6
指定した解像度の変更可否を確認して解像度を変更
プライマリモニタ用のコード
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FDispDevName : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := '画面解像度の設定';

  //設定する値をセット
  LabeledEdit1.Text := '640';
  LabeledEdit2.Text := '480';
  LabeledEdit3.Text := '16';
  LabeledEdit4.Text := '60';

  //変更対象のディスプレイデバイス名
  //プライマリモニタの場合
  FDispDevName := '\\.\DISPLAY1';
end;

//=============================================================================
//  指定した値で画面の解像度を設定
//  ChangeDisplaySettingsEx関数で設定
//
//  リフレッシュレート(周波数)を設定すると設定後の画面が乱れてしまうようだ
//  インデックスの値で設定した方が無難なようである
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPelsWidth     : Cardinal;
  LPelsHeight    : Cardinal;
  LBitsPerPel    : Cardinal;
  LDispFrequency : Cardinal;
  LDevMode       : TDeviceMode;
  LRet           : Integer;
  i              : Integer;
begin
  LPelsWidth     := StrToIntDef(LabeledEdit1.Text, 0);
  LPelsHeight    := StrToIntDef(LabeledEdit2.Text, 0);
  LBitsPerPel    := StrToIntDef(LabeledEdit3.Text, 0);
  LDispFrequency := StrToIntDef(LabeledEdit4.Text, 0);

  //DevMode構造体の初期化
  FillChar(LDevMode, SizeOf(TDeviceMode), 0);
  LDevMode.dmSize := SizeOf(TDeviceMode);

  //実際に希望設定の値が存在するかをチェック
  i    := 0;
  LRet := -1;
  while EnumDisplaySettings(PChar(FDispDevName), i, LDevMode) do begin
    if (LDevMode.dmPelsWidth        = LPelsWidth)     and
       (LDevMode.dmPelsHeight       = LPelsHeight)    and
       (LDevMode.dmBitsPerPel       = LBitsPerPel)    and
       (LDevMode.dmDisplayFrequency = LDispFrequency) then begin
      LRet := i;
      break;
    end;
    inc(i);
  end;

  if LRet >= 0 then begin
    //取得したDevMode構造体の値で解像度を設定
    LRet := ChangeDisplaySettingsEx(PChar(FDispDevName), LDevMode, 0, 0, nil);

    if LRet = DISP_CHANGE_SUCCESSFUL then begin
      MessageBox(Handle, '設定の変更に成功しました', '情報', MB_ICONINFORMATION);
    end else begin
      MessageBox(Handle, '設定の変更に失敗しました', '情報', MB_ICONINFORMATION);
    end;
  end else begin
    MessageBox(Handle, '設定の変更に失敗しました', '情報', MB_ICONINFORMATION);
  end;
end;

//=============================================================================
//  元の解像度に戻す
//  コンピュータを再起動しても元の解像度に戻る
//  (ChangeDisplaySettingsExの第4引数にCDS_UPDATEREGISTRYの指定がある場合は不可)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LpDevMode : PDeviceMode;
begin
  LpDevMode := nil;
  ChangeDisplaySettingsEx(PChar(FDispDevName), LpDevMode^, 0, 0, nil);
end;

end.




05_解像度を変更してフルスクリーンモードにする


解像度を変更すると同時に,サンプルプログラムのフォームを全画面に表示にします.一般的に「フルスクリーン」あるいは「全画面表示」と言っているようです.
ゲーム等では,解像度の低い画面で動作するものがあり,そのような場合に使われているようです.
解像度を変更しなければ,単なるフォームのフルスクリーン表示です.パワーポイント等のフルスクリーンと同じです.ただし,このサンプルでは,フォーム上のコントロール,オブジェクト類のリサイズはしません.

このサンプルでは,指定した解像度が設定可能かのチェックはしていません.
このようなフルスクリーン表示では,終了するまでスタートメニューを表示させないとか,タスクバーも表示させない,等という仕様のアプリがあります.必要であればそのような機能を追加します.

本サンプルは,EXE を実行したモニタの解像度を変更し,フルスクリーンにします.そのため,EXE を実行したモニタを検出するコードを追加しています.



[備考]
画面の解像度を変更するということと,フルスクリーンにするということは,全く別の機能です.直接関係するものではありません.


図14
設計時画面
  • このフォームをフルスクリーン表示する
  • キャプチャした画像がウェブページで判別しにくいので色を変更した
  • 変更対象は,この EXE を実行したモニタ
図15
実行結果
  • 640 X 480 のフルスクリーン表示に変更
  • タスクバーも見えない
  • [ESC] キーで元に戻る


リスト7
EXE を実行したモニタの解像度を変更してフルスクリーンモードにする
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    { Private 宣言 }
    FWndStyleOld : Integer;
    FFormStyleOld : TFormStyle;
    FDispDevName  : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  MultiMon;


{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := 'フルスクリーンにして解像度を変更';

  //変更対象のディスプレイデバイス名
  //プライマリモニタの場合
  FDispDevName := '\\.\DISPLAY1';
end;

//=============================================================================
//  フルスクリーンにして画面の解像度も変更
//  ChangeDisplaySettingsEx関数を使用
//
//  このEXEを実行したモニタの解像度を変更してフルスクリーンにする
//  そのため,ウィンドウハンドルからモニタのハンドルを取得
//  そのハンドルからモニタのTMonitorInfoEx構造体を取得して,そのメンバから
//  ディスプレイデバイス名を取得する
//
//  周波数を設定すると設定後の画面が乱れてしまうようだ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDevMode       : TDeviceMode;
  LWndStyle      : Integer;
  LMonitorHandle : HMONITOR;
  LMonitorInfoEx : TMonitorInfoEx;
begin
  //現在のウィンドウスタイルとフォームスタイルの設定を退避
  FWndStyleOld  := GetWindowLong(Form1.Handle, GWL_STYLE);
  FFormStyleOld := FormStyle;

  //枠なしフォームにして最大化
  LWndStyle := Integer(WS_POPUP);
  SetWindowLong(Form1.Handle, GWL_STYLE, LWndStyle);
  FormStyle   := fsStayOnTop;
  WindowState := wsMaximized;

  //DevMode構造体の初期化
  FillChar(LDevMode, SizeOf(TDeviceMode), 0);
  LDevMode.dmSize := SizeOf(TDeviceMode);

  //解像度と色数の指定
  LDevMode.dmPelsWidth  := 640;
  LDevMode.dmPelsHeight := 480;
  LDevMode.dmBitsPerPel := 16;
  //何を設定するかの指定
  LDevMode.dmFields := DM_PELSWIDTH  or DM_PELSHEIGHT or DM_BITSPERPEL;

  //ウィンドウハンドルからモニタのハンドルを取得
  LMonitorHandle := MonitorFromWindow(Handle, MONITOR_DEFAULTTONEAREST);

  //TMonitorInfoExレコードの初期化
  FillChar(LMonitorInfoEx, SizeOf(TMonitorInfoEx), #0);
  LMonitorInfoEx.cbSize := SizeOf(LMonitorInfoEx);
  //モニタの情報を取得して,ディスプレイデバイス名メンバの値を取得
  GetMonitorInfo(LMonitorHandle, @LMonitorInfoEx);
  FDispDevName := LMonitorInfoEx.szDevice;

  //設定したDevMode構造体の値で解像度を設定
  ChangeDisplaySettingsEx(PChar(FDispDevName), LDevMode, 0, CDS_FULLSCREEN, nil);
end;

//=============================================================================
//  TApplicationEventsコンポのOnMessageイベント処理
//  [ESC]キー押下で元に戻す
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  LpDevMode : PDeviceMode;
begin
  if Msg.message = WM_KEYDOWN then begin
    if Msg.wParam = VK_ESCAPE then begin
      //ウィンドウスタイルとフォームスタイルを元に戻す
      WindowState := wsNormal;
      FormStyle   := FFormStyleOld;
      SetWindowLong(Form1.Handle, GWL_STYLE, FWndStyleOld);

      //解像度を元に戻す
      LpDevMode := nil;
      ChangeDisplaySettingsEx(PChar(FDispDevName), LpDevMode^, 0, 0, nil);
    end;
  end;
end;

end.


上のサンプルコードでは,全画面 (フルスクリーン) 表示にするために,SetWindowLong 関数を使用していますが,Delphi では,次の設定でもフルスクリーン表示にすることができます.
これはオブジェクトインスペクタでも設定できます.


  BorderStyle := bsNone;
  WindowState := wsMaximized;




06_フォームのリサイズと同時にフォーム上のコントロールもリサイズ


画面の解像度のテストとは直接関係ありませんが,フォームのリサイズと同時に,フォーム上に配置したコントロールも同時にリサイズするテストをしてみました.

ここでは,TWinControl の ScaleBy メソッドを使用しています.ScaleBy や ScaleControls メソッドは,フォームのリサイズを連続的に行うような用途には向いていないようですが,今回のように,一時的にサイズの切り換えを実行する用途に向いているようです.
リサイズは縦横比を保ったリサイズとなります.もっとも,そうでないと,ボタン等が変形,文字も変形してしまいますから,理にはかなっています.

TGraphicControl の場合は注意が必要です.たとえ,リサイズできても,結果的に表示画像がリサイズ表示されるかは,コントロールの設定,画像の描画方法によります. 

本サンプルでは,ディスプレイデバイスを指定していません.必要があれば前項までのサンプルコードを参考にしてください.



図16
EXE を起動した直後の画面
  • 画面の解像度は 1024 X 768
図17
[変更] ボタンをクリック
  • 640 X 480 のサイズのフルスクリーン表示
  • タスクバーも見えない
  • TImage.Stretch := False; の場合
図18
画像の表示もリサイズ
  • TImage.Stretch := True; にした場合
図19
[ESC] キーで元に戻した結果


リスト8
フォームのリサイズと同時に,フォーム上に配置したコントロールもリサイズする
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ApplicationEvents1: TApplicationEvents;
    Memo1: TMemo;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    { Private 宣言 }
    LWndStyleOld     : Integer;
    LFormStyleOld    : TFormStyle;
    LOriginFormWidth : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := 'フルスクリーンにして解像度を変更';

  LOriginFormWidth := Self.Width;
end;

//=============================================================================
//  フルスクリーンにして画面の解像度も変更
//  EnumDisplaySettings関数を使用
//  周波数を設定すると設定後の画面が乱れてしまうようだ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDevMode  : TDeviceMode;
  LWndStyle : Integer;
begin
  Image1.Stretch := True;
  //現在のウィンドウスタイルとフォームスタイルの設定を退避
  LWndStyleOld  := GetWindowLong(Form1.Handle, GWL_STYLE);
  LFormStyleOld := FormStyle;

  //枠なしフォームにして最大化
  LWndStyle := Integer(WS_POPUP);
  SetWindowLong(Form1.Handle, GWL_STYLE, LWndStyle);
  FormStyle   := fsStayOnTop;
  WindowState := wsMaximized;

  //DevMode構造体の初期化
  FillChar(LDevMode, SizeOf(TDeviceMode), 0);
  LDevMode.dmSize := SizeOf(TDeviceMode);

  //スケーリング
  Self.ScaleBy(640, LOriginFormWidth);

  //解像度と色数の指定
  LDevMode.dmPelsWidth  := 640;
  LDevMode.dmPelsHeight := 480;
  LDevMode.dmBitsPerPel := 16;
  //何を設定するかの指定
  LDevMode.dmFields := DM_PELSWIDTH  or DM_PELSHEIGHT or DM_BITSPERPEL;

  //設定したDevMode構造体の値で解像度を設定
  ChangeDisplaySettings(LDevMode, CDS_FULLSCREEN);
end;

//=============================================================================
//  TApplicationEventsコンポのOnMessageイベント処理
//  [ESC]キー押下で元に戻す
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  LpDevMode : PDeviceMode;
begin
  if Msg.message = WM_KEYDOWN then begin
    if Msg.wParam = VK_ESCAPE then begin

      //スケールを元に戻す
      Self.ScaleBy(LOriginFormWidth, 640);

      //ウィンドウスタイルとフォームスタイルを元に戻す
      WindowState := wsNormal;
      FormStyle   := LFormStyleOld;
      SetWindowLong(Form1.Handle, GWL_STYLE, LWndStyleOld);


      //解像度を元に戻す
      LpDevMode := nil;
      ChangeDisplaySettings(LpDevMode^, 0);
    end;
  end;
end;

end.




07_ディスプレイデバイスの情報


ディスプレイデバイスを調べるテストです.EnumDisplayDevices 関数を使用します.
このサンプルで取得した \\.\DISPLAY1 を EnumDisplaySettingsEx 関数の第 1 引数にして実行してみましたが,nil の時と同じ結果となりました.


図20
設計時画面
図21
実行結果


リスト9
ディスプレイデバイスの情報
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := 'ディスプレイデバイス';

  ListBox1.Font.Size := 10;
  ListBox1.Font.Name := 'MS ゴシック';
end;

//=============================================================================
//  ディスプレイデバイスの列挙
//  EnumDisplayDevices関数を使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
const
  DISPLAY_DEVICE_ACTIVE = $1;
var
  LDispDevice : TDisplayDevice;
  LdwFlags    : Cardinal;
  LMonitorNo  : Cardinal;
begin
  ListBox1.Items.Clear;
  ListBox1.Items.BeginUpdate;

  LMonitorNo     := 0;
  LdwFlags       := 0;
  LDispDevice.cb := Sizeof(TDisplayDevice);
  while EnumDisplayDevices(nil, LMonitorNo, LDispDevice , LdwFlags) do begin
    if (LDispDevice.StateFlags and DISPLAY_DEVICE_ACTIVE) <> 0 then begin

      //モニタ(ディスプレイ)ごとの処理
      //ここでは単にデバイス名をTListBoxに表示するだけ
      ListBox1.Items.add(LDispDevice.DeviceName + '   ' + LDispDevice.DeviceString);
    end;
    inc(LMonitorNo);
  end;

  ListBox1.Items.EndUpdate;
end;

end.




08_WMI を使用した画面解像度の取得


デスクトップモニタの解像度は WMI の Win32_VideoController または Win32_DesktopMonitor クラスのプロパティからも取得できます.
下図は,[900] [01_コンピュータシステムの情報を取得] のサンプルで,Win32_DesktopMonitor クラスを指定して実行した結果です.最初の赤枠の値は,インチ当たりのピクセル数 (DPI あるいは PPI) です.次の赤枠が画面の解像度の値です.

WMI の,この関係のクラスは,接続しているモニタ全ての情報を列挙し,ネットワーク上の情報取得が可能な状態になっている場合は,ネットワーク上のモニタの情報も取得できるようですが,筆者の環境では,プライマリモニタの情報しか取得できていません.

Win32_PnPEntity where service="monitor" ではモニタが 2 つ検出できています.



図22
実行結果




09_画面サイズを mm 単位まで取得


ディスプレイのサイズを mm (ミリメートル) 単位まで取得するサンプルです.
最初のコードは,画面のピクセル数と DPI (インチ当たりのピクセル数,PPI とも言う) から換算しています.結果として数ミリメートル以上の精度は望めないようです.モニタのサイズや種類によっては目安程度の値と考えた方が無難と思われます.
正確な値は,おそらく,モニタを実測するしかないでしょう.

DIP と解像度の値から算出するサンプルで実寸を取得できるのは,モニタの最大解像度で表示している時だけです.解像度を変更した場合でも正確な値を取得するには,対象のモニタが持っている最大解像度の値を使用して計算しなければなりません.

[備考]
Windows XP では,GetDeviceCaps 関数の引数,HORZSIZE, VERTSIZE で,比較的精度の高い値を取得することができました,Windows 8.1, Windows 10 でも比較的物理的な値に近い値が取得できるようです.
Windows 7 では,この引数を指定して取得した値は,ほとんど意味のない値のように思われます.
Windows Vista, Windows 8 では確認していません.


図23
DPI と最大解像度の値から計算した結果
  • 実際のモニタのサイズは 24 インチ
  • 実サイズは,横 52.0 cm,縦 32.0 cm
図24
HORZSIZE, VERTSIZE から取得した値
  • 数値の意味については不明
  • Windows 8.1 / 10 では実際のモニタのサイズに近い値が取得できるようだ


リスト10
画面サイズを mm 単位で取得
プライマリモニタ用のコード
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  画面(ディスプレイ)のサイズをmm単位で取得
//  DPIと解像度の値から計算する方法
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDeviceName : string;
  LMonitorDC   : HDC;
  LXDPI       : Integer;
  LYDPI       : Integer;
  LDevMode    : TDeviceMode;
  LXResMax    : Cardinal;
  LYResMax    : Cardinal;
  LXSizemm    : Double;
  LYSizemm    : Double;
  LInchSize   : Double;
  LstrText    : string;
  i           : Integer;
begin
  LDeviceName := '\\.\DISPLAY1';
  LMonitorDC  := CreateDC('DISPLAY', PChar(LDeviceName), nil, nil);
  try
    LXDPI := GetDeviceCaps(LMonitorDC, LOGPIXELSX);
    LYDPI := GetDeviceCaps(LMonitorDC, LOGPIXELSY);

    //横と縦方向の解像度の最大値を検出
    LXResMax := 0;
    LYResMax := 0;
    i := 0;
    while EnumDisplaySettings(PChar(LDeviceName), i, LDevMode) do begin
      if LXResMax < LDevMode.dmPelsWidth  then LXResMax := LDevMode.dmPelsWidth;
      if LYResMax < LDevMode.dmPelsHeight then LYResMax := LDevMode.dmPelsHeight;
      inc(i);
    end;

    LXSizemm  := LXResMax / LXDPI * 2.54;
    LYSizemm  := LYResMax / LYDPI * 2.54;
    LInchSize := Sqrt(LXSizemm * LXSizemm + LYSizemm * LYSizemm) / 2.54;

    LstrText := '横 cm :  ' + FormatFloat('#0.#', LXSizemm) + sLineBreak
              + '縦 cm :  ' + FormatFloat('#0.#', LYSizemm) + sLineBreak
              + FormatFloat('#0.0', LInchSize) + ' インチ';

    MessageBox(Handle, PChar(LstrText), '画面サイズ cm', MB_ICONINFORMATION);
  finally
    DeleteDC(LMonitorDC);
  end;
end;

//=============================================================================
//  画面(ディスプレイ)のサイズをmm単位で取得
//  GetDeviceCaps関数の引数,HORZSIZE,VERTSIZEを使用する方法
//
//  Windows XP, 8.1, 10 では比較的精度のいい値となるようである
//  Windows 7 で取得した値の意味については不明
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LMonitorDC : HDC;
  LXSizemm  : Double;
  LYsizemm  : Double;
  LInchSize : Double;
  LstrText  : string;
begin
  LMonitorDC := CreateDC('DISPLAY', '\\.\DISPLAY1', nil, nil);
  try
    LXSizemm  := GetDeviceCaps(LMonitorDC, HORZSIZE) / 10.0;
    LYsizemm  := GetDeviceCaps(LMonitorDC, VERTSIZE) / 10.0;
    LInchSize := Sqrt(LXSizemm * LXSizemm + LYSizemm * LYSizemm) / 2.54;

    LstrText := '横 cm :  ' + FormatFloat('#0.#', LXSizemm) + sLineBreak
              + '縦 cm :  ' + FormatFloat('#0.#', LYsizemm) + sLineBreak
              + FormatFloat('#0.0', LInchSize) + ' インチ';

    MessageBox(Handle, PChar(LstrText), '画面サイズ cm', MB_ICONINFORMATION);
  finally
    DeleteDC(LMonitorDC);
  end;
end;

end.




10_画面サイズの mm 単位までの取得と DPI 仮想化


Windows Vista で DPI 仮想化という仕様が実装されました.
下図のように文字等のサイズを大きく表示するようにすると,実行アプリケーションの文字も大きく表示するようになります.Windows 7 では画像も同時に拡大するようになりました.Windows XP から改良されたことになります.

この DPI 仮想化では,画面の解像度の値は変わりますが,DPI の値は変化しません.DPI が変化した時と同じ結果となりますが,画面の一部が拡大表示するような動作になります.

[画面の解像度] [テキストやその他の項目の大きさの変更] で,[カスタムテキストサイズの設定 (DPI)] の,[Windows XP 形式の DPI スケーリングを使用する] をチェックすると,Windows XP と同じ動作仕様となります.


[備考]
筆者の環境では 100 % が既定値で,インチ当たりのピクセル数は 96 DPI となっていますが.これらの値は,モニタの種類,Windows のバージョンよっても異なることがあります.必ずしも 100 % が既定値で,インチ当たりのピクセル数が 96 DPI とは限りません.
画面のサイズをミリメートル単位で知る必要はないと思いますが,特に,携帯系のモニタでは機種によって違うことがあります.例えば,画素の密度が高くなれば,DPI の値を高くできます.
画面のサイズと画面の解像度が比例しないこともあるということです.


図25
画面の解像度を変更
  • [大(L)] - 150%] にする
図26
カスタム DPI 設定
  • 確認表示するだけ
  • [Windows XP 形式の...] はチェックしない

上の図の操作で解像度を変更しても,インチ当たりのピクセル数は元の 96 DPI のままです.
上の図で表示されている,144 ピクセル/インチ の値になるのは,[Windows XP 形式の DPI スケーリングを使用する] にチェックを入れた時です.

モニタのサイズを取得するコードは,この DPI 仮想化の影響を受けることになります.
前項の Button1 クリックのコードは,最大解像度の値を検出して計算しているので,同じ結果となっています.この画像は,キャプチャした画像をそのままの大きさで掲載しています.



図27
実行結果