Enable Windows DPI awareness

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.