Enable Windows DPI awareness

This commit is contained in:
2026-05-24 16:29:13 +03:00
parent 8624116f0c
commit ffb735756e
3 changed files with 95 additions and 6 deletions
+8 -6
View File
@@ -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;
if CurDPI <= 0 then CurDPI := Screen.PixelsPerInch;
if CurDPI <= 0 then CurDPI := 96;
CurDPI := CurrentScreenDPI;
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;
if DPI <= 0 then DPI := Screen.PixelsPerInch;
if DPI <= 0 then DPI := 96;
DPI := CurrentScreenDPI;
FSettings.SaveWindowBounds(L, T, Wd, Ht, DPI);
end;
+85
View File
@@ -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.
+2
View File
@@ -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;