DPI_AWARENESS_CONTEXT

[Josep Roca]

Somebody knows hot to declare DPI_AWARENESS_CONTEXT?

According the MSDN documentation it is a handle.
See: https://learn.microsoft.com/en-us/windo ... ss-context

Code: Select all

#define DPI_AWARENESS_CONTEXT_UNAWARE              ((DPI_AWARENESS_CONTEXT)-1)
#define DPI_AWARENESS_CONTEXT_SYSTEM_AWARE         ((DPI_AWARENESS_CONTEXT)-2)
#define DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE    ((DPI_AWARENESS_CONTEXT)-3)
#define DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 ((DPI_AWARENESS_CONTEXT)-4)
#define DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED    ((DPI_AWARENESS_CONTEXT)-5)

I have found a C++ pre-processor macro

Code: Select all

#define DECLARE_HANDLE(name) type name##__ : as int unused : end type : type name as name##__ ptr

but I doesnt work if if use DECLARE_HANDLE(DPI_AWARENESS_CONTEXT)

Thanks in advance for any help.

[Josep Roca]

Additionally, the C runtime import library provided with the compiler must be outdated, because the functions tested works with 64 bit, but not with 32-bit (the linker reports undefined reference).

Code: Select all

enum DPI_AWARENESS
  DPI_AWARENESS_INVALID = -1
  DPI_AWARENESS_UNAWARE = 0
  DPI_AWARENESS_SYSTEM_AWARE = 1
  DPI_AWARENESS_PER_MONITOR_AWARE = 2
end enum

'#define DECLARE_HANDLE(name) type name##__ : as int unused : end type : type name as name##__ ptr
#define DPI_AWARENESS_CONTEXT HANDLE
'#define DPI_AWARENESS_CONTEXT_UNAWARE              ((DPI_AWARENESS_CONTEXT)-1)
'#define DPI_AWARENESS_CONTEXT_SYSTEM_AWARE         ((DPI_AWARENESS_CONTEXT)-2)
'#define DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE    ((DPI_AWARENESS_CONTEXT)-3)
'#define DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 ((DPI_AWARENESS_CONTEXT)-4)
'#define DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED    ((DPI_AWARENESS_CONTEXT)-5)

enum DPI_HOSTING_BEHAVIOR
  DPI_HOSTING_BEHAVIOR_INVALID = -1
  DPI_HOSTING_BEHAVIOR_DEFAULT = 0
  DPI_HOSTING_BEHAVIOR_MIXED = 1
end enum

enum DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS
  DCDC_DEFAULT = &h0000
  DCDC_DISABLE_FONT_UPDATE = &h0001
  DCDC_DISABLE_RELAYOUT = &h0002
end enum

enum DIALOG_DPI_CHANGE_BEHAVIORS
  DDC_DEFAULT = &h0000
  DDC_DISABLE_ALL = &h0001
  DDC_DISABLE_RESIZE = &h0002
  DDC_DISABLE_CONTROL_RELAYOUT = &h0004
end enum

