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

'' このサンプルは、PDF/UA-2(アクセシビリティ対応)に準拠したドキュメントを作成する方法を示しています。
Public Class PdfUa2
    Function CreatePDF(ByVal stream As Stream) As Integer
        Dim doc = New GcPdfDocument()

        '' PDF/UA-2 はPDF 2.0に基づいています。
        doc.PdfVersion = "2.0"
        '' PDF/UAでは、文書の言語を指定する必要があります。
        doc.Lang = "ja"
        '' ドキュメントを PDF/UA-2 準拠としてマークします。
        doc.Metadata.PdfUa = 2
        '' PDF/UA-2では、(文書の日付ではなく)ISO 14289-2:2024規格そのものの「改訂」年が求められます。
        doc.Metadata.PdfUaRev = "2024"
        doc.Metadata.Title = "PDF/UA-2 準拠ドキュメント"
        doc.ViewerPreferences.DisplayDocTitle = True
        '' ドキュメントをタグ付きPDFの規則に準拠しているものとしてマークします(PDF/UAで必須)。
        doc.MarkInfo.Marked = True

        Dim fnt = GCTEXT.Font.FromFile(Path.Combine("Resources", "Fonts", "ipag.ttc"))

        '' PDF/UA-2 では、構造ツリーで使用する名前空間を宣言することが求められます。
        '' 標準の PDF 2.0 構造名前空間を追加します。
        Dim ns = New [Namespace]("http://iso.org/pdf2/ssn")
        doc.StructTreeRoot.Namespaces.Add(ns)

        '' PDF/UA-2では、構造ツリーのルートとして「Document」構造要素が必要であり、
        '' これは前述の通り名前空間に関連付けられている必要があります。
        Dim seDocument = New StructElement("Document") With {.NS = ns}
        doc.StructTreeRoot.Children.Add(seDocument)

        Const chapterCount = 3
        For i = 0 To chapterCount - 1
            Dim page = doc.Pages.Add()
            Dim g = page.Graphics
            Dim headingTop = 72.0F

            If i = 0 Then
                '' Structure Destination は PDF 2.0 で導入された非常に新しい仕組みです。
                '' このコメント執筆時点では、これらのデモで使用されている DsPdfViewer も
                '' Adobe Acrobat も Structure Destination を解決できません。
                '' そのため、以下のブックマークをクリックしても、PDF/UA-2 および
                '' PDF 2.0 の仕様に従って宛先自体は正しく生成されているにもかかわらず、
                '' 対応する見出しへ移動しない場合があります。
                ''
                '' この注記は文書本来の内容には含まれないため、すでに埋め込まれている
                '' フォントを使用して描画されます
                '' (PDF/UA-2 では、標準 14 フォントを含め、表示に使用するすべての
                '' フォントを埋め込む必要があります)。
                ''
                '' また、この注記はタグ付きコンテンツではなく、レイアウト用のアーティファクト
                '' としてマークされています
                '' (PDF/UA-2 では、すべてのコンテンツはタグ付きコンテンツであるか、
                '' またはアーティファクトである必要があります)。
                Dim tlNote = g.CreateTextLayout()
                tlNote.DefaultFormat.Font = fnt
                tlNote.DefaultFormat.FontSize = 12
                tlNote.MarginAll = 72
                tlNote.MaxWidth = page.Size.Width
                tlNote.Append(
                        "この文書のアウトライン(ブックマーク)は、PDF/UA-2 の要件に従い、各章の見出しへ直接移動するために、" +
                        "PDF 2.0 の「Structure Destination」を使用しています。 " +
                        "しかし、これらのデモで使用されている DsPdfViewer や Adobe Acrobat は、現時点ではこの新しい種類の宛先を解決できないため、" +
                        "ブックマークをクリックしても目的の見出しへ移動しない場合があります。 " +
                        "ただし、宛先自体は正しく生成されています。")
                tlNote.PerformLayout(True)

                Dim noteRect = tlNote.ContentRectangle
                noteRect.Inflate(9, 9)

                g.BeginMarkedContent(New TagArtifact With {.Type = TagArtifact.Types.TypeLayout})
                g.FillRectangle(noteRect, Color.FromArgb(213, 221, 240))
                g.DrawRectangle(noteRect, Color.FromArgb(59, 92, 170), 0.5F)
                g.DrawTextLayout(tlNote, PointF.Empty)
                g.EndMarkedContent()

                headingTop = noteRect.Bottom + 24
            End If

            '' ドキュメントルート下の最上位「H1」要素としてタグ付けされた章の見出し
            Dim seHeading = New StructElement("H1") With {.DefaultPage = page}
            seDocument.Children.Add(seHeading)

            Dim tlHeading = g.CreateTextLayout()
            tlHeading.MarginAll = 72
            tlHeading.MarginTop = headingTop
            tlHeading.MaxWidth = page.Size.Width
            tlHeading.DefaultFormat.Font = fnt
            tlHeading.DefaultFormat.FontBold = True
            tlHeading.DefaultFormat.FontSize = 20
            tlHeading.Append($"{i + 1} 章")

            g.BeginMarkedContent(New TagMcid("H1", 0))
            g.DrawTextLayout(tlHeading, PointF.Empty)
            g.EndMarkedContent()
            seHeading.ContentItems.Add(New McidContentItemLink(0))

            '' 同一のドキュメントルート下で「P」要素としてタグ付けされた章の本文
            Dim seParagraph = New StructElement("P") With {.DefaultPage = page}
            seDocument.Children.Add(seParagraph)

            Dim tlBody = g.CreateTextLayout()
            tlBody.MarginAll = 72
            tlBody.MarginTop = tlHeading.ContentRectangle.Bottom + 24
            tlBody.MaxWidth = page.Size.Width
            tlBody.DefaultFormat.Font = fnt
            tlBody.DefaultFormat.FontSize = 12
            tlBody.Append(Util.getString_ja(0, 1, 3, 7, 11))

            g.BeginMarkedContent(New TagMcid("P", 1))
            g.DrawTextLayout(tlBody, PointF.Empty)
            g.EndMarkedContent()
            seParagraph.ContentItems.Add(New McidContentItemLink(1))

            '' PDF/UA-2 の要件に従い、この章の見出しに対するアウトライン項目
            '' (ブックマーク)を Structure Destination を使用して追加します。
            '' Structure Destination は、ページ番号や座標ではなく、見出しに対応する
            '' 構造要素を直接参照する宛先です。
            '' (PDF 2.0 仕様書 12.3.2.3「Structure Destinations」参照)
            doc.Outlines.Add(New OutlineNode($"{i + 1} 章", New DestinationFitBV(seHeading, Nothing)))
        Next

        doc.Save(stream)
        Return doc.Pages.Count
    End Function
End Class