Enable Windows DPI awareness

MainForm.pas

@@ -923,6 +923,12 @@ end;
 // Settings helpers
 // ===========================================================================
 
+function CurrentScreenDPI: Integer;
+begin
+  Result := Screen.PixelsPerInch;
+  if Result <= 0 then Result := 96;
+end;
+
 procedure TMainForm.RestoreWindowBounds;
 var
   L, T, Wd, Ht, SavedDPI, CurDPI: Integer;
@@ -932,9 +938,7 @@ begin
   FSettings.LoadWindowBounds(L, T, Wd, Ht, SavedDPI);
   if (Wd > 400) and (Ht > 300) then
   begin
-    CurDPI := PixelsPerInch;
+    CurDPI := CurrentScreenDPI;
-    if CurDPI <= 0 then CurDPI := Screen.PixelsPerInch;
-    if CurDPI <= 0 then CurDPI := 96;
     if SavedDPI <= 0 then SavedDPI := CurDPI;
 
     if SavedDPI <> CurDPI then
@@ -977,9 +981,7 @@ begin
   end;
 
   if (Wd <= 400) or (Ht <= 300) then Exit;
-  DPI := PixelsPerInch;
+  DPI := CurrentScreenDPI;
-  if DPI <= 0 then DPI := Screen.PixelsPerInch;
-  if DPI <= 0 then DPI := 96;
   FSettings.SaveWindowBounds(L, T, Wd, Ht, DPI);
 end;
 

WindowsDPI.pas

@@ -0,0 +1,85 @@
+unit WindowsDPI;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+procedure EnableProcessDpiAwareness;
+
+implementation
+
+{$IFDEF MSWINDOWS}
+uses
+  Windows;
+
+type
+  TDpiAwarenessContext = THandle;
+  TSetProcessDpiAwarenessContext = function(Value: TDpiAwarenessContext): BOOL; stdcall;
+  TSetProcessDpiAwareness = function(Value: Integer): HRESULT; stdcall;
+  TSetProcessDPIAware = function: BOOL; stdcall;
+
+const
+  DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 = TDpiAwarenessContext(PtrInt(-4));
+  DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE    = TDpiAwarenessContext(PtrInt(-3));
+  PROCESS_PER_MONITOR_DPI_AWARE              = 2;
+
+function TrySetDpiAwarenessContext(Value: TDpiAwarenessContext): Boolean;
+var
+  User32: HMODULE;
+  Proc: TSetProcessDpiAwarenessContext;
+begin
+  Result := False;
+  User32 := GetModuleHandle('user32.dll');
+  if User32 = 0 then Exit;
+  Proc := TSetProcessDpiAwarenessContext(GetProcAddress(User32, 'SetProcessDpiAwarenessContext'));
+  if Assigned(Proc) then
+    Result := Proc(Value);
+end;
+
+function TrySetDpiAwarenessShcore: Boolean;
+var
+  Shcore: HMODULE;
+  Proc: TSetProcessDpiAwareness;
+begin
+  Result := False;
+  Shcore := LoadLibrary('shcore.dll');
+  if Shcore = 0 then Exit;
+  try
+    Proc := TSetProcessDpiAwareness(GetProcAddress(Shcore, 'SetProcessDpiAwareness'));
+    if Assigned(Proc) then
+      Result := Proc(PROCESS_PER_MONITOR_DPI_AWARE) >= 0;
+  finally
+    FreeLibrary(Shcore);
+  end;
+end;
+
+function TrySetSystemDpiAware: Boolean;
+var
+  User32: HMODULE;
+  Proc: TSetProcessDPIAware;
+begin
+  Result := False;
+  User32 := GetModuleHandle('user32.dll');
+  if User32 = 0 then Exit;
+  Proc := TSetProcessDPIAware(GetProcAddress(User32, 'SetProcessDPIAware'));
+  if Assigned(Proc) then
+    Result := Proc();
+end;
+
+procedure EnableProcessDpiAwareness;
+begin
+  if TrySetDpiAwarenessContext(DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2) then Exit;
+  if TrySetDpiAwarenessContext(DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE) then Exit;
+  if TrySetDpiAwarenessShcore then Exit;
+  TrySetSystemDpiAware;
+end;
+
+{$ELSE}
+procedure EnableProcessDpiAwareness;
+begin
+end;
+{$ENDIF}
+
+end.

ewsdr.lpr

@@ -14,6 +14,7 @@ uses
   cthreads,
   {$ENDIF}
   Interfaces,  // LCL platform
+  WindowsDPI,
   Forms, MainForm, AudioOutput, DeviceForm, FlatButton, FreqDisplay, VfoOverlay,
   WDSP, WDSPEngine, WebPageHtml, WebServer, WebUtils, WinFirewall, WsClient,
   Settings;
@@ -21,6 +22,7 @@ uses
 {$R *.res}
 
 begin
+  EnableProcessDpiAwareness;
   RequireDerivedFormResource := True;
   Application.Title:='EWSDR';
   Application.Scaled:=True;