[SOLVED] Windows: how to query the real DPI-setting of the monitor?

[Hartmut]

My sister has a laptop with real 1920x1080 pixels. But she changed something in the Windows10 System-Control to have bigger Fonts and this results, that only 1536x864 pixels are reported by this command:

Code: Pascal  [Select][+][-]

1. writeln(Screen.Width, 'x', Screen.Height);

I did expect that this commands

Code: Pascal  [Select][+][-]

1. writeln('DPI-Faktor1: ', Screen.PixelsPerInch);
2. writeln('DPI-Faktor2: ', Screen.PrimaryMonitor.PixelsPerInch);

would return '120', but both return '96'.

I want to detect, that this laptop runs with 120 dpi. How can I do that? Is there a function in the LCL for that? Or a Windows-API-function? I googled for that but (in a reliable time) got lost in a labyrinth of very complicated links.

Important: the code to detect the 120 dpi must run in a program with setting Project Options / Application / "Use LCL scaling (Hi-DPI)" and "DPI awareness" both = off.

Thanks in advance.

[Thaddy]

TScreen. Which is already initialized as Screen.

[Seenkao]

Да я столкнулся с масштабированием в Windows. Рекомендованные способы определения масштаба вели к вычислению DPI, но при запросе DPI вывод был 96. При более подробном изучении, я узнал, что есть функция GetScaleFactorForMonitor которая возвращает текущий масштаб для данного монитора.


Google translate:
Yes, I encountered scaling in Windows. The recommended methods for determining the scale led to calculating the DPI, but when querying the DPI, the output was 96. Upon closer examination, I learned that there is a function GetScaleFactorForMonitor that returns the current scale for a given monitor.

for pascal:

Code: Pascal  [Select][+][-]

1. function GetScaleFactorForMonitor(hmonitor: HMONITOR; out Scale: UINT): HRESULT; stdcall; external 'Shcore.dll';

[Hartmut]

Thank you very much Seenkao for that suggestion. This is my code:

Code: Pascal  [Select][+][-]

1. function GetScaleFactorForMonitor(hmonitor: HMONITOR; out scale: UINT): HRESULT;
2.                                  stdcall; external 'Shcore.dll';
3.  
4. procedure winShowPrimMonitorDPI;
5.    {shows the DPI-percentage of the Primary Monitor}
6.    var h: HMONITOR;
7.        scale: UINT;
8.        res: HRESULT;
9.    begin
10.    h:=Screen.PrimaryMonitor.Handle;
11.    scale:=UINT(-1);
12.    res:=GetScaleFactorForMonitor(h, scale);
13. writeln('res=', res, ' scale=', scale);
14.    end;

The good news is: on my Win10 computer (which has a normal Font size) it works and results 'res=0, scale=100'. For the result on my sisters Win10 laptop (which has an increased Font size) I'm still waiting.

The bad news is: unfortunately function GetScaleFactorForMonitor() does exist only from Win 8.1 on. And when I start above code on my Win7 computer, the program crashes immediately at start without any message. When I start it within the Lazarus IDE with the Debugger then I get this message:

Code: [Select]

The program can not be started, because Shcore.dll is missing on the computer. Install the program again to solve the problem.

That means, if I create any program which contains function GetScaleFactorForMonitor(), then this program will crash at starting time on computers with Win8 or older. Unfortunately I can not live with that. What I need is a function to query the real DPI setting and it is ok, if this functions returns an error code (which I can catch) if it runs on e.g. Win7, but it may not crash.

Do you (or someone else) have another idea?

[wp]

But she changed something in the Windows10 System-Control to have bigger Fonts

There are two ways to change the size of fonts in Windows
- "System" > "Screen" > "Scaling": 100% (96ppi), 125% (120ppi), 150% (144 ppi), etc. - this changes the pixel density, i.e. the ppi, and this is what Screen.PixelsPerInch reports (and LCL uses for scaling)
- "Ease of Access" > "Text size": slider starting at 100% - this changes only the text size, not the ppi. Screen.PixelsPerInch always reports the same value (not handled by LCL scaling). Maybe this is what your sister changed.

[Seenkao]

Вам надо создать функцию как переменную, произвести её активацию и при вызове её произвести проверку на существование данной функции. Код ниже прилагаю, но для вас он может быть не совсем верным. Используйте для данных действий уже готовые средства FPC/Lazarus.
И, на всякий случай, проверку DPI так же желательно производить! Потому что на разных системах, программы могут работать по разному.


Google translate:
You need to create a function as a variable, activate it and when calling it, check for the existence of this function. I attach the code below, but it may not be entirely correct for you. Use ready-made FPC/Lazarus tools for these actions.
And, just in case, it is also advisable to check the DPI! Because on different systems, programs may work differently.

Code: Pascal  [Select][+][-]

