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

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":

Code:

---

<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:

Attachment 188534

DPI Awareness Test - 125% Scaling:

Attachment 188535

DPI Awareness Test - 150% Scaling:

Attachment 188536

DPI Awareness Test - 175% Scaling:

Attachment 188537

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

Code:

---

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):

Code:

---

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

Code:

---

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: Attachment 188538

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

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

Quote:

---

Originally Posted by 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?

---

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.

Quote:

---

Originally Posted by rboeck

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.

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:

Quote:

---

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?

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":

Attachment 188817

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.

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:

Quote:

---

"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

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.

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

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

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

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.

Attachment 189825

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.

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

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 :cool:

Yes, I also like the work of a VanGoghGaming user

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)

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

Code:

---

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.

It appears that even when you have your application manifested as dpi per-monitor aware that Windows still handles the resizing of the form itself when switching DPI if the form is a fixed size. Meaning, if I do nothing to adjust the scaling of my controls and I drag a window between different DPI's, Windows still changes the width and height of the form. It seems to only do this for forms set as fixed single. I understand that this should be normal behavior because the controls should be scaled to fit, but is there a way to control that functionality to either eliminate or fine tune that sizing that Windows is doing?

You receive the WM_DPICHANGED message when you drag your window to another monitor with different DPI or when you change the DPI of the current monitor. That is when you need to re-arrange everything.

Quote:

---

Originally Posted by VanGoghGaming

You receive the WM_DPICHANGED message when you drag your window to another monitor with different DPI or when you change the DPI of the current monitor. That is when you need to re-arrange everything.

---

Sorry if I was unclear in my question. I am asking specifically about the width and height of the form itself, not its contents. Windows is still controlling that when the form has a "fixed single" border style even when I say the app is dpi monitor aware.

You don't need to have a manifest in order to make your application per-monitor DPI aware. I use Richclient 5 and 6 and there is a set DPI aware switch that you can use. This turns DPI awareness ON.

With that switch enabled you can definitely subClass and gather WM_DPICHANGED messages as they occur and then change the scaling of your app. accordingly.

I have not yet tested it with the SetProcessDPIAware API but I will do that next and return the results later.

SetProcessDPIAware -> It is recommended that you set the process-default DPI awareness via application manifest, not an API call.

Oh yes, I saw that, some time ago in fact. However, recommendations from Microoosoooft not to use deprecated APIs are really just that, in my experience so far. I use several APIs that MS has said not to use for over ten years. They still work with very little or absolutely zero side effect. Often, MS recommendations are meant to coerce you into using something they want you to - and nothing more.

With regard to the SetProcessDPIAware API, testing over time will prove that so I am happy to do that testing.

In any case, I am actually using Olaf's RC5/6 DPI aware switch. Now, I don't know whether that is just a wrapper around the same API or the later context one, I suspect it is one or the other. In any case, Olaf seemed confident enough to include it, to wrap it in his code and call it to set DPI awareness - unless he has found another way to switch DPI awareness ON.

PS. I am avoiding manifests where possible as they have side effects I do not want.

On a side note, capturing the WM_DPICHANGED message is a very nice method of catching the point where your form moves from one monitor to another.

Unfortunately, it only operates when the DPI scaling of one monitor is different from another.

Do you happen to know of any other API or WM message that can be captured that is triggered when a form moves from one monitor to another? Without DPI scaling being implemented I mean.

A manifest is as flexible as you want, you can put in it only the information you need (like the DPI stuff in this case). As for the form moving to another monitor with the same DPI there's a lot of math involved in determining where the Left/Top coordinates reside in the global desktop space, especially in a multi-monitor setup. There are edge cases to look out for as well, like a form being partially between monitors, it's up to you to fine tune the algorithm.

Is there a way to adapt the program directly when it starts without a manifest? Automatically disable dpi scaling.

VB. Net, you can do it by adding a few lines of code before creating the form control.

Quote:

---

Originally Posted by VanGoghGaming

As for the form moving to another monitor with the same DPI there's a lot of math involved in determining where the Left/Top coordinates reside in the global desktop space, especially in a multi-monitor setup. There are edge cases to look out for as well, like a form being partially between monitors, it's up to you to fine tune the algorithm.

---

That's why I didn't do it. Looking for an easy method.

Quote:

---

Originally Posted by xiaoyao

Automatically disable dpi scaling

---

Automatically disable dpi scaling for the app or disabling the desktop scaling?

Assuming the former then it won't have DPI scaling without the manifest. You can try to use the DPI_AWARE API to toggle it on/off but you will need to do a HARD restart of the program.