将插入的 EMF 文件解组到 Powerpoint 时出现失真

Posted 2023-03-29

【中文标题】将插入的 EMF 文件解组到 Powerpoint 时出现失真

【英文标题】：Distortion when ungrouping inserted EMF file into Powerpoint

【发布时间】：2021-02-21 13:19:37

【问题描述】：

背景：我是IguanaTex 的开发人员，这是一个在 Powerpoint 中包含 LaTeX 显示的 Powerpoint 插件。 IguanaTex 可以通过将 EMF 文件插入幻灯片、取消分组并进行一些清理（删除多余的形状、进一步取消分组、删除线条......）来生成矢量图形显示（Powerpoint Shapes，通常是 Freeforms）。这些 EMF 文件通常使用外部引擎 (Tex2img) 从 LaTeX 或用户想要转换为可编辑形状的 PDF 文件生成（与 LaTeX 并不真正相关，但整个代码库都可以提供）功能，所以我把它放进去）。

问题：我最近注意到以编程方式对 EMF 文件取消分组时出现零星问题，而通过 GUI 取消对同一文件的分组不会导致错误。我已确认这发生在运行 Office 2010、Office 2016 或 Office 365 的两台 Windows 10 计算机上。

假设我们在 Powerpoint 中插入this EMF file 并获得以下图片对象：

使用IguanaTex's VBA code 插入同一个文件会导致以下失真输出，其中“a”和“s”字母被垂直拉长：

VBA 代码本质上：

Adds the EMF file as a shape 使用 Shapes.AddPicture 方法 Ungroups the shape 使用 Shape.Ungroup 方法到 ShapeRange 中（相当于在 GUI 中取消组合插入的 EMF 文件） Cleans up 再取消组合，删除多余的形状（在我们的例子中是 1 个 Autoshape 和 1 个 Rectangle），选择顶部的组（或 Freeform，如果只有一个），删除剩余的 Rectangle，并设置每个形状的轮廓不可见。

在调试模式下运行代码，我可以查明在第一个 Shape.Ungroup 步骤中发生的失真，这在理论上应该再次等同于在 GUI 中执行 Shift+Ctrl+G（并按 GUI 要求按是用于取消组合 EMF 文件时的确认）。请注意，当我跨过 Ungrouping 线时，仍然会发生失真。

这个错误特别令人沮丧的是，如果我在宏中放置与处理上述步骤 2 和 3 完全相同的 VBA 代码（除了插入文件之外的所有内容），然后在文件之后停止加载项代码在步骤 1 中插入并使用宏运行其余部分，通常不会导致任何失真。我说通常是因为这个错误不是 100% 可重现的：它有时会发生，有时不会。我发现重现它的最可靠方法是插入上面链接的 EMF 文件。

因此，代码本身似乎没有特别的问题，但 Powerpoint 运行它的方式。会不会有一些比赛条件？请注意，我还注意到 IguanaTex 在对形状进行分组/取消分组时有时会在随机位置引发错误，并且重新运行通常可以解决问题，这也可能指向某些竞争条件。然而，这似乎不太可能，因为在调试模式下单步执行代码时仍然会出现失真问题。

因此，我的问题是：有没有人知道发生了什么，我该如何解决这个问题？

下面是前面提到的宏：

Public Sub Emftoshape()
    Dim ConvertLines As Boolean
    ConvertLines = False
    Dim Sel As Selection
    Set Sel = Application.ActiveWindow.Selection
    ' Get current slide, it will be used to group ranges
    Dim sld As Slide
    Dim SlideIndex As Long
    SlideIndex = ActiveWindow.View.Slide.SlideIndex
    Set sld = ActivePresentation.Slides(SlideIndex)

    Dim shp As Shape
    Set shp = Sel.ShapeRange(1)
    ' Convert EMF image to object
    Dim Shr As ShapeRange
    Set Shr = shp.Ungroup
    Set Shr = Shr.Ungroup
    ' Clean up
    Shr.Item(1).Delete
    Shr.Item(2).Delete
    Dim newShape As Shape
    If Shr(3).GroupItems.count > 2 Then
        Set newShape = Shr(3)
    Else ' only a single freeform, so not a group
        Set newShape = Shr(3).GroupItems(2)
    End If
    Shr(3).GroupItems(1).Delete

    If newShape.Type = msoGroup Then
    
        Dim arr_group() As Variant
        arr_group = GetAllShapesInGroup(newShape)
        Call FullyUngroupShape(newShape)
        Set newShape = sld.Shapes.Range(arr_group).Group
        
        Dim emf_arr() As Variant ' gather all shapes to be regrouped later on
        j_emf = 0
        Dim delete_arr() As Variant ' gather all shapes to be deleted later on
        j_delete = 0
        Dim s As Shape
        For Each s In newShape.GroupItems
            j_emf = j_emf + 1
            ReDim Preserve emf_arr(1 To j_emf)
            If s.Type = msoLine Then
                If ConvertLines And (s.Height > 0 Or s.Width > 0) Then
                    emf_arr(j_emf) = LineToFreeform(s).name
                    j_delete = j_delete + 1
                    ReDim Preserve delete_arr(1 To j_delete)
                    delete_arr(j_delete) = s.name
                Else
                    emf_arr(j_emf) = s.name
                End If
            Else
                emf_arr(j_emf) = s.name
                If s.Fill.Visible = msoTrue Then
                s.Line.Visible = msoFalse
                Else
                s.Line.Visible = msoTrue
                
                End If
            End If
        Next
        newShape.Ungroup
        If j_delete > 0 Then
            sld.Shapes.Range(delete_arr).Delete
        End If
        Set newShape = sld.Shapes.Range(emf_arr).Group
    
    Else
        If newShape.Type = msoLine Then
            newShapeName = LineToFreeform(newShape).name
            newShape.Delete
            Set newShape = sld.Shapes(newShapeName)
        Else
            newShape.Line.Visible = msoFalse
        End If
    End If
    newShape.LockAspectRatio = msoTrue
