mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 17:27:32 +00:00
Enable Windows DPI awareness
This commit is contained in:
+8
-6
@@ -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;
|
||||
|
||||
|
||||
@@ -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.
|
||||
@@ -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;
|
||||
|
||||
Reference in New Issue
Block a user