1. var
2.   libShcore: HMODULE;
3.   ...
4.   GetDpiForMonitor: function(hmonitor: HMONITOR; dpiType: TMonitorDpiType; out dpiX: UINT; out dpiY: UINT): HRESULT; stdcall;
5.   GetScaleFactorForMonitor: function(hmonitor: HMONITOR; out Scale: UINT): HRESULT; stdcall;
6. ...
7.  

Code: Pascal  [Select][+][-]

1. procedure SetProcPoint;
2. begin
3.   ...
4.    libShcore := dlopen('Shcore.dll');
5.   if libShcore <> LIB_ERROR then
6.   begin
7.     (GetDpiForMonitor) := dlsym(libShcore, 'GetDpiForMonitor');
8.     (GetScaleFactorForMonitor) := dlsym(libShcore, 'GetScaleFactorForMonitor');
9.   end
10.   else begin
11.     (GetDpiForMonitor) := nil;
12.     (GetScaleFactorForMonitor) := nil;
13.   end;
14.   ...
15. end;
16.  

Code: Pascal  [Select][+][-]

1. procedure TestScale;
2. var
3.   outX, outY: LongWord;
4. begin
5.   ...
6.   if Assigned(GetScaleFactorForMonitor) then
7.     if GetScaleFactorForMonitor(scrMonitor, outX) = S_OK then
8.       scrScaleWindow := 100 / outx;
9.   if (Assigned(GetDpiForMonitor)) and (outX = 100) then
10.     if GetDpiForMonitor(scrMonitor, MDT_EFFECTIVE_DPI, outX, outY) = S_OK then
11.       scrScaleWindow := 96 / outX;
12.   ...
13. end;

Товарищи разработчики FPC/Lazarus, внесите пожалуйста данную функцию в ваш код! Так же можете использовать код, что я скинул, он сделан по вашему подобию и думаю не составит труда внести изменения.

Google translate:
Comrades FPC/Lazarus developers, please add this function to your code! You can also use the code that I dropped, it is made in your likeness and I think it will not be difficult to make changes.

[rvk]

Important: the code to detect the 120 dpi must run in a program with setting Project Options / Application / "Use LCL scaling (Hi-DPI)" and "DPI awareness" both = off.

