VB6 - Simple way to make your VB6 application "Per-Monitor DPI Aware"

[VanGoghGaming]

This sample project shows how you can automatically resize your form and its controls as well as adjust their font sizes whenever the current DPI changes (the user runs their desktop at a different DPI, or changes the DPI on a whim or maybe drags your window to another monitor with a different DPI).

The main prerequisite is that your app is manifested for "PerMonitorV2":

<dpiAwareness xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">PerMonitorV2</dpiAwareness>

A sample manifest is included in the project for this purpose. Now the system will send the WM_DPICHANGED message whenever the current DPI changes (this includes the first time your app is executed on a system with non-standard DPI (other than 96), as well as subsequent changes in real time).

The demo project below includes a form and some of the most frequently encountered controls (CommandButton, Frame, OptionButton, CheckBox, Label, TextBox, Image, HScrollBar, ComboBox) but the concept remains the same for any other controls you might use:

DPI Awareness Test - 100% Scaling:



DPI Awareness Test - 125% Scaling:



DPI Awareness Test - 150% Scaling:



DPI Awareness Test - 175% Scaling:



I only have a couple of Full HD monitors (1920x1080) so I could only test 100%, 125%, 150% and 175% scaling modes. I would be interested to see if the scaling works just as well on 2k and 4k monitors if someone else could test it.

The concept is fairly simple, just subclass your form and intercept the "WM_DPICHANGED" message which will kindly provide you with the new scaling factor and window size for your form. From there all it takes is to resize the rest of your controls and their font sizes with the new scaling factor:

frmDPITest

Option Explicit

Implements ISubclass

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const WM_DPICHANGED As Long = &H2E0, LOGPIXELSX As Long = 88, SWP_NOACTIVATE As Long = &H10, SWP_NOOWNERZORDER As Long = &H200, SWP_NOZORDER As Long = &H4

Private m_lOrigWndProc As Long, lInitialDPI As Long, sngScaleFactor As Single

Private Sub cmdAnotherCommandButton_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    cmbComboBox.AddItem TypeName(cmbComboBox): cmbComboBox.ListIndex = 0
    lInitialDPI = GetDeviceCaps(hDC, LOGPIXELSX): sngScaleFactor = lInitialDPI / 96 ' Calculate the initial DPI and ScaleFactor values
    SubclassWnd hWnd, Me ' Subclass the form to check for DPI changes
End Sub

Private Sub ResizeControls()
Dim xControl As Control
    If sngScaleFactor <> 1 Then ' Resize controls only when the ScaleFactor has changed
        For Each xControl In Controls
            With xControl
                Select Case True
                    Case TypeOf xControl Is CommandButton, TypeOf xControl Is Frame, TypeOf xControl Is OptionButton, TypeOf xControl Is CheckBox, TypeOf xControl Is Label, TypeOf xControl Is TextBox
                        .Left = .Left * sngScaleFactor: .Top = .Top * sngScaleFactor: .Width = .Width * sngScaleFactor
                        .Font.Size = .Font.Size * sngScaleFactor: .Height = .Height * sngScaleFactor
                    Case TypeOf xControl Is ComboBox ' Height is ReadOnly for a ComboBox
                        .Left = .Left * sngScaleFactor: .Top = .Top * sngScaleFactor: .Width = .Width * sngScaleFactor: .Font.Size = .Font.Size * sngScaleFactor
                    Case TypeOf xControl Is HScrollBar, TypeOf xControl Is Image ' These controls don't have a Font property
                        .Left = .Left * sngScaleFactor: .Top = .Top * sngScaleFactor: .Width = .Width * sngScaleFactor: .Height = .Height * sngScaleFactor
                End Select
            End With
        Next xControl
    End If
End Sub

Private Property Get ISubclass_OrigWndProc() As Long
    ISubclass_OrigWndProc = m_lOrigWndProc
End Property

Private Property Let ISubclass_OrigWndProc(lOrigWndProc As Long)
    m_lOrigWndProc = lOrigWndProc
End Property

