<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1"
    xmlns:asmv3="urn:schemas-microsoft-com:asm.v3"
    manifestVersion="1.0">
  <asmv3:application>
    <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
      <dpiAware>true</dpiAware>
    </asmv3:windowsSettings>
  </asmv3:application>
  <assemblyIdentity
    type="win32"
    name="DelphiApplication"
    version="1.0.0.0" 
    processorArchitecture="*"/>
  <dependency>
    <dependentAssembly>
      <assemblyIdentity
        type="win32"
        name="Microsoft.Windows.Common-Controls"
        version="6.0.0.0"
        publicKeyToken="6595b64144ccf1df"
        language="*"
        processorArchitecture="*"/>
    </dependentAssembly>
  </dependency>
  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
    <security>
      <requestedPrivileges>
        <requestedExecutionLevel
          level="asInvoker"
          uiAccess="false"/>
        </requestedPrivileges>
    </security>
  </trustInfo>
  <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
    <application>
      <!--Windows 10-->
      <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />
      <!--Windows 8.1-->
      <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" />
      <!--Windows 8-->
      <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" />
      <!--Windows 7-->
      <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />
      <!--Windows Vista-->
      <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />
    </application>
  </compatibility>
</assembly>

  <asmv3:application>
    <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
      <dpiAware>true</dpiAware>
    </asmv3:windowsSettings>
  </asmv3:application>

//=============================================================================
//  GetDeviceCaps 関数を使用してディスプレイの DPI を取得
//  横方向の DPI と縦方向の DPI は同じ値
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LXDpi : Integer;
  LText : string;
begin
  LXDpi := GetDeviceCaps(GetDC(0), LOGPIXELSX);

  LText := IntToStr(LXDpi) + ' dpi' + sLineBreak;
  LText := LText + IntToStr(Trunc(LXDpi / USER_DEFAULT_SCREEN_DPI * 100.0)) + ' %';
  MessageBox(Handle, PChar(LText), 'DPI', MB_ICONINFORMATION);
end;

implementation

{$R *.dfm}

  // GetDpiForSystem 関数は Delphi 10.3 には実装されている
  // Windows 10, ビルド 1607 以降で使用可能
  function GetDpiForSystem : UINT; stdcall; external 'user32.dll';

//=============================================================================
//  GetDpiForSystem 関数を使用してディスプレイの DPI を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDpi   : Integer;
  LValue : Integer;
  LText  : string;
begin
  LDpi   := GetDpiForSystem;
  LValue := Trunc(LDpi / USER_DEFAULT_SCREEN_DPI * 100.0);

  LText := IntToStr(LDpi) + ' dpi' + sLineBreak;
  LText := LText + IntToStr(LValue) + ' %';
  MessageBox(Handle, PChar(LText), 'DPI', MB_ICONINFORMATION);
end;

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  MONITOR_DPI_TYPE = (
    MDT_EFFECTIVE_DPI = 0,
    MDT_ANGULAR_DPI = 1,
    MDT_RAW_DPI = 2,
    MDT_DEFAULT = MDT_EFFECTIVE_DPI);
  TMonitorDpiType = MONITOR_DPI_TYPE;

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

var
  Form1: TForm1;

implementation

uses
  Winapi.MultiMon;

{$R *.dfm}

  // この関数は Delphi 10.3 には実装されている ( uses に Winapi.ShellScaling が必要 )
  // Windows 8.1 以降で使用可能
  function GetDpiForMonitor(hmonitor: HMONITOR;
                            dpiType: TMonitorDpiType;
                            out dpiX: UINT;
                            out dpiY: UINT): HRESULT; stdcall; external 'Shcore.dll';

//=============================================================================
//  GetDpiForMonitor 関数を使用してディスプレイの DPI を取得
//  
//  uses に Winapi.MultiMon が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LCursorPos : TPoint;
  LhMonitor  : HMONITOR;
  LXDpi      : UINT;
  LYDpi      : UINT;
  LText      : string;
begin
  // マウスカーソルがあるモニタのハンドルを取得
  GetCursorPos(LCursorPos);
  LhMonitor := MonitorFromPoint(LCursorPos, MONITOR_DEFAULTTONEAREST);

  GetDpiForMonitor(LhMonitor, MDT_EFFECTIVE_DPI, LXDpi, LYDpi);

  LText := IntToStr(LXDpi) + ' dpi' + sLineBreak;
  LText := LText + IntToStr(Trunc(LXDpi / USER_DEFAULT_SCREEN_DPI * 100.0)) + ' %';
  MessageBox(Handle, PChar(LText), 'DPI', MB_ICONINFORMATION);