extern "Windows-MS"

   DECLARE FUNCTION AdjustWindowRectExForDpi (BYVAL lpRect AS RECT PTR, BYVAL dwStyle AS DWORD, BYVAL bMenu As WINBOOL, _
      BYVAL dwExStyle AS DWORD, BYVAL dpi AS UINT) AS WINBOOL
   DECLARE FUNCTION AreDpiAwarenessContextsEqual (BYVAL dpiContextA AS DPI_AWARENESS_CONTEXT, BYVAL dpiContextB AS DPI_AWARENESS_CONTEXT) AS WINBOOL
   DECLARE FUNCTION EnableNonClientDpiScaling (BYVAL hwnd AS HWND) AS WINBOOL
   DECLARE FUNCTION GetAwarenessFromDpiAwarenessContext(BYVAL value AS DPI_AWARENESS_CONTEXT) AS DPI_AWARENESS
   DECLARE FUNCTION GetDialogControlDpiChangeBehavior (BYVAL hwnd AS HWND) AS DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS
   DECLARE FUNCTION GetDialogDpiChangeBehavior (BYVAL hDlg AS HWND) AS DIALOG_DPI_CHANGE_BEHAVIORS
   DECLARE FUNCTION GetDpiAwarenessContextForProcess (BYVAL hProcess AS HANDLE) AS DPI_AWARENESS_CONTEXT
   DECLARE FUNCTION GetDpiForSystem() AS UINT
   ' --- Works in 64-bit; undefined reference in 32-bit
   DECLARE FUNCTION GetDpiForWindow (BYVAL hwnd AS HWND) AS UINT
   ' --- Works in 64-bit; undefined reference in 32-bit
   DECLARE FUNCTION GetDpiFromDpiAwarenessContext (BYVAL value AS DPI_AWARENESS_CONTEXT) AS UINT
   DECLARE FUNCTION GetSystemDpiForProcess(BYVAL hProcess AS HANDLE) AS UINT
   DECLARE FUNCTION GetSystemMetricsForDpi (BYVAL nIndex AS int_, BYVAL dpi AS UINT) AS int_
   DECLARE FUNCTION GetThreadDpiAwarenessContext () AS DPI_AWARENESS_CONTEXT
   ' --- Works in 64-bit; undefined reference in 32-bit
   DECLARE FUNCTION GetThreadDpiHostingBehavior () AS DPI_HOSTING_BEHAVIOR
   DECLARE FUNCTION GetWindowDpiAwarenessContext (BYVAL hwnd AS HWND) AS DPI_AWARENESS_CONTEXT
   DECLARE FUNCTION InheritWindowMonitor (BYVAL hwnd AS HWND, BYVAL hwndInherit AS HWND) AS WINBOOL
   DECLARE FUNCTION IsValidDpiAwarenessContext (BYVAL value AS DPI_AWARENESS_CONTEXT) AS WINBOOL
   ' --- Works in 64-bit; undefined reference in 32-bit
   DECLARE FUNCTION LogicalToPhysicalPointForPerMonitorDPI (BYVAL hwnd AS HWND, BYVAL lpPoint AS LPPOINT) AS WINBOOL
   DECLARE FUNCTION PhysicalToLogicalPointForPerMonitorDPI (BYVAL hwnd AS HWND, BYVAL lpPoint AS LPPOINT) AS WINBOOL
   DECLARE FUNCTION SetDialogControlDpiChangeBehavior (BYVAL hwnd AS HWND, BYVAL mask AS DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS, _
      BYVAL values AS DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS) AS WINBOOL
   DECLARE FUNCTION SetProcessDpiAwarenessContext (BYVAL value AS DPI_AWARENESS_CONTEXT) AS WINBOOL
   DECLARE FUNCTION SetThreadCursorCreationScaling(BYVAL cursorDPI AS UINT) AS UINT
   DECLARE FUNCTION SetThreadDpiAwarenessContext (BYVAL dpiContext AS DPI_AWARENESS_CONTEXT) AS DPI_AWARENESS_CONTEXT
   DECLARE FUNCTION SetThreadDpiHostingBehavior (BYVAL value AS DPI_HOSTING_BEHAVIOR) AS DPI_HOSTING_BEHAVIOR
   DECLARE FUNCTION SystemParametersInfoForDpi (BYVAL uiAction AS UINT, BYVAL uiParam AS UINT, BYVAL pvParam AS PVOID, BYVAL fWinIni AS UINT, BYVAL dpi AS UINT) AS WINBOOL

end extern

[Josep Roca]

If I load the functions dynamically, they work with 32-bit, e.g.

Code: Select all

FUNCTION GetDpiForSystem () AS UINT
   DIM AS ANY PTR pLib = DyLibLoad("user32.dll")
   IF pLib = NULL THEN RETURN 0
   DIM pGetDpiForSystem AS FUNCTION () AS UINT
   pGetDpiForSystem = DyLibSymbol(pLib, "GetDpiForSystem")
   IF pGetDpiForSystem THEN FUNCTION = pGetDpiForSystem()
   DyLibFree(pLib)
END FUNCTION

[UEZ]

I stumbled across the same question a few years ago when I was researching DPI stuff, but I couldn't find a source that explained how to understand it.

[Josep Roca]

Maybe it can be used with

Code: Select all

#define DPI_AWARENESS_CONTEXT HANDLE
#macro DPI_AWARENESS_CONTEXT_UNAWARE (handle)
   handle-1
#endmacro

I will try to see if it works.

[UEZ]

Can you try this one here?

Code: Select all

#include once "windows.bi"

' Declare necessary Windows API functions
Declare Function SetThreadDpiAwarenessContext Lib "Shcore.dll" (ByVal dpiContext As Any Ptr) As Any Ptr


