Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Reliably read Windows Scaling factor from Delphi VCL application

In my efforts to properly handle DPI changes in my application, I am using the following code to read the current scaling factor:

TYPE TZoom = BYTE;

FUNCTION OldStyleGetDpiForSystem : TZoom; cdecl;
  VAR
    DC          : HDC;
    X,Y,Z       : LongWord;

  BEGIN
    DC:=GetDC(0);
    TRY
      X:=GetDeviceCaps(DC,LOGPIXELSX);
      Y:=GetDeviceCaps(DC,LOGPIXELSY)
    FINALLY
      ReleaseDC(0,DC)
    END;
    IF X>Y THEN Result:=X ELSE Result:=Y
  END;

FUNCTION GetDpiForSystem : TZoom;
  TYPE
    GetDpiForSystemFunc = FUNCTION : TZoom; cdecl;

  CONST
    GetDpiForSystem     : GetDpiForSystemFunc = NIL;

  BEGIN
    IF NOT Assigned(GetDpiForSystem) THEN BEGIN
      // Try to use official method (available from Windows 10, version 1607 [desktop apps only] and on)
      GetDpiForSystem:=GetProcAddress(LoadLibrary('USER32.DLL'),'GetDpiForSystem');
      // If not found, then use fall-back method with GetDeviceCaps of DeskTop
      IF NOT Assigned(GetDpiForSystem) THEN GetDpiForSystem:=OldStyleGetDpiForSystem
      // In any case, only determine method once, but call the method every time, as the DPI can change
      // while the application is running
    END;
    Result:=ROUND(GetDpiForSystem/USER_DEFAULT_SCREEN_DPI*100.0)
  END;

FUNCTION WindowsScaleFactor : TZoom;
  BEGIN
    Result:=GetDpiForSystem
  END;

My problem is that this ALWAYS return 100 (96 dpi), no matter what setting I set up in Windows (Windows 10).

I have compiled my application with default project settings (ie. Manifest File Auto Generate, Tags to include: Enable Runtime Themes & Enable High DPI).

I have also tried turning off "Enable High DPI" and then enable it manually in the application (but I get an error when I try, that suggests that DPI mode is already set, but that's probably another question for another time).

Can anybody guide me in a direction that will allow me to reliably read the current DPI scale factor set up in Windows? I also need to respond to DPI changes, but can't seem to intercept the WM_DPICHANGED message. Where should I intercept this message? At the Application-level or on a Form-level?

To reproduce my test setup, create an empty VCL application with a single button named Button1 on it. In the FormCreate event, put the following code:

procedure TForm14.FormCreate(Sender: TObject);
begin
  Button1.Caption:=IntToStr(WindowsScaleFactor)
end;

Attach the Button1.OnClick event to the FormCreate method so that the buttons caption is initialized on startup, and refreshed every time you click on it.

Then run the application. The button caption should read 100 to begin with (if you are running with 100% scaling). Then try to change the scaling in Windows and click the button. It should change to the value you have chosen, but (on my PC) it still returns 100%.

The manifest (extracted from the compiled .EXE) is as follows:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
  <asmv3:application>
    <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
      <dpiAware>True/PM</dpiAware>
    </asmv3:windowsSettings>
  </asmv3:application>
  <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>
                <!--The ID below indicates app support for Windows Vista -->
                <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
                <!--The ID below indicates app support for Windows 7 -->
                <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
                <!--The ID below indicates app support for Windows 8 -->
                <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
                <!--The ID below indicates app support for Windows 8.1 -->
                <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
                <!--The ID below indicates app support for Windows 10 -->
                <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
        </application>
</compatibility>
</assembly>
like image 488
HeartWare Avatar asked Feb 22 '18 09:02

HeartWare


2 Answers

I can recommend you start by reading this blog post

dpi awareness in vcl applications

You can respond to dpi changes by setting up event handlers for TForm.OnBeforeMonitorDPIChanged and TForm.OnAfterMonitorDPIChanged

procedure FormBeforeMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer);
procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer);

The event parameters will tell you the new DPI and old DPI.

Your manifest settings are correct.

like image 97
Jan Lauridsen Avatar answered Nov 11 '22 05:11

Jan Lauridsen


In a VCL application, you can retrive the scale factor from every TControl in a form.

procedure TfrmMain.FormShow(Sender: TObject);
var
 currentScaleFactor : Single;
begin
 currentScaleFactor := TControl(btnDoResize).ScaleFactor;
 lblScaleFator.Caption := 'Scalefactor: ' + currentScaleFactor.ToString;
end;
like image 1
Ivan Revelli Avatar answered Nov 11 '22 03:11

Ivan Revelli