在UWP應用程序中將XAML轉換爲PDF

Question

我在我用作UWP應用程序中的打印根的XAML頁面上有一個Canvas元素。我正在使用PrintManager.PrintTaskRequested和PrintDocument.Paginate等事件來準備我的報告並將其發送到打印機。

我需要以編程方式將報告導出爲PDF文件。理想的解決方案會以某種方式利用現有的打印根（Canvas），打印到它，然後將結果轉換爲PDF。之後，我可以將PDF保存到文件或附加到電子郵件。

我一直在尋找合適的解決方案一段時間，但在UWP中沒有任何工作。例如，這篇文章提供了一個完美的解決方案似乎並不在UWP工作：

How to programmatically print to PDF file without prompting for filename in C# using the Microsoft Print To PDF printer that comes with Windows 10

我希望得到任何幫助。

Answer 1

我在這個問題上苦苦掙扎了很長一段時間 - 在UWP中自動執行XAML進行PDF轉換 - 最後找到了一個出色的解決方案。

在UWP中有幾個以編程方式創建PDF的庫。訣竅是XAML轉換。我採取了以下方法：

A）遍歷XAML樹並生成要轉換的控件列表。在我的情況下，文本塊和邊框，但這可以擴大。 B）聲明與您的XAML實際大小相匹配的PDF頁面大小。

C）通過列表，得到控制座標。使用C1PDF中的相應功能在PDF中創建相同的元素。該代碼還檢查任何RotateTransforms，並將旋轉角度應用於文本。

使用此解決方案，我能夠將XAML用戶界面（本身表示爲打印文檔）與PDF完全相似，完全可擴展且具有完美的打印效果。

下面是一些代碼，讓你對你的方式，使用ComponentOne的PDF控件，我寫我的XAML控制轉換爲PDF：

Async Function XAMLtoPDF(myXAMLcontrol As Control) As Task(Of Boolean) 
    Dim pdf As C1PdfDocument 
    pdf = New C1PdfDocument(PaperKind.Letter) 
    Dim lTB As New List(Of Object) 

    pdf.PageSize = New Size(myXAMLcontrol.ActualWidth, myXAMLcontrol.ActualHeight) 

    FindTextBlocks(myXAMLcontrol, lTB) 
    For x = 0 To lTB.Count - 1 
     If TypeOf lTB(x) Is TextBlock Then 
      Dim TB As TextBlock = lTB(x) 
      Dim obj As FrameworkElement = TB 
      Dim angle As Double = 0 
      Do While obj IsNot Nothing 
       Dim renderxform As Transform = obj.RenderTransform 
       If TypeOf renderxform Is TransformGroup Then 
        Dim tg As TransformGroup = CType(renderxform, TransformGroup) 
        For Each t As Transform In tg.Children 
         If TypeOf t Is RotateTransform Then 
          angle -= CType(t, RotateTransform).Angle 
         End If 
        Next 
       ElseIf TypeOf renderxform Is RotateTransform Then 
        angle -= CType(renderxform, RotateTransform).Angle 
       End If 
       obj = obj.Parent 
      Loop 

      Dim myfont As Font 
      Select Case TB.FontStyle 
       Case FontStyle.Normal 
        If TB.FontWeight.Weight = FontWeights.Bold.Weight Then 
         myfont = New Font(TB.FontFamily.Source, TB.FontSize, PdfFontStyle.Bold) 
        Else 
         myfont = New Font(TB.FontFamily.Source, TB.FontSize, PdfFontStyle.Regular) 
        End If 
       Case Else 'FontStyle.Oblique, FontStyle.Italic    ' 
        myfont = New Font(TB.FontFamily.Source, TB.FontSize, PdfFontStyle.Italic) 
      End Select 

      Dim ttv As GeneralTransform = TB.TransformToVisual(myXAMLcontrol) 
      Dim ScreenCoords As Point = ttv.TransformPoint(New Point(0, 0)) 
      Dim myWidth As Double, myHeight As Double 
      If TB.TextWrapping = TextWrapping.NoWrap Then 
       myWidth = pdf.MeasureString(TB.Text, myfont).Width 
       myHeight = pdf.MeasureString(TB.Text, myfont).Height 
      Else 
       myWidth = TB.ActualWidth + 10  'Admittedly, 10 is a kluge factor to make wrapping match' 
       myHeight = pdf.MeasureString(TB.Text, myfont, myWidth).Height 
      End If 
      Dim rc As New Rect(ScreenCoords.X, ScreenCoords.Y, myWidth, myHeight) 

      If angle Then 
       Dim fmt As New StringFormat() 
       fmt.Angle = angle 
       pdf.DrawString(TB.Text, myfont, CType(TB.Foreground, SolidColorBrush).Color, rc, fmt) 
      Else 
       pdf.DrawString(TB.Text, myfont, CType(TB.Foreground, SolidColorBrush).Color, rc) 
      End If 
     ElseIf TypeOf lTB(x) Is Border Then 
      Dim BDR As Border = lTB(x) 
      Dim ttv As GeneralTransform = BDR.TransformToVisual(myXAMLcontrol) 
      Dim ScreenCoords As Point = ttv.TransformPoint(New Point(0, 0)) 
      Dim pts() As Point = { 
       New Point(ScreenCoords.X, ScreenCoords.Y), 
       New Point(ScreenCoords.X + BDR.ActualWidth, ScreenCoords.Y), 
       New Point(ScreenCoords.X + BDR.ActualWidth, ScreenCoords.Y + BDR.ActualHeight), 
       New Point(ScreenCoords.X, ScreenCoords.Y + BDR.ActualHeight)} 

      Dim Clr As Color = CType(BDR.BorderBrush, SolidColorBrush).Color 
      If BDR.BorderThickness.Top Then pdf.DrawLine(New Pen(Clr, BDR.BorderThickness.Top), pts(0), pts(1)) 
      If BDR.BorderThickness.Right Then pdf.DrawLine(New Pen(Clr, BDR.BorderThickness.Right), pts(1), pts(2)) 
      If BDR.BorderThickness.Bottom Then pdf.DrawLine(New Pen(Clr, BDR.BorderThickness.Bottom), pts(2), pts(3)) 
      If BDR.BorderThickness.Left Then pdf.DrawLine(New Pen(Clr, BDR.BorderThickness.Left), pts(3), pts(0)) 
     ElseIf TypeOf lTB(x) Is Rectangle Then 
      Dim Rect As Rectangle = lTB(x) 
      Dim ttv As GeneralTransform = Rect.TransformToVisual(myXAMLcontrol) 
      Dim ScreenCoords As Point = ttv.TransformPoint(New Point(0, 0)) 
      Dim pts() As Point = { 
       New Point(ScreenCoords.X + Rect.Margin.Left, ScreenCoords.Y + Rect.Margin.Top), 
       New Point(ScreenCoords.X + Rect.ActualWidth - Rect.Margin.Right, ScreenCoords.Y + Rect.Margin.Top), 
       New Point(ScreenCoords.X + Rect.ActualWidth - Rect.Margin.Right, ScreenCoords.Y + Rect.ActualHeight - Rect.Margin.Bottom), 
       New Point(ScreenCoords.X + Rect.Margin.Left, ScreenCoords.Y + Rect.ActualHeight - Rect.Margin.Bottom)} 

      Dim MyPen1 As New Pen(CType(Rect.Stroke, SolidColorBrush).Color, Rect.StrokeThickness) 
      MyPen1.DashStyle = DashStyle.Custom 
      MyPen1.DashPattern = Rect.StrokeDashArray.ToArray 
      Dim MyPen2 As New Pen(CType(Rect.Stroke, SolidColorBrush).Color, Rect.StrokeThickness) 
      MyPen2.DashStyle = DashStyle.Custom 
      MyPen2.DashPattern = Rect.StrokeDashArray.ToArray 

      pdf.DrawLine(MyPen2, pts(0), pts(1)) 
      pdf.DrawLine(MyPen1, pts(1), pts(2)) 
      pdf.DrawLine(MyPen2, pts(2), pts(3)) 
      pdf.DrawLine(MyPen1, pts(3), pts(0)) 
     End If 
    Next 
    Dim file As StorageFile = Await ThisApp.AppStorageFolder.CreateFileAsync("Temp.PDF", Windows.Storage.CreationCollisionOption.ReplaceExisting) 
    Await pdf.SaveAsync(file) 
    Return True 