' Define DPI Awareness Contexts
#define DPI_AWARENESS_CONTEXT_UNAWARE              Cast(Any Ptr, -1)
#define DPI_AWARENESS_CONTEXT_SYSTEM_AWARE         Cast(Any Ptr, -2)
#define DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE    Cast(Any Ptr, -3)
#define DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 Cast(Any Ptr, -4)
#define DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED    Cast(Any Ptr, -5)

'https://docs.microsoft.com/en-us/windows/desktop/api/shellscalingapi/nf-shellscalingapi-setprocessdpiawareness
Function _WinAPI_SetProcessDpiAwareness(DPIAwareFlag As Any Ptr) As Any Ptr
	Dim As Any Ptr pLib = DyLibLoad("Shcore.dll")
	Dim pSetProcessDpiAwareness As Function(ByVal DPIAwareFlag As Any Ptr) As Any Ptr
	pSetProcessDpiAwareness = DyLibSymbol(pLib, "SetProcessDpiAwareness")
	Dim As Any Ptr pReturn = pSetProcessDpiAwareness(DPIAwareFlag)
	DyLibFree(pLib)
	If pReturn Then Return pReturn 
	Return 0
End Function

Function _WinAPI_SetThreadDpiAwarenessContext(iDPI_AWARENESS As Any Ptr) As Any Ptr 'Windows 10, version 1607 [desktop apps only]
	Dim As Any Ptr pLib = DyLibLoad("User32.dll")
	If pLib = NULL Then Exit Function
	Dim pSetThreadDpiAwarenessContext As Function (ByVal iDPI_AWARENESS As Any Ptr) As Any Ptr
	pSetThreadDpiAwarenessContext = DyLibSymbol(pLib, "SetThreadDpiAwarenessContext")
	Dim As Any Ptr pReturn = pSetThreadDpiAwarenessContext(iDPI_AWARENESS)
	DyLibFree(pLib)
	If pReturn Then Return pReturn 
	Return 0	
End Function

' Function to create a simple window
Function WindowProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT '...'
    Select Case uMsg
        Case WM_PAINT
            Dim ps As PAINTSTRUCT
            Dim hdc As HDC = BeginPaint(hWnd, @ps)

            ' Set text color and font size for better scaling
            SetTextColor(hdc, RGB(0, 0, 255))
            TextOut(hdc, 50, 50, "Hello, DPI-aware GDI Scaling!", 30)

            EndPaint(hWnd, @ps)
            Return 0

        Case WM_DESTROY
            PostQuitMessage(0)
            Return 0
    End Select

    Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function

' Main function to create a window and test DPI scaling
Sub RunApp()
    Dim wc As WNDCLASSEX
    Dim hWnd As HWND
    Dim msg As MSG

    wc.style         = CS_HREDRAW Or CS_VREDRAW
    wc.lpfnWndProc   = @WindowProc
    wc.cbClsExtra    = 0
    wc.cbWndExtra    = 0
    wc.hInstance     = GetModuleHandle(NULL)
    wc.hIcon         = LoadIcon(NULL, IDI_APPLICATION)
    wc.hCursor       = LoadCursor(NULL, IDC_ARROW)
    wc.hbrBackground = Cast(HBRUSH, COLOR_WINDOW + 1)
    wc.lpszMenuName  = NULL
    wc.lpszClassName = Cast(LPTSTR, StrPtr("MyWindowClass"))

    If RegisterClass(@wc) = 0 Then
        MessageBox(NULL, "Window Registration Failed!", "Error", MB_OK Or MB_ICONERROR)
        Exit Sub
    End If

    hWnd = CreateWindowEx(0,  wc.lpszClassName, "DPI Aware GDI Example", WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 500, 300, NULL, NULL, GetModuleHandle(NULL), NULL)

    If hWnd = NULL Then
        MessageBox(NULL, "Window Creation Failed!", "Error", MB_OK Or MB_ICONERROR)
        Exit Sub
    End If

    ShowWindow(hWnd, SW_SHOWNORMAL)
    UpdateWindow(hWnd)

    While GetMessage(@msg, NULL, 0, 0)
        TranslateMessage(@msg)
        DispatchMessage(@msg)
    Wend
End Sub

' Main program execution
Dim As Any Ptr pDPI = _WinAPI_SetThreadDpiAwarenessContext(DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED)
? pDPI
RunApp()

I asked ChatGPT

[Josep Roca]

It works! Thanks ChatGPT

The function _WinAPI_SetProcessDpiAwareness doesn't need the use of any ptr becasue it uses a "normal" enumeration:

Code: Select all

enum PROCESS_DPI_AWARENESS
  PROCESS_DPI_UNAWARE = 0
  PROCESS_SYSTEM_DPI_AWARE = 1
  PROCESS_PER_MONITOR_DPI_AWARE = 2
end enum

Code: Select all

Function _WinAPI_SetProcessDpiAwareness(BYVAL DPIAwareFlag As PROCESS_DPI_AWARENESS) As HRESULT
	Dim As Any Ptr pLib = DyLibLoad("Shcore.dll")
	Dim pSetProcessDpiAwareness As Function(ByVal DPIAwareFlag As PROCESS_DPI_AWARENESS) As HRESULT
	pSetProcessDpiAwareness = DyLibSymbol(pLib, "SetProcessDpiAwareness")
	Dim As HRESULT hr = pSetProcessDpiAwareness(DPIAwareFlag)
	DyLibFree(pLib)
	Return hr
End Function

[Josep Roca]

It also works if we use Cast(HANDLE, -1) instead of Cast(Any Ptr, -1), which looks more appropriate since Microsoft says that DPI_AWARENESS_CONTEXT is a handle.

[Löwenherz]

OK I have found These constants.. for SetProcessDpiAwarenessContext dont know If thats helping too

Code: Select all

#DPI_AWARENESS_CONTEXT_UNAWARE = 16
#DPI_AWARENESS_CONTEXT_SYSTEM_AWARE = 17
#DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE = 18
#DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 = 34

[Josep Roca]

@Löwenherz
These constants can be found in a VB forum and are foolish, but thanks for bothering.

The correct declarations, using the MSDN syntax, are the following.

Code: Select all

#define DPI_AWARENESS_CONTEXT HANDLE
#define DPI_AWARENESS_CONTEXT_UNAWARE              (CAST(DPI_AWARENESS_CONTEXT,-1))
#define DPI_AWARENESS_CONTEXT_SYSTEM_AWARE         (CAST(DPI_AWARENESS_CONTEXT,-2))
#define DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE    (CAST(DPI_AWARENESS_CONTEXT,-3))
#define DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 (CAST(DPI_AWARENESS_CONTEXT,-4))
#define DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED    (CAST(DPI_AWARENESS_CONTEXT,-5))

Code: Select all

enum PROCESS_DPI_AWARENESS
  PROCESS_DPI_UNAWARE = 0
  PROCESS_SYSTEM_DPI_AWARE = 1
  PROCESS_PER_MONITOR_DPI_AWARE = 2
end enum

The functions:

Code: Select all

Function SetProcessDpiAwareness(BYVAL value As PROCESS_DPI_AWARENESS) As HRESULT
	Dim As Any Ptr pLib = DyLibLoad("Shcore.dll")
	Dim pSetProcessDpiAwareness As Function(ByVal value As PROCESS_DPI_AWARENESS) As HRESULT
	pSetProcessDpiAwareness = DyLibSymbol(pLib, "SetProcessDpiAwareness")
	Dim As HRESULT hr = pSetProcessDpiAwareness(value)
	DyLibFree(pLib)
	Return hr
End Function

Function SetThreadDpiAwarenessContext(BYVAL dpiContext As DPI_AWARENESS_CONTEXT) As DPI_AWARENESS_CONTEXT
	Dim As Any Ptr pLib = DyLibLoad("User32.dll")
	If pLib = NULL Then Exit Function
	Dim pSetThreadDpiAwarenessContext As Function (ByVal dpiContext As DPI_AWARENESS_CONTEXT) As DPI_AWARENESS_CONTEXT
	pSetThreadDpiAwarenessContext = DyLibSymbol(pLib, "SetThreadDpiAwarenessContext")
	Dim hReturn AS DPI_AWARENESS_CONTEXT = pSetThreadDpiAwarenessContext(dpiContext)
	DyLibFree(pLib)
	Return hReturn
End Function

You call the functions as follows:

Code: Select all

SetProcessDpiAwareness(PROCESS_SYSTEM_DPI_AWARE)
SetThreadDpiAwarenessContext(DPI_AWARENESS_CONTEXT_SYSTEM_AWARE)

Tested with Windows 10. They work.

[UEZ]

It also works if we use Cast(HANDLE, -1) instead of Cast(Any Ptr, -1), which looks more appropriate since Microsoft says that DPI_AWARENESS_CONTEXT is a handle.

I don't know Integer -1 will be the same result as Cast(HANDLE, -1).

