ListFonts.vb
'' 完毕:
Imports System.IO
Imports System.Drawing
Imports System.Collections.Generic
Imports System.Linq
Imports GrapeCity.Documents.Pdf
Imports GrapeCity.Documents.Text

'' 此示例列出了在加载的 PDF 中找到的所有字体,
'' 打印每种字体的一些信息,并指示 Font 对象是否
'' 可以从 PDF 中的字体创建。
Public Class ListFonts
    Function CreatePDF(ByVal stream As Stream) As Integer
        Dim sourcePDF = "CompleteJavaScriptBook.pdf"

        Dim doc = New GcPdfDocument()
        Dim page = doc.NewPage()

        Dim rc = Util.AddNote(
            "此示例将任意 PDF 加载到临时 GcPdfDocument 中," +
            "",
            page)

        '' 渲染文本的文本布局:
        Dim tab = 24
        Dim tl = page.Graphics.CreateTextLayout()
        tl.DefaultFormat.Font = StandardFonts.Times
        tl.DefaultFormat.FontSize = 12
        tl.MaxWidth = doc.PageSize.Width
        tl.MaxHeight = doc.PageSize.Height
        tl.MarginAll = rc.Left
        tl.MarginTop = rc.Bottom + 36
        tl.TabStops = New List(Of TabStop)() From {New TabStop(tab)}
        tl.FirstLineIndent = -tab
        tl.MarginRight = 144

        '' 寡妇/孤儿控制的文本分割选项:
        Dim tso = New TextSplitOptions(tl) With
        {
            .KeepParagraphLinesTogether = True,
            .MinLinesInFirstParagraph = 2,
            .MinLinesInLastParagraph = 2,
            .RestMarginTop = rc.Left
        }

        '' 打开任意 PDF,将其加载到临时文档中并获取所有字体:
        Using fs = New FileStream(Path.Combine("Resources", "PDFs", sourcePDF), FileMode.Open, FileAccess.Read)
            Dim doc1 = New GcPdfDocument()
            doc1.Load(fs)
            Dim fonts = doc1.GetFonts()
            tl.AppendLine($"Total of {fonts.Count} fonts found in {sourcePDF}:")
            tl.AppendLine()
            Dim i As Integer = 0
            For Each fnt In fonts
                Dim nativeFont = fnt.CreateNativeFont()
                tl.Append($"{i}:{vbTab}BaseFont: {fnt.BaseFont} IsEmbedded: {fnt.IsEmbedded}.")
                tl.AppendParagraphBreak()
                If nativeFont IsNot Nothing Then
                    tl.AppendLine($"{vbTab}CreateNativeFont succeeded, family: {nativeFont.FontFamilyName} bold: {nativeFont.FontBold} italic: {nativeFont.FontItalic}.")
                Else
                    tl.AppendLine($"{vbTab}CreateNativeFont failed")
                End If
                tl.AppendLine()
                i += 1
            Next
            tl.PerformLayout(True)
            While (True)
                '' 'rest' 将接受不适合的文本:
                Dim rest As TextLayout = Nothing
                Dim splitResult = tl.Split(tso, rest)
                doc.Pages.Last.Graphics.DrawTextLayout(tl, PointF.Empty)
                If splitResult <> SplitResult.Split Then
                    Exit While
                End If
                tl = rest
                doc.NewPage()
            End While
        End Using
        '' 完毕:
        doc.Save(stream)
        Return doc.Pages.Count
    End Function
End Class