ListFonts.vb
'' 
'' このコードは、DioDocs for PDF のサンプルの一部として提供されています。
'' © MESCIUS inc. All rights reserved.
'' 
Imports System.IO
Imports System.Drawing
Imports System.Collections.Generic
Imports System.Linq
Imports GrapeCity.Documents.Pdf
Imports GrapeCity.Documents.Text

'' このサンプルは、読み込まれた PDF で見つかったすべてのフォントを一覧表示し、
'' 各フォントの情報をいくつか印刷して、
'' PDF のフォントから Font オブジェクトを作成できるかどうかを示します。
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 に読み込み、その文書で" +
            "見つかったすべてのフォントをそれらのいくつかのプロパティとともに一覧表示" +
            "します。また、それらの各 PDF フォントから Font オブジェクトの作成を試み、" +
            "この操作が成功したかどうかを報告します。",
            page)

        '' テキストを描画するためのテキストレイアウト。
        Dim tab = 24
        Dim tl = page.Graphics.CreateTextLayout()
        tl.DefaultFormat.Font = Util.getFont()
        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 = 72

        '' widow/orphan 制御のテキスト分割オプション。
        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($"「{sourcePDF}」で合計 {fonts.Count} 種のフォントが使用されています。")
            tl.AppendLine()
            Dim i As Integer = 0
            For Each fnt In fonts
                Dim nativeFont = fnt.CreateNativeFont()
                tl.Append($"{i + 1}:{vbTab}BaseFont: {fnt.BaseFont} IsEmbedded: {fnt.IsEmbedded}.")
                tl.AppendParagraphBreak()
                If nativeFont IsNot Nothing Then
                    tl.AppendLine($"{vbTab}Fontオブジェクトの作成: 成功 {vbCrLf}{vbTab}フォントファミリー: {nativeFont.FontFamilyName}、太字: {nativeFont.FontBold}、斜体: {nativeFont.FontItalic}")
                Else
                    tl.AppendLine($"{vbTab}Fontオブジェクトの作成: 失敗")
                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
        '' PDF ドキュメントを保存します。
        doc.Save(stream)
        Return doc.Pages.Count
    End Function
End Class