Just curious... why can't you have DPI awareness set to True in the Project options?
(it's what gives Screen.PixelsPerInch its correct value)

GetScaleFactorForMonitor works for me too on Windows 10.

That means, if I create any program which contains function GetScaleFactorForMonitor(), then this program will crash at starting time on computers with Win8 or older. Unfortunately I can not live with that. What I need is a function to query the real DPI setting and it is ok, if this functions returns an error code (which I can catch) if it runs on e.g. Win7, but it may not crash.

Do you (or someone else) have another idea?

You could try to see how Screen.PixelsPerInch does it.

What are you going to do with the value? Because you set your program to be NOT DPI AWARE. So using that number for things, will screw up other things.

But, ok, you asked for another idea...
You defined the function GetScaleFactorForMonitor as stdcall; external 'Shcore.dll';
That's going to load the Shcore.dll at startup.

If you don't want that, and you want to catch the non-exist error, then you need to load the Shcore.dll dynamically during runtime with LoadLibrary and GetProcAddress.

Something like... (not tested):

Code: Pascal  [Select][+][-]

1. type
2.   TGetScaleFactorForMonitor = function(hmonitor: HMONITOR; out scale: UINT): HRESULT; stdcall;
3.  
4. var
5.   ShcoreLib: HMODULE;
6.   GetScaleFactorForMonitor: TGetScaleFactorForMonitor;
7. begin
8.   ShcoreLib := LoadLibrary('Shcore.dll'); // Load the library
9.   if ShcoreLib <> 0 then
10.   begin
11.     // Get the procedure address
12.     @GetScaleFactorForMonitor := GetProcAddress(ShcoreLib, 'GetScaleFactorForMonitor');
13.     if Assigned(GetScaleFactorForMonitor) then
14.     begin
15.       // Call the function
16.       result := GetScaleFactorForMonitor(hMonitor, scale);
17.       if result = S_OK then
18.         Writeln('Scale factor: ', scale)
19.       else
20.         Writeln('Error calling GetScaleFactorForMonitor, HRESULT: ', result);
21.     end
22.     else
23.       Writeln('GetScaleFactorForMonitor function not found in Shcore.dll.');
24.     // Free the library
25.     FreeLibrary(ShcoreLib);
26.   end
27.   else
28.     Writeln('Could not load Shcore.dll.');

(Seenkao just beat me to it )

[Hartmut]

Thanks a lot to all for your valuable replies. I will answer them detailed later. Currently I'm stuck because I dont find the Unit for dlopen, LIB_ERROR and dlsym in a reliable time. I'm a bloody beginner to all this dll stuff. Can please someone help?

[Seenkao]

Code: Pascal  [Select][+][-]

1. type
2.   TGetScaleFactorForMonitor = function(hmonitor: HMONITOR; out scale: UINT): HRESULT; stdcall;
3.  
4. var
5.   ShcoreLib: HMODULE;
6.   GetScaleFactorForMonitor: TGetScaleFactorForMonitor;
7. begin
8.   ShcoreLib := LoadLibrary('Shcore.dll'); // Load the library
9.   if ShcoreLib <> 0 then
10.   begin
11.     // Get the procedure address
12.     @GetScaleFactorForMonitor := GetProcAddress(ShcoreLib, 'GetScaleFactorForMonitor');
13.     if Assigned(GetScaleFactorForMonitor) then
14.     begin
15.       // Call the function
16.       result := GetScaleFactorForMonitor(hMonitor, scale);
17.       if result = S_OK then
18.         Writeln('Scale factor: ', scale)
19.       else
20.         Writeln('Error calling GetScaleFactorForMonitor, HRESULT: ', result);
21.     end
22.     else
23.       Writeln('GetScaleFactorForMonitor function not found in Shcore.dll.');
24.     // Free the library
25.     FreeLibrary(ShcoreLib);
26.   end
27.   else
28.     Writeln('Could not load Shcore.dll.');

GetProcAddress and LoadLibrary

[Hartmut]

Hello Seenkao, maybe we misunderstood. I need to know, in which Unit functions dlopen() and dlsym() exist. I must include this Unit with the 'uses' command.

[rvk]

Hello Seenkao, maybe we misunderstood. I need to know, in which Unit functions dlopen() and dlsym() exist. I must include this Unit with the 'uses' command.

Don't use dlopen(). You are on Windows so use LoadLibrary().
See my code.

dlopen() is a Linux function.

[Hartmut]

Thanks rvk, now I begin to understand. I will use your code. Which Unit do I need for LoadLibrary() and GetProcAddress() and FreeLibrary() ?

[rvk]

Here is tested code:

Code: Pascal  [Select][+][-]

1. uses Windows;
2.  
3. type
4.   TGetScaleFactorForMonitor = function(hmonitor: HMONITOR; out scale: UINT): HRESULT; stdcall;
5.  
6. function winShowPrimMonitorDPI: Integer;
7. var
8.   ShcoreLib: HMODULE;
9.   GetScaleFactorForMonitor: TGetScaleFactorForMonitor;
10.   Scale: UINT;
11. begin
12.   Result := -1;
13.   ShcoreLib := LoadLibrary('Shcore.dll'); // Load the library
14.   if ShcoreLib <> 0 then
15.   begin
16.     pointer(GetScaleFactorForMonitor) := GetProcAddress(ShcoreLib, 'GetScaleFactorForMonitor');
17.     if Assigned(GetScaleFactorForMonitor) then
18.       if GetScaleFactorForMonitor(Screen.PrimaryMonitor.Handle, Scale) = 0 then
19.         Result := Scale;
20.     FreeLibrary(ShcoreLib);
21.   end;
22. end;
23.  
24. procedure TForm1.FormCreate(Sender: TObject);
25. var
26.   Scale: Integer;
27. begin
28.   Scale := winShowPrimMonitorDPI;
29.   Showmessage(Scale.ToString);
30. end;

[rvk]

Here is tested code:

And a console version:

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses Windows, multimon;
6.  
7. type
8.   TGetScaleFactorForMonitor = function(hmonitor: HMONITOR; out scale: UINT): HRESULT; stdcall;
9.  
10. function winShowPrimMonitorDPI: Integer;
11. var
12.   ShcoreLib: HMODULE;
13.   GetScaleFactorForMonitor: TGetScaleFactorForMonitor;
14.   Scale: UINT;
15. begin
16.   Result := -1;
17.   ShcoreLib := LoadLibrary('Shcore.dll'); // Load the library
18.   if ShcoreLib <> 0 then
19.   begin
20.     pointer(GetScaleFactorForMonitor) := GetProcAddress(ShcoreLib, 'GetScaleFactorForMonitor');
21.     if Assigned(GetScaleFactorForMonitor) then
22.       if GetScaleFactorForMonitor(MonitorFromWindow(0, MONITOR_DEFAULTTOPRIMARY), Scale) = 0 then
23.         Result := Scale;
24.     FreeLibrary(ShcoreLib);
25.   end;
26. end;
27.  
28. {$R *.res}
29.  
30. begin
31.   Writeln('Scale is ', winShowPrimMonitorDPI);
32.   readln;
33. end.

Of course... for multiple monitors you would need to consider which monitor the window is on (also for the LCL version above).
Otherwise you can run into weird things when multiple monitors have different DPI settings 

[Hartmut]

Thank you rvk, this compiles. I will continue to investigate and report later (maybe tomorrow).