在特定 Windows 显示比例调整大小时，InkPicture 渲染不正确

Question

我使用 Excel/VBA 创建了一个仅包含 InkPicture 控件的 Excel 用户窗体。我已经设法加载图片（拉伸模式），使表单可调整大小（API 调用），在调整大小时调整 inkpicture 的大小。这一切都运行良好。

我还需要手动调整 Ink 的大小，因为它不随 InkPicture 缩放。这也应该很容易用 InkPicture1.Renderer.ScaleTransform 实现，并且它工作得很好 - 大多数时候！

问题：调整用户窗体大小时，ScaleTransform 函数将停止在水平或垂直方向上缩放 - 但仅在特定 Windows 显示比例：125%、175%、200% 和 225% - 而缩放100%、150% 和 250% 效果完美。

不同 Windows 显示比例的行为变化很奇怪，我一直在寻找驱动程序更新和性能瓶颈。

我不确定 Display Scale 是否仅适用于触摸屏。

我的两台电脑都有同样的问题： - Microsoft Surface Pro 6 (i5)，Windows 10，Office 365 - Excel 32 位 - 联想 Yoga (i7)，Windows 10，Office 365 - Excel 64 位。两者都是触摸屏，使用板载英特尔显卡。运行在外接显示器上没有任何变化。

我调查过： - Windows，Office 和所有驱动程序应该是最新的 - 禁用硬件加速（不适用于我的电脑） - 替代代码：改用 inkpicture.resize 事件 - 替代代码：ScaleTransforming 一次一个方向

要重现错误，您需要... - 创建启用宏的工作簿 - 创建用户窗体 (UserForm1) - 将 InkPicture ActiveX 控件添加到项目中 - 插入 InkPicture 控件 (InkPicture1) - 将下面的 VBA 代码复制到项目中

粘贴到模块中并运行作为宏：

Public Sub OpenUserForm1()
    UserForm1.Show
End Sub

粘贴到 userform1 代码中：

Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long

Dim widthBefore As Double
Dim heightBefore As Double

Private Sub UserForm_Initialize()
    Me.InkPicture1.Top = 0
    Me.InkPicture1.Left = 0

    widthBefore = Me.InkPicture1.Width
    heightBefore = Me.InkPicture1.Height

    Call DrawForm
End Sub

Private Sub UserForm_Activate()
    Call MakeFormMaximizable
End Sub

Private Sub UserForm_Resize()
    Call DrawForm
End Sub

Private Sub DrawForm()
    If Me.InsideHeight = 0 Or Me.InsideWidth = 0 Then Exit Sub

    Me.InkPicture1.Width = Me.InsideWidth
    Me.InkPicture1.Height = Me.InsideHeight

    Dim hMultiplier As Single, vMultiplier As Single

    hMultiplier = Me.InkPicture1.Width / widthBefore
    vMultiplier = Me.InkPicture1.Height / heightBefore

    ' This function messes up!
    Me.InkPicture1.Renderer.ScaleTransform hMultiplier, vMultiplier

    widthBefore = Me.InkPicture1.Width
    heightBefore = Me.InkPicture1.Height
End Sub

Private Sub MakeFormMaximizable()
    Dim BitMask As LongPtr
    Dim Window_Handle As LongPtr
    Dim WindowStyle As LongPtr
    Dim Ret As LongPtr

    Const GWL_STYLE As Long = -16
    Const WS_THICKFRAME As Long = &H40000

    Const MAX_BOX As Long = &H10000
    Box_Type = MAX_BOX

    Window_Handle = GetForegroundWindow()
    WindowStyle = GetWindowLongPtr(Window_Handle, GWL_STYLE)

    BitMask = WindowStyle Or Box_Type Or WS_THICKFRAME

    Ret = SetWindowLongPtr(Window_Handle, GWL_STYLE, BitMask)
    Ret = DrawMenuBar(Window_Handle)
End Sub

要获得 Wanted/Expected 行为： - 将图形显示比例设置为 100%（后跟 logout/login） - 打开 Excel 工作簿/打开用户表单 - 在用户窗体上绘制墨迹 - 调整用户表单的大小将是完全流畅和无缝的 - 完美！

