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