End Sub

Private Sub FullyUngroupShape(newShape As Shape)
    Dim Shr As ShapeRange
    Dim s As Shape
    If newShape.Type = msoGroup Then
        Set Shr = newShape.Ungroup
        For i = 1 To Shr.count
            Set s = Shr.Item(i)
            If s.Type = msoGroup Then
                Call FullyUngroupShape(s)
            End If
        Next
    End If
End Sub

Private Function GetAllShapesInGroup(newShape As Shape) As Variant
    Dim arr() As Variant
    Dim j As Long
    Dim s As Shape
    For Each s In newShape.GroupItems
            j = j + 1
            ReDim Preserve arr(1 To j)
            arr(j) = s.name
    Next
    GetAllShapesInGroup = arr
End Function

Private Function LineToFreeform(s As Shape) As Shape
    t = s.Line.Weight
    Dim ApplyTransform As Boolean
    ApplyTransform = True
    
    Dim bHflip As Boolean
    Dim bVflip As Boolean
    Dim nBegin As Long
    Dim nEnd As Long
    Dim aC(1 To 4, 1 To 2) As Double
    
    With s
        aC(1, 1) = .Left:           aC(1, 2) = .Top
        aC(2, 1) = .Left + .Width:  aC(2, 2) = .Top
        aC(3, 1) = .Left:           aC(3, 2) = .Top + .Height
        aC(4, 1) = .Left + .Width:  aC(4, 2) = .Top + .Height
    
        bHflip = .HorizontalFlip
        bVflip = .VerticalFlip
    End With
    
    If bHflip = bVflip Then
        If bVflip = False Then
            ' down to right -- South-East
            nBegin = 1: nEnd = 4
        Else
            ' up to left -- North-West
            nBegin = 4: nEnd = 1
        End If
    ElseIf bHflip = False Then
        ' up to right -- North-East
        nBegin = 3: nEnd = 2
    Else
        ' down to left -- South-West
        nBegin = 2: nEnd = 3
    End If
    xs = aC(nBegin, 1)
    ys = aC(nBegin, 2)
    xe = aC(nEnd, 1)
    ye = aC(nEnd, 2)
    
    ' Get unit vector in orthogonal direction
    xd = xe - xs
    yd = ye - ys
    
    s_length = Sqr(xd * xd + yd * yd)
    If s_length > 0 Then
    n_x = -yd / s_length
    n_y = xd / s_length
    Else
    n_x = 0
    n_y = 0
    End If
    
    x1 = xs + n_x * t / 2
    y1 = ys + n_y * t / 2
    x2 = xe + n_x * t / 2
    y2 = ye + n_y * t / 2
    x3 = xe - n_x * t / 2
    y3 = ye - n_y * t / 2
    x4 = xs - n_x * t / 2
    y4 = ys - n_y * t / 2
        
    'End If
    
    
    If ApplyTransform Then
        Dim builder As FreeformBuilder
        Set builder = ActiveWindow.Selection.SlideRange(1).Shapes.BuildFreeform(msoEditingCorner, x1, y1)
        builder.AddNodes msoSegmentLine, msoEditingAuto, x2, y2
        builder.AddNodes msoSegmentLine, msoEditingAuto, x3, y3
        builder.AddNodes msoSegmentLine, msoEditingAuto, x4, y4
        builder.AddNodes msoSegmentLine, msoEditingAuto, x1, y1
        Dim oSh As Shape
        Set oSh = builder.ConvertToShape
        oSh.Fill.ForeColor = s.Line.ForeColor
        oSh.Fill.Visible = msoTrue
        oSh.Line.Visible = msoFalse
        oSh.Rotation = s.Rotation
        Set LineToFreeform = oSh
    Else
        Set LineToFreeform = s
    End If
