diff --git a/MainForm.pas b/MainForm.pas index 311b5d6..4bfd5dd 100644 --- a/MainForm.pas +++ b/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; - 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; diff --git a/WindowsDPI.pas b/WindowsDPI.pas new file mode 100644 index 0000000..ed1a460 --- /dev/null +++ b/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. diff --git a/ewsdr.lpr b/ewsdr.lpr index c41a720..f96552a 100644 --- a/ewsdr.lpr +++ b/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;