要获得奇怪的行为： - 将图形显示比例设置为 200%（后跟 logout/login） - 打开 Excel 工作簿/打开用户表单 - 在用户窗体上绘制墨迹 - 调整用户窗体大小时，绘制的墨迹不再跟随。它要么只在一个方向上缩放，要么在一个没有被缩放的方向上缩放。

我希望有人可以重现相同的 error/behavior，有类似的经验，有想法或理想的修复方法。

非常感谢。

Answer 1

我找到了解决方法。您需要忽略 InkPicture 控件对其渲染变换矩阵所做的计算，而是手动使用 Inkpicture.SetViewTransform 和 InkTransform.SetTranform 函数。代码非常清晰，现在它将使您的 UserForm、InkPicture 和 Ink 调整大小在所有显示设置（无论如何都经过测试）中协调和平滑。

但是，显示设置中的比例因子将不一致 - 您需要校准坐标系！我通过使用函数 Inkpicture.GetViewTransform 创建一个初始比例因子来完成此操作。这需要从 Form_Init 调用，我已将代码包装在下面代码中的函数 GetInitScale 中。

这里是除UserForm1.show之外的完整修改代码：

Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long

Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "Gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Const HWND_DESKTOP As Long = 0
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90
Const TWIPSPERINCH = 1440

Dim widthBefore As Double, heightBefore As Double
Dim xInitScale As Double, yInitScale As Double

Private Sub UserForm_Initialize()
    widthBefore = Me.InkPicture1.Width
    heightBefore = Me.InkPicture1.Height

    Me.InkPicture1.Top = 0
    Me.InkPicture1.Left = 0

    Call GetInitScale

    Call DrawForm
End Sub

Private Sub UserForm_Activate()
    Call MakeFormMaximizable
End Sub

Private Sub UserForm_Resize()
    Call DrawForm
End Sub

Private Sub DrawForm()
    Me.InkPicture1.Width = Me.InsideWidth
    Me.InkPicture1.Height = Me.InsideHeight

    Call ScaleInk
End Sub

Private Sub GetInitScale()
    Dim aTransform As New InkTransform
    Dim eM11 As Single, eM12 As Single, eM21 As Single, eM22 As Single, eDx As Single, eDy As Single

    ' Remember initial transform to ensure robustness for diffrent display settings
    Me.InkPicture1.Renderer.GetViewTransform aTransform
    aTransform.GetTransform eM11, eM12, eM21, eM22, eDx, eDy

    xInitScale = eM11
    yInitScale = eM22
End Sub

Private Sub ScaleInk()
    Dim aTransform As New InkTransform
    Dim eM11 As Single, eM22 As Single

    ' Set transformation matrix manually
    eM11 = xInitScale * Me.InkPicture1.Width / widthBefore
    eM22 = yInitScale * Me.InkPicture1.Height / heightBefore

    ' Set new Transform
    aTransform.SetTransform eM11, 0, 0, eM22, 0, 0
    Me.InkPicture1.Renderer.SetViewTransform aTransform
End Sub

Private Sub MakeFormMaximizable()
    Dim BitMask As LongPtr
    Dim Window_Handle As LongPtr
    Dim WindowStyle As LongPtr
    Dim Ret As LongPtr

    Const GWL_STYLE As Long = -16
    Const WS_THICKFRAME As Long = &H40000

    Const MAX_BOX As Long = &H10000
    Box_Type = MAX_BOX

    Window_Handle = GetForegroundWindow()
    WindowStyle = GetWindowLongPtr(Window_Handle, GWL_STYLE)

    BitMask = WindowStyle Or Box_Type Or WS_THICKFRAME

    Ret = SetWindowLongPtr(Window_Handle, GWL_STYLE, BitMask)
    Ret = DrawMenuBar(Window_Handle)
End Sub

希望这对某人有用。对我来说当然是:-)

/干杯

在特定 Windows 显示比例调整大小时，InkPicture 渲染不正确

InkPicture renders incorrectly when resized at specific Windows Display Scales

excel

vba

resize

userform

scaletransform