Private Function ISubclass_WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static lNewDPI As Long
Dim bDiscardMessage As Boolean
    Select Case uMsg
        Case WM_DPICHANGED ' This message signals a change in the DPI of the current monitor or the window was dragged to a monitor with a different DPI
            Dim rcWndRect As RECT, lOldDPI As Long
            If lNewDPI Then lOldDPI = lNewDPI Else lOldDPI = lInitialDPI
            lNewDPI = wParam And &HFFFF&: sngScaleFactor = lNewDPI / lOldDPI ' Calculate the new DPI value and ScaleFactor
            CopyMemory ByVal VarPtr(rcWndRect), ByVal lParam, LenB(rcWndRect) ' The new suggested window size is saved in a RECT structure pointed by lParam
            With rcWndRect
                SetWindowPos hWnd, 0, .Left, .Top, .Right - .Left, .Bottom - .Top, SWP_NOACTIVATE Or SWP_NOOWNERZORDER Or SWP_NOZORDER ' Resize the form to reflect the new DPI changes
            End With
            ResizeControls ' After the form is resized do the same for all its controls
    End Select
    If Not bDiscardMessage Then ISubclass_WndProc = CallWindowProc(m_lOrigWndProc, hWnd, uMsg, wParam, lParam)
End Function

mdlSubclass - This module demonstrates the original subclassing method (changing a window's procedure with SetWindowLong) but you can easily replace it with the newer "comctl32" subclassing method (using the "SetWindowSubclass" API). I just wanted to see if I could use "SetWindowLong" to mimic the same behavior (as an exercise):

Option Explicit

Private Const GWL_WNDPROC As Long = (-4), GWL_USERDATA As Long = (-21), WM_NCDESTROY As Long = &H82

Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (dstObject As Any, ByVal lpObject As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Function SubclassWnd(hWnd As Long, Subclass As ISubclass) As Boolean
    With Subclass
        If .OrigWndProc = 0 Then
            .OrigWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc) ' Save the original Window Procedure and then subclass it
            SetWindowLong hWnd, GWL_USERDATA, ObjPtr(Subclass): SubclassWnd = True ' Save a reference to our subclassed object
        End If
    End With
End Function

Private Function UnSubclassWnd(hWnd As Long, Subclass As ISubclass) As Boolean
    With Subclass
        If .OrigWndProc Then SetWindowLong hWnd, GWL_WNDPROC, .OrigWndProc: UnSubclassWnd = True ' Remove the subclass and restore the original Window Procedure
    End With
End Function

Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Subclass As ISubclass
    vbaObjSetAddref Subclass, GetWindowLong(hWnd, GWL_USERDATA) ' Return an object from a pointer (inverse of ObjPtr). This is our subclassed object whose reference we saved above
    Select Case uMsg
        Case WM_NCDESTROY ' Remove subclassing as the window is about to be destroyed
            UnSubclassWnd hWnd, Subclass
            CallWindowProc Subclass.OrigWndProc, hWnd, uMsg, wParam, lParam
        Case Else
            WndProc = Subclass.WndProc(hWnd, uMsg, wParam, lParam) ' Pass all messages to our custom subclassed procedure
    End Select
End Function

ISubclass

Option Explicit

Public Property Get OrigWndProc() As Long

End Property

Public Property Let OrigWndProc(lOrigWndProc As Long)

End Property

Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

End Function

Here is the demo project: DPITest.zip

[baka]

how about a monitor that uses different aspect ratio resolution? not all are 16:9
will this work in windows 7,8,10,11?

[rboeck]

I tested with this configuration: Left and primary display: 27 " with resolution of 2540 x 1440, 100% scaling, second display 4k ( 3840 x 2160), 175 % scaling.

For me it works perfect, the form looks identical in size, when i drop it from left to right

[VanGoghGaming]

how about a monitor that uses different aspect ratio resolution? not all are 16:9
will this work in windows 7,8,10,11?

Pretty sure the WM_DPICHANGED message requires at least Windows 8.1. Aspect ratio shouldn't matter at all as long as your form fits on the screen but feel free to test. In fact if you have two monitors with different aspect ratios (16:9 vs 4:3) but they are both running at the same DPI (for example 96 DPI - 100% scaling) then the WM_DPICHANGED message is not even sent at all when you move your window from one monitor to the other. This is intended only for resizing user interfaces when the DPI changes.

[VanGoghGaming]

For me it works perfect, the form looks identical in size, when i drop it from left to right

You need to compile the project and run the executable to observe the form scaling when moved to another monitor with a different DPI. This won't work in the IDE unless you apply the same manifest to VB6.EXE which can be achieved with the "manifest tool" (MT.EXE) that you can find in the Windows SDK.

[Dragokas]

Thanks a much for this easy and nice example.
I have both 2k and 4k, so I may test. Atm I don't see issues with your project.

As about dynamic DPI change tracking: I see it with a quite limited usage, because the only OS which support dpi change without requirement to logoff, I know of, is Win10.
Other: Win 7, Win 8.1 and Win 11 require user to log off/log on as soon as I try to change the dpi. Correct me if I doing it wrong. Here is settings for Win 11.

Also about:

You need to compile the project and run the executable to observe the form scaling when moved to another monitor with a different DPI

if you know, please explain, how is it possible to have different dpi on the secondary monitor? Because... the only settings I know of is system-wide, which applied to both monitors. Is there place where I can define it separately per each monitor?

[VanGoghGaming]

You can definitely have different scaling for each monitor, otherwise the scaling options wouldn't make sense at all and there wouldn't be a "PerMonitorV2" manifest option... First go to "Settings -> System -> Display" and click on the monitor for which you wish to change the scaling and then scroll down to "Scale and layout":



There you can see different scaling options depending on the native resolution of the selected monitor. For a "Full HD" monitor (1920x1080) there are four available scaling modes (100% (Recommended), 125%, 150% and 175%).

Also from the article that you linked:

"Windows 11 applies the new scaling immediately and without the need to restart the system or sign out of your profile. Still, you might need to reopen some apps that do not support per-monitor DPI-awareness version 2."

Just figured I should ask you though, are your monitors set to "Extend these displays", like in the screenshot above? I don't think it will work if they are set to "mirror" each other, they must be separate entities to have different DPIs.

[Dragokas]

VanGoghGaming, thanks and sorry for confusion.
Yeah, it's "Extend these displays" option. It seems it's kind a tricky:
- on Win7 there is really no way to control per-monitor dpi; it's applied on both monitors simultaneously as soon as I try to change it and logoff.
- on Win10, I checked, and dpi is really splitted per monitor.

As about logoff:

"Windows 11 applies the new scaling immediately and without the need to restart the system or sign out of your profile. Still, you might need to reopen some apps that do not support per-monitor DPI-awareness version 2."

is correct, until you try to specify user-defined dpi*. In that case windows require me a logoff.
* it's a sub-menu here: https://ibb.co/mHpmfyG

[VanGoghGaming]

Well, yeah, I didn't even take Win7 under consideration. In fact, the "WM_DPICHANGED" message requires Win8.1 or newer. Also I don't think there are many users willing to mess around with custom scaling factors. It's also available in Windows 10 under "Advanced scaling settings" and it does say it will be applied to all monitors but I was never curious to try it...

The predefined values work well for most people and then you can set different scaling factors independently for each monitor in Windows 11 and you will receive the "WM_DPICHANGED" message when moving your app from one monitor to another.

[Maurizio]

Hi VanGogh,

i really appreciate your way to deal dpiaware application subclassing window message.

I have both 2k and 4k monitors, so i can test the code with all resolutions and dpi settings needed.

For the following test my setting have been 4k resolution (3840*2160 pixel) with a text scale of 250%. This way i have 240 dpi.

I downloaded your project but i have an issue:

1) I compile the exe of your project but the DpiTest.exe i get doesn't work. When i start the DpiTest.exe, i get an error on "side by side application error" from windows (look here i have this one https://answers.microsoft.com/en-us/...9-f3b13612e304) .
After some try i have found that if i remove the .res file in the project, the DpiTest.exe run successfully and it works fine to detect the correct dpi (240 dpi in my test), because you have an external manifest file. If i rename the .manifest file, the DpiTest.exe (without .res inside) is no more DpiAware and it no more detect the correct dpi (i get 96 dpi).