end;

end.

  // モニタ番号が I のモニタのハンドルを取得
  LScreen := TScreen.Create(Self);
  try
    LhMonitor := LScreen.Monitors[i].Handle;
  finally
    FreeAndNil(LScreen);
  end;

//=============================================================================
//  レジストリから DPI の値を取得
// 
//  DPI の現在値はレジストリの以下のキーの項目 AppliedDPI にある
//、ディスプレイの拡大率を変更した場合、PC を再起動しないと更新されない
//  HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics
//
//  uses に Registry が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LRegistry  : TRegistry;
  LRegistKey : string;
  LDpi       : Integer;
    LText    : string;
begin
  LDpi := 0;
  LRegistry := TRegistry.Create(KEY_READ);
  try
    LRegistry.RootKey := HKEY_CURRENT_USER;
    LRegistKey := 'Control Panel\Desktop\WindowMetrics';

    if LRegistry.OpenKey(LRegistKey, False) then begin
      LDpi := LRegistry.ReadInteger('AppliedDPI');
    end;
  finally
    FreeAndNil(LRegistry);
  end;

  LText := IntToStr(LDpi) + ' dpi' + sLineBreak;
  LText := LText + IntToStr(Trunc(LDpi / 96 * 100.0)) + ' %';
  MessageBox(Handle, PChar(LText), 'DPI', MB_ICONINFORMATION);
end;

implementation

{$R *.dfm}

  function DwmGetWindowAttribute(hwnd: HWND; dwAttribute: DWORD;
    pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall;  external 'DWMAPI.DLL';

const
  DWMWA_EXTENDED_FRAME_BOUNDS = 9;  

//=============================================================================
//  ディスプレイの拡大率を取得
//  実際のウィンドウのサイズと GetWindowRect の戻り値の比率から計算
//
//  ウィンドウのサ実イズは DwmGetWindowAttribute で取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LThick   : Integer;
  LRectDwm : TRect;
  LRectWin : TRect;
  LRatio   : Single;
  LText    : string;
begin
  // ウィンドウの外周の外の部分 ('DWM で描画されない部分 )
  // BorderStyle := bsSizeable の時の値
  LThick := GetSystemMetrics(SM_CXSIZEFRAME) - GetSystemMetrics(SM_CXBORDER);

  DwmGetWindowAttribute(Handle, DWMWA_EXTENDED_FRAME_BOUNDS, @LRectDwm, SizeOf(LRectDwm));
  GetWindowRect(Handle, LRectWin);

  // 拡大率
  LRatio := (LRectDwm.Right - LRectDwm.Left) / (LRectWin.Right - LRectWin.Left - LThick * 2);

  LText := IntToStr(LRectWin.Right - LRectWin.Left) + ' .dots' + sLineBreak;
  LText := LText + IntToStr(LRectDwm.Right - LRectDwm.Left) + ' dots' + sLineBreak;
  LText := LText + sLineBreak + FormatFloat('0.00', LRatio);

  MessageBox(Handle, PChar(LText), 'DPI', MB_ICONINFORMATION);
end;

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

const
  // Delphi 10.4 にはこの定義が実装されている
  WM_DPICHANGED = $02E0;

type
  TForm1 = class(TForm)
  protected
    procedure WMDPIChanged(var message: TMessage); message WM_DPICHANGED;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//-----------------------------------------------------------------------------
//  WM_DPICHANGED メッセージの受信
//  拡大率 ( DPI ) が変更されたら DPI の値と拡大率を表示
//
//  このメッセージは、マニフェストの dpiAware 属性の値が True/PM でないと捕捉不可
//  Delphi 10.4 では [マニフェスト] の [DPI の認識] で設定する
//-----------------------------------------------------------------------------
procedure TForm1.WMDPIChanged(var message: TMessage);
var
  LDpiX : Integer;
  LPer  : Integer;
  LText : string;
begin
  LDpiX := LoWord(message.WParam);
  LPer  := Trunc(LDpiX / USER_DEFAULT_SCREEN_DPI * 100.0);

  LText := IntToStr(LDpiX) + ' dpi' + sLineBreak + IntToStr(LPer) + ' %';
  MessageBox(Handle, PChar(LText), 'DPI', MB_ICONINFORMATION);
end;

end.