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

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.

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;

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;

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;

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

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

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 := 'ＭＳ ゴシック';
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.

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 := 'ＭＳ ゴシック';

  //変更対象のディスプレイデバイス名
  //プライマリモニタの場合
  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.

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.

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.

  BorderStyle := bsNone;
  WindowState := wsMaximized;

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.

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 := 'ＭＳ ゴシック';
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.

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.