So, it seems there is something to fix with the .res file, can you check ?

More...what is inside the res ? I think it is an embedded Manifest, it is ? I think that an embedded manifest is a plus!

Thanks in advance
Maurizio

P.S. In the following image the image on the left is 4k 250% text scale 240 dpi, i changed to 150% text scale for the image in the middle, and i restored to 250% for the image on the rigth, it seems to work.



Attachment 189824

[Maurizio]

Dear Vangogh,

i have found the following on the web:

https://stackoverflow.com/questions/...into-a-vb6-exe

"The VB6 compiler does indeed require that an arbitrary text file included in a resource must be an exact multiple of 4 bytes. I simply added spaces to the XML until Notepad++ told me that the total file size including BOM was a multiple of 4."

But it seems to me that your .res is already 4 byte multiple...

So ?

Bye
Maurizio

[VanGoghGaming]

The manifest embedded in the resource file works fine mate. Just delete or rename the external manifest file if your Windows complains about it.

[Maurizio]

I renamed the external manifest but still the error is here!

Ok i changed the length of the external manifest adding a space, after i run the makeres.bat to rebuild the res file.

Now it works with the embedded res.

The following attachment have both manifest and res modified as the DpiTest.exe that works fine on my pc.

DPITestModifiedFiles.zip

[VanGoghGaming]