End Function 

Private Sub FindTextBlocks(uiElement As Object, foundOnes As IList(Of Object)) 
    If TypeOf uiElement Is TextBlock Then 
     Dim uiElementAsTextBlock = DirectCast(uiElement, TextBlock) 
     If uiElementAsTextBlock.Visibility = Visibility.Visible Then 
      foundOnes.Add(uiElementAsTextBlock) 
     End If 
    ElseIf TypeOf uiElement Is Panel Then 
     Dim uiElementAsCollection = DirectCast(uiElement, Panel) 
     If uiElementAsCollection.Visibility = Visibility.Visible Then 
      For Each element In uiElementAsCollection.Children 
       FindTextBlocks(element, foundOnes) 
      Next 
     End If 
    ElseIf TypeOf uiElement Is UserControl Then 
     Dim uiElementAsUserControl = DirectCast(uiElement, UserControl) 
     If uiElementAsUserControl.Visibility = Visibility.Visible Then 
      FindTextBlocks(uiElementAsUserControl.Content, foundOnes) 
     End If 
    ElseIf TypeOf uiElement Is ContentControl Then 
     Dim uiElementAsContentControl = DirectCast(uiElement, ContentControl) 
     If uiElementAsContentControl.Visibility = Visibility.Visible Then 
      FindTextBlocks(uiElementAsContentControl.Content, foundOnes) 
     End If 
    ElseIf TypeOf uiElement Is Border Then 
     Dim uiElementAsBorder = DirectCast(uiElement, Border) 
     If uiElementAsBorder.Visibility = Visibility.Visible Then 
      foundOnes.Add(uiElementAsBorder) 
      FindTextBlocks(uiElementAsBorder.Child, foundOnes) 
     End If 
    ElseIf TypeOf uiElement Is Rectangle Then 
     Dim uiElementAsRectangle = DirectCast(uiElement, Rectangle) 
     foundOnes.Add(uiElementAsRectangle) 
    End If 
End Sub 

實際結果：