在特定 Windows 显示比例下调整大小时，InkPicture 呈现不正确

Question

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

我还需要手动调整墨迹的大小，因为它不会随墨迹图片缩放。这也应该很容易用InkPicture1.Renderer.ScaleTransform实现，而且它运行得很好 - 大多数时候！

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

不同 Windows 显示秤的行为变化很奇怪，我已经寻找驱动程序更新和性能瓶颈。

我不确定显示比例是否仅适用于触摸屏。

在我的两台计算机上都有相同的问题： - Microsoft Surface Pro 6 (i5)， Windows 10， Office 365 - Excel 32位 - 联想瑜伽(i7)，视窗10，办公室365 - Excel 64位。 两者都是触摸屏，使用板载英特尔显卡。在外部显示器上运行不会有任何变化。

我调查过： - Windows，Office和所有驱动程序应该是最新的 - 禁用硬件加速(不适用于我的计算机) - 替代代码：改用 inkpicture.resize 事件 - 替代代码：缩放一次转换一个方向

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

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

Public Sub OpenUserForm1()
UserForm1.Show
End Sub

粘贴到用户表单 1 代码中：

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

要获取通缉/预期行为，请执行以下操作： - 将图形显示比例设置为100%(然后注销/登录) - 打开Excel工作簿/打开用户表单 - 在用户窗体上绘制墨水 - 调整用户表单的大小将是完全流畅和无缝的 - 完美！

要获得奇怪的行为： - 将图形显示比例设置为200%(然后注销/登录) - 打开Excel工作簿/打开用户表单 - 在用户窗体上绘制墨水 - 调整用户表单的大小时，绘制的墨水不再遵循。它要么只在一个方向上缩放，要么在未缩放的方向上缩放。

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

多谢。

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

希望这对某人有用。这当然是给我的：-)

/干杯