I find that hard to believe since it works fine for everyone else but anyway you can easily edit it in Notepad and add some spaces to make its size a multiple of 4 bytes. Then you can use the included "MAKERES.BAT" from the ZIP archive to compile it into a resource file.

[Maurizio]

I solved, thanks so much.

In the next days i plan to use your tip on my app, i'll let you know if i have something nice.

Thanks so much
You are really kind.

Maurizio

[taishan]

Excellent work BroVanGogh !! tested on dual 4k monitors, one 65" (150% scale) the other an 86" at 300%, form looked as though it was drawn in Cairo. Very impressive

[HackerVlad]

Yes, I also like the work of a VanGoghGaming user

[Thierry76]

Thanks a lot VanGoghGaming !!!
(I had to add a space into the manifest like Maurizio, but it was not the first time I need to do that, and i know the stackoverflow tip)

[VanGoghGaming]

You need to install SP6 if you don't already have it! That will solve the bug with the manifest file size required to be a multiple of 4!

Anyway here's a short drop-in module that can be included into any project adding this DPI-resizing functionality to all its forms:

mdlDPIChange.bas

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const WM_NCDESTROY As Long = &H82, WM_DPICHANGED As Long = &H2E0, LOGPIXELSX As Long = &H58, SWP_NOACTIVATE As Long = &H10, SWP_NOOWNERZORDER As Long = &H200, SWP_NOZORDER As Long = &H4

Private Declare Function SetWindowSubclass Lib "comctl32" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function DefSubclassProc Lib "comctl32" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private lNewDPI As Long, sngScaleFactor As Single, xControl As Control

Public Function SubclassForm(objForm As Form, Optional dwRefData As Long) As Boolean
    If dwRefData = 0 Then dwRefData = GetDeviceCaps(objForm.hDC, LOGPIXELSX)
    SubclassForm = SetWindowSubclass(objForm.hWnd, AddressOf WndProc, ObjPtr(objForm), dwRefData)
End Function

Public Function UnSubclassForm(hWnd As Long, uIdSubclass As Long) As Boolean
    UnSubclassForm = RemoveWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass)
End Function

Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As RECT, ByVal objForm As Form, ByVal dwRefData As Long) As Long
    Select Case uMsg
        Case WM_NCDESTROY ' Remove subclassing as the window is about to be destroyed
            UnSubclassForm hWnd, ObjPtr(objForm)
        Case WM_DPICHANGED ' This message signals a change in the DPI of the current monitor or the window was dragged to a monitor with a different DPI
            lNewDPI = wParam And &HFFFF&: sngScaleFactor = lNewDPI / dwRefData: SubclassForm objForm, lNewDPI ' Calculate the new DPI and ScaleFactor and update dwRefData
            With lParam
                SetWindowPos hWnd, 0, .Left, .Top, .Right - .Left, .Bottom - .Top, SWP_NOACTIVATE Or SWP_NOOWNERZORDER Or SWP_NOZORDER ' Resize the form to reflect the new DPI changes
            End With
            objForm.Font.Size = objForm.Font.Size * sngScaleFactor
            For Each xControl In objForm.Controls ' After the form is resized do the same for all its controls
                If Not (TypeOf xControl Is Timer Or TypeOf xControl Is Menu) Then ' Do not process controls without dimensions
                    With xControl
                        .Left = .Left * sngScaleFactor: .Top = .Top * sngScaleFactor: .Width = .Width * sngScaleFactor ' Common properties for most controls
                        Select Case True
                            Case TypeOf xControl Is Label, TypeOf xControl Is TextBox, TypeOf xControl Is CommandButton, TypeOf xControl Is Frame, TypeOf xControl Is PictureBox, _
                                 TypeOf xControl Is ListBox, TypeOf xControl Is OptionButton, TypeOf xControl Is CheckBox
                                .Font.Size = .Font.Size * sngScaleFactor: .Height = .Height * sngScaleFactor
                            Case TypeOf xControl Is ComboBox ' Height is ReadOnly for a ComboBox
                                .Font.Size = .Font.Size * sngScaleFactor
                            Case TypeOf xControl Is HScrollBar, TypeOf xControl Is Image ' These controls don't have a Font property
                                .Height = .Height * sngScaleFactor
                        End Select
                    End With
                End If
            Next xControl
    End Select
    WndProc = DefSubclassProc(hWnd, uMsg, wParam, VarPtr(lParam))
End Function

Then add "SubclassForm Me" to any "Form_Load()" and you're done! You may need to tweak the "Select Case" statement to include any other controls that are not already present in the list.