Code: Select all

#define DPI_AWARENESS_CONTEXT_UNAWARE                          -1
#define DPI_AWARENESS_CONTEXT_SYSTEM_AWARE                  -2
#define DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE        -3
#define DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2   -4
#define DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED         -5

Maybe this will work, too.

[Josep Roca]

No, it does not work (unless you declare the parameter as HANDLE, or ANY PTR, to force the compiler to do automatic conversion). The value must be unsigned, Instead of HANDLE, you can use ULong (in 32-bit) or ULongInt (in 64-bit). They are using negative numbers and casting them to a ULong or ULongInt to get a unsigned number. If you print these numbers in hexadecimal, you can see the pattern.

In 32-bit:
FFFFFFFF
FFFFFFFE
FFFFFFFD
FFFFFFFC
FFFFFFFB

In 64-bit:
FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFE
FFFFFFFFFFFFFFFD
FFFFFFFFFFFFFFFC
FFFFFFFFFFFFFFFB

A way to have different values for 32 and 64-bit with just one declaration (and to cause headaches to those who don't use C++).

[adeyblue]

It's in my modern Win32 headers and libs from the metadata Microsoft publish (https://www.freebasic.net/forum/viewtopic.php?t=32786). They're architected differently to the SDK headers, so this stuff is in ui.hidpi.bi rather than winuser.bi or whatever it's normally in. The metadata is laid out in 300+ arbitrary namespaces and was primarily meant for C#/Rust use, so don't blame me, it's not my choice of organisation.

Code: Select all

Extern "Windows"
'' DPI_AWARENESS documentation at https://learn.microsoft.com/windows/win32/api/windef/ne-windef-dpi_awareness
Enum '' DPI_AWARENESS
    DPI_AWARENESS_INVALID = -1,
    DPI_AWARENESS_UNAWARE = 0,
    DPI_AWARENESS_SYSTEM_AWARE = 1,
    DPI_AWARENESS_PER_MONITOR_AWARE = 2
End Enum '' DPI_AWARENESS
Type DPI_AWARENESS As ULong

'' DPI_HOSTING_BEHAVIOR documentation at https://learn.microsoft.com/windows/win32/api/windef/ne-windef-dpi_hosting_behavior
Enum '' DPI_HOSTING_BEHAVIOR
    DPI_HOSTING_BEHAVIOR_INVALID = -1,
    DPI_HOSTING_BEHAVIOR_DEFAULT = 0,
    DPI_HOSTING_BEHAVIOR_MIXED = 1
End Enum '' DPI_HOSTING_BEHAVIOR
Type DPI_HOSTING_BEHAVIOR As ULong

'' DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS documentation at https://learn.microsoft.com/windows/win32/api/winuser/ne-winuser-dialog_control_dpi_change_behaviors
Enum '' DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS
    DCDC_DEFAULT = 0,
    DCDC_DISABLE_FONT_UPDATE = 1,
    DCDC_DISABLE_RELAYOUT = 2
End Enum '' DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS
Type DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS As ULong

'' DIALOG_DPI_CHANGE_BEHAVIORS documentation at https://learn.microsoft.com/windows/win32/api/winuser/ne-winuser-dialog_dpi_change_behaviors
Enum '' DIALOG_DPI_CHANGE_BEHAVIORS
    DDC_DEFAULT = 0,
    DDC_DISABLE_ALL = 1,
    DDC_DISABLE_RESIZE = 2,
    DDC_DISABLE_CONTROL_RELAYOUT = 4
End Enum '' DIALOG_DPI_CHANGE_BEHAVIORS
Type DIALOG_DPI_CHANGE_BEHAVIORS As ULong

'' PROCESS_DPI_AWARENESS documentation at https://learn.microsoft.com/windows/win32/api/shellscalingapi/ne-shellscalingapi-process_dpi_awareness
Enum '' PROCESS_DPI_AWARENESS
    PROCESS_DPI_UNAWARE = 0,
    PROCESS_SYSTEM_DPI_AWARE = 1,
    PROCESS_PER_MONITOR_DPI_AWARE = 2
End Enum '' PROCESS_DPI_AWARENESS
Type PROCESS_DPI_AWARENESS As ULong

'' MONITOR_DPI_TYPE documentation at https://learn.microsoft.com/windows/win32/api/shellscalingapi/ne-shellscalingapi-monitor_dpi_type
Enum '' MONITOR_DPI_TYPE
    MDT_EFFECTIVE_DPI = 0,
    MDT_DEFAULT = 0,
    MDT_ANGULAR_DPI = 1,
    MDT_RAW_DPI = 2
End Enum '' MONITOR_DPI_TYPE
Type MONITOR_DPI_TYPE As ULong

Type DPI_AWARENESS_CONTEXT As Any Ptr

Const DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED As DPI_AWARENESS_CONTEXT = cast(DPI_AWARENESS_CONTEXT, -5)
Const DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 As DPI_AWARENESS_CONTEXT = cast(DPI_AWARENESS_CONTEXT, -4)
Const DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE As DPI_AWARENESS_CONTEXT = cast(DPI_AWARENESS_CONTEXT, -3)
Const DPI_AWARENESS_CONTEXT_SYSTEM_AWARE As DPI_AWARENESS_CONTEXT = cast(DPI_AWARENESS_CONTEXT, -2)
Const DPI_AWARENESS_CONTEXT_UNAWARE As DPI_AWARENESS_CONTEXT = cast(DPI_AWARENESS_CONTEXT, -1)

'' SetThreadDpiAwarenessContext documentation at https://learn.microsoft.com/windows/win32/api/winuser/nf-winuser-setthreaddpiawarenesscontext
'' Dll - USER32.dll
Declare Function SetThreadDpiAwarenessContext stdcall  (_ 
    ByVal dpiContext_ as DPI_AWARENESS_CONTEXT _ ''  In
) As DPI_AWARENESS_CONTEXT

'' GetThreadDpiAwarenessContext documentation at https://learn.microsoft.com/windows/win32/api/winuser/nf-winuser-getthreaddpiawarenesscontext
'' Dll - USER32.dll
Declare Function GetThreadDpiAwarenessContext stdcall  () As DPI_AWARENESS_CONTEXT

'' GetWindowDpiAwarenessContext documentation at https://learn.microsoft.com/windows/win32/api/winuser/nf-winuser-getwindowdpiawarenesscontext
'' Dll - USER32.dll
Declare Function GetWindowDpiAwarenessContext stdcall  (_ 
    ByVal hwnd_ as HWND _ ''  In
) As DPI_AWARENESS_CONTEXT

'' GetAwarenessFromDpiAwarenessContext documentation at https://learn.microsoft.com/windows/win32/api/winuser/nf-winuser-getawarenessfromdpiawarenesscontext
'' Dll - USER32.dll
Declare Function GetAwarenessFromDpiAwarenessContext stdcall  (_ 
    ByVal value_ as DPI_AWARENESS_CONTEXT _ ''  In
) As DPI_AWARENESS

'' GetDpiFromDpiAwarenessContext documentation at https://learn.microsoft.com/windows/win32/api/winuser/nf-winuser-getdpifromdpiawarenesscontext
'' Dll - USER32.dll
Declare Function GetDpiFromDpiAwarenessContext stdcall  (_ 
    ByVal value_ as DPI_AWARENESS_CONTEXT _ ''  In
) As ULong

'' AreDpiAwarenessContextsEqual documentation at https://learn.microsoft.com/windows/win32/api/winuser/nf-winuser-aredpiawarenesscontextsequal
'' Dll - USER32.dll
Declare Function AreDpiAwarenessContextsEqual stdcall  (_ 
    ByVal dpiContextA_ as DPI_AWARENESS_CONTEXT,  _ ''  In
    ByVal dpiContextB_ as DPI_AWARENESS_CONTEXT _ ''  In
) As BOOL

'' IsValidDpiAwarenessContext documentation at https://learn.microsoft.com/windows/win32/api/winuser/nf-winuser-isvaliddpiawarenesscontext
'' Dll - USER32.dll
Declare Function IsValidDpiAwarenessContext stdcall  (_ 
    ByVal value_ as DPI_AWARENESS_CONTEXT _ ''  In
) As BOOL

If you're going to transcribe anything more modern than the FB Windows headers have, have a findstr/grep in there first. The last update was the SDK from four months ago, so it's probably in there somewhere, it'll just need finding.

[UEZ]

I created a test GUI and it seems to work properly.

DPI Demo.bas:

Code: Select all

'Coded by UEZ build 2025-03-27
#cmdline "'App.rc'"
#include "_WinAPI_DpiAwareness.bi"

Declare Function RtlGetVersion Lib "NtDll.dll" Alias "RtlGetVersion" (OsVersionInformation As RTL_OSVERSIONINFOW) As Long

Dim Shared As Single fDPI

Function WindowProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT
    Select Case uMsg
        Case WM_PAINT
            Dim ps As PAINTSTRUCT
            Dim hdc As HDC = BeginPaint(hWnd, @ps)

     		Dim hFont As HFONT = CreateFont(36 * fDPI, 0, 0, 0, FW_BOLD, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, ANTIALIASED_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, "Arial")
    
		    Dim hOldFont As HFONT = Cast(hFont, SelectObject(hdc, hFont))
            Dim As String sTxt = "Hello, DPI-aware demo! DPI: " & fDPI
            TextOut(hdc, 50, 50, sTxt , Len(sTxt))
            EndPaint(hWnd, @ps)
            Return 0
    	Case WM_DPICHANGED
    		Dim As RECT Ptr tPOS = Cast(RECT Ptr, lParam)
    		Dim As RECT tWin 
    		GetWindowRect(hWnd, @tWin)
    		SetWindowPos(hWnd, HWND_NOTOPMOST, tWin.left, tWin.top, tPOS->right - tPOS->left, tPOS->bottom - tPOS->top, SWP_SHOWWINDOW)
    		fDPI = LoWord(wParam) / 96
    		Return 0
        Case WM_DESTROY
            PostQuitMessage(0)
            Return 0
    End Select

    Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function


Sub RunApp()
    Dim wc As WNDCLASSEX
    Dim hWnd As HWND
    Dim msg As MSG
	
	wc.cbSize		 = SizeOf(WNDCLASSEX)
    wc.style         = CS_HREDRAW Or CS_VREDRAW
    wc.lpfnWndProc   = @WindowProc
    wc.hInstance     = GetModuleHandle(NULL)
    wc.hIcon         = LoadIcon(NULL, IDI_APPLICATION)
    wc.hCursor       = LoadCursor(NULL, IDC_ARROW)
    wc.hbrBackground = Cast(HBRUSH, COLOR_WINDOW + 1)
    wc.lpszMenuName  = NULL
    wc.lpszClassName = Cast(LPTSTR, StrPtr("MyWindowClass"))

    If RegisterClassEx(@wc) = 0 Then
        MessageBox(NULL, "Window Registration Failed!", "Error", MB_OK Or MB_ICONERROR)
        Exit Sub
    End If

    hWnd = CreateWindowEx(0,  wc.lpszClassName, "DPI Aware GDI Example", WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 600, 300, NULL, NULL, GetModuleHandle(NULL), NULL)

    If hWnd = NULL Then
        MessageBox(NULL, "Window Creation Failed!", "Error", MB_OK Or MB_ICONERROR)
        Exit Sub
    End If

    ShowWindow(hWnd, SW_SHOWNORMAL)
    UpdateWindow(hWnd)
	
    While GetMessage(@msg, NULL, 0, 0)
        TranslateMessage(@msg)
        DispatchMessage(@msg)
    Wend
End Sub

Function MonitorEnumProc(hMonitor As HMONITOR, hDC As HDC, r As RECT, d As LPARAM) As BOOL
	Dim As tDPI dpiM
	_WinAPI_GetDpiForMonitor(hMonitor, MDT_EFFECTIVE_DPI, dpiM)
	
	Dim As MONITORINFOEX tMI
	tMI.cbSize = SizeOf(MONITORINFOEX)
	GetMonitorInfo(hMonitor, Cast(LPMONITORINFO, @tMI))
	
	Static As DISPLAY_DEVICE tDD
	tDD.cb = SizeOf(DISPLAY_DEVICE)
	EnumDisplayDevices(tMI.szDevice, 0, @tDD, 0) 'https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-enumdisplaydevicesw
	
	? dpiM.dpiX, dpiM.dpiX / 96, tMI.szDevice, tDD.DeviceString, IIf(tMI.dwFlags = MONITORINFOF_PRIMARY, True, False)
	
	Return True
End Function

Dim As RTL_OSVERSIONINFOW OS
OS.dwOSVersionInfoSize = SizeOf(RTL_OSVERSIONINFOW)
RtlGetVersion(OS)
If OS.dwBuildNumber < 14393 Then
	End MessageBox(0, "Most of the WINAPI functions require OS build number > 14393 aka Win10 1607+ ", "ERROR", MB_OK Or MB_ICONSTOP Or MB_TOPMOST)
End If

? "Monitor information"
EnumDisplayMonitors(0, 0, Cast(MonitorEnumProc, @MonitorEnumProc), 0) 'https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-enumdisplaymonitors

fDPI = _WinAPI_GetDpiForSystem() / 96
Dim As BOOL iDPI = _WinAPI_SetProcessDpiAwarenessContext(DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2)

RunApp()

The rest of the files can be found on my 1Drv: _WinAPI_DPIAwarness

Most of the DPI functions require Win10+!

[Löwenherz]

similar topic: AfxSetProcessDPIAware
I have changed only the fontsize
works also perfect.

IF pWindow->DPI <> 192 THEN hNewFont = pWindow->CreateFont("Tahoma", 34)

Code: Select all

' ########################################################################################
' Microsoft Windows
' File: CW_GDI_HelloWordGradient_HDPI.fbtpl
' Contents: CWindow Hello Word with gradient example (High DPI)
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' Gradient fill procedure
' ========================================================================================
SUB DrawGradient (BYVAL hDC AS HDC)

   DIM rcFill   AS RECT
   DIM rcClient AS RECT
   DIM fStep    AS SINGLE
   DIM hBrush   AS HBRUSH
   DIM lOnBand  AS LONG

   GetClientRect WindowFromDC(hDC), @rcClient
   fStep = rcClient.Bottom / 200

   FOR lOnBand = 0 TO 199
      SetRect @rcFill, 0, lOnBand * fStep, rcClient.Right + 1, (lOnBand + 1) * fStep
      ' // Note: The C macro RGB has been renamed as BGR to avoid conflicts with the Free Basic RGB intrinsic function
      hBrush = CreateSolidBrush(BGR(0, 0, (255 - lOnBand)))
      FillRect hDC, @rcFill, hBrush
      DeleteObject hBrush
   NEXT

END SUB
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   ' // Create the main window
   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow Hello World with gradient", @WndProc)
   pWindow.Brush = GetStockObject(WHITE_BRUSH)
   pWindow.SetClientSize(500, 320)
   pWindow.Center

   ' // Add two buttons without position or size (they will be resized in the WM_SIZE message).
   pWindow.AddControl("Button", pWindow.hWindow, IDOK,     "&Ok")
   pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Quit")

   

   ' // Dispatch Windows messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window callback procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   STATIC hNewFont AS HFONT

   SELECT CASE uMsg

      CASE WM_CREATE
         ' // Get a pointer to the CWindow class from the CREATESTRUCT structure
         DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
         ' // Create a new font scaled according the DPI ratio
         'IF pWindow->DPI <> 96 THEN hNewFont = pWindow->CreateFont("Tahoma", 9)
         ' changed for a test below
         IF pWindow->DPI <> 192 THEN hNewFont = pWindow->CreateFont("Tahoma", 34)
         EXIT FUNCTION

      CASE WM_COMMAND
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_PAINT
         ' // Draw the text
         DIM ps AS PAINTSTRUCT, hOldFont AS HFONT
         DIM hDC AS HDC = BeginPaint(hwnd, @ps)
         IF hNewFont THEN hOldFont = CAST(HFONT, SelectObject(hDC, CAST(HGDIOBJ, hNewFont)))
         DIM rc AS RECT
         GetClientRect hwnd, @rc
         SetBkMode hDC, TRANSPARENT
         SetTextColor hDC, &HFFFFFF
         DrawTextW hDC, "Hello, Freebasic World!", -1, @rc, DT_SINGLELINE OR DT_CENTER OR DT_VCENTER
         IF hNewFont THEN SelectObject(hDC, CAST(HGDIOBJ, CAST(HFONT, hOldFont)))
         EndPaint hwnd, @ps
         FUNCTION = CTRUE
         EXIT FUNCTION

      CASE WM_ERASEBKGND
         ' // Draw the gradient
         DIM hDC AS HDC = CAST(HDC, wParam)
         DrawGradient hDC
         FUNCTION = CTRUE
         EXIT FUNCTION

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Resize the buttons
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            pWindow->MoveWindow GetDlgItem(hwnd, IDOK), pWindow->ClientWidth - 185, pWindow->ClientHeight - 35, 75, 23, CTRUE
            pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 95, pWindow->ClientHeight - 35, 75, 23, CTRUE
         END IF

    	CASE WM_DESTROY
         ' // Destroy the new font
         IF hNewFont THEN DeleteObject(CAST(HGDIOBJ, hNewFont))
         ' // End the application by sending an WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================