End Function

编辑： 以下是插入上面链接的 EMF 文件或其修改版本的几种方法之间的视觉比较，其中添加了颜色以进行说明：

EMF 文件cleaned by John Korchok 删除剪贴蒙版和矩形，并与 GUI 取消组合。除了扭曲（曲线不平滑，并且“a”和“s”比原始文件中的高）之外，使用 VBA 或 GUI 取消组合时文件的行为确实相同。不幸的是，这不是我的问题的可行解决方案。 使用 VBA 取消分组的 EMF 文件（矩形/自动形状通常被 IguanaTex 删除）。 “a”和“s”明显更高，这要归功于作为参考添加的水平线。 EMF 文件与 GUI 取消组合。这是期望的结果。 相应的 PNG 文件（通过使用 Ghostscript 从 PDF 转换获得）其纵横比已修改以匹配插入的 EMF 文件的大小。因为我更信任 PDF/PNG 输出，所以 IguanaTex 可以选择“矢量化”PNG 显示，调整未分组 EMF 的大小以匹配 PNG 的大小。

【问题讨论】：

我已经dumped the emf records 转为明文。我认为 mapMode 从 MM_ANISOTROPIC 到 MM_TEXT 的切换很奇怪，但它发生在任何渲染之前。也许您可以通过dumping 工作的.emfs 和非工作的.emfs 找到任何相关性。典型的罪魁祸首是名称中包含窗口、视口和世界的记录。大部分没有设置边界（高度/宽度 = -1）。

感谢您指出这种将 emf 转储为文本的方式，我不知道。我会尝试看看是否能找到相关性。

【参考方案1】：

当您得到可变且不可预测的结果时，很可能是源文件的某些属性导致了问题。我在 Adob​​e Illustrator 和 InkScape 中都打开了它。您的示例文件有问题：

文字很小，大约2.5点。这意味着即使是轻微的错误也会产生很大的视觉效果。 k 的顶部肯定被 EMF 的边缘剪掉了。我相信 m 可能会被剪裁在左侧，但是图像太小了，我无法放大到足以看到。由于这是调整大小的两个字母，这可能是问题的根源。 您的 EMF 还包括一个 3.91" 宽和 1.06" 高的矩形，与微小的文本相比，它是巨大的。此矩形的左上角与屏蔽文本的矩形位于同一位置。

我认为，如果您使用更多真实文件进行测试，您可能会得到更好的结果。

【讨论】：

感谢您对此进行调查。我同意该文件有问题，但如果我想将 LaTeX 编译成 EMF，这就是我要处理的问题。话虽如此，我在 Inkscape 中没有看到如此严重的问题。文件大小看起来很合理。你如何推断​​文本大小？我不确定 k 的顶部是否被剪裁，我相信它只是接触边缘，m 也是如此。调整大小的两个字母是“a”和“s”。与文本相比，我也没有看到一个巨大的矩形：我看到的是一个比文本稍大的黑色矩形，中心是空心的，并且部分隐藏了它。

在 InkScape 中，使用 Ctrl + A 查看在屏幕外向右和向下延伸的额外矩形。 k 的顶部肯定被剪裁，Illustrator 显示顶部，InkScape 没有。 InkScape 也显示了宽的黑色边框，但它没有出现在 Illustrator 中，所以我认为这可能是 InkScape 的奇怪之处。

我删除了剪贴蒙版和大矩形。试试这个。如果它按预期工作，那么这两个对象之一就是一个因素：www.brandwares.com/downloads/masks_revised.emf

有趣的是，您的 EMF 文件也有“a”/“s” 垂直略微拉长（即使只是使用 GUI 插入时），尽管不如使用 VBA 取消分组后那么多。实际上，即使在 PDF 输出中，“a”/“s”也只是一根拉长的头发，但在您的 EMF 文件中更是如此，它还有其他失真。你是对的，“k”出现了轻微的切割，但这仅仅是因为一个矩形，一旦我删除了矩形，它就没有被切割。看看 jonathanleroux.org/software/iguanatex/EMF_examples.pptx。

在排版中，顶部和/或底部边缘弯曲的字母通常比顶部和/或底部平坦的字母略高。 en.wikipedia.org/wiki/Overshoot_(typography)