VerticalTextJP.vb
'' 完毕:
Imports System.IO
Imports System.Drawing
Imports GrapeCity.Documents.Pdf
Imports GrapeCity.Documents.Text
Imports GrapeCity.Documents.Drawing
Imports GCTEXT = GrapeCity.Documents.Text
Imports GCDRAW = GrapeCity.Documents.Drawing

'' 使用具有水平列的布局绘制从右到左的垂直日语文本。
'' 另请参阅ArabicColumnsMultiLangVerticalText。
Public Class VerticalTextJP

    Const text = "日本語(にほんご、にっぽんご)は、主として、日本列島で使用されてきた言語である。日本手話を母語とする者などを除いて、ほぼ全ての日本在住者は日本語を第一言語とする。日本国は法令上、公用語を明記していないが、事実上の公用語となっており、学校教育の「国語」で教えられる。使用者は、日本国内を主として約\uFF11億\uFF13千万人。日本語の文法体系や音韻体系を反映する手話として日本語対応手話がある。"

    Function CreatePDF(ByVal stream As Stream) As Integer
        Using clouds As GCDRAW.Image = GCDRAW.Image.FromFile(Path.Combine("Resources", "Images", "clouds.jpg")),
            firth As GCDRAW.Image = GCDRAW.Image.FromFile(Path.Combine("Resources", "Images", "firth.jpg")),
            lavender As GCDRAW.Image = GCDRAW.Image.FromFile(Path.Combine("Resources", "Images", "lavender.jpg"))
            Dim yumin = GCTEXT.Font.FromFile(Path.Combine("Resources", "Fonts", "yumin.ttf"))
            Dim ia = New ImageAlign(ImageAlignHorz.Left, ImageAlignVert.Top, True, True, True, False, False)

            Dim doc = New GcPdfDocument()

            '' 将保存并呈现文本的 TextLayout:
            Dim tl = New TextLayout(72)
            tl.FirstLineIndent = 18
            tl.ParagraphSpacing = 6
            tl.FlowDirection = FlowDirection.VerticalRightToLeft
            tl.TextAlignment = TextAlignment.Justified
            Dim tf = New TextFormat() With {.Font = yumin, .FontSize = 12}
            '' 重复测试文本以填充几页:
            For i = 0 To 25
                tl.Append(text, tf)
                tl.AppendLine()
            Next

            '' 将文本布局为 4 个水平列:
            '' (此示例中的逻辑/代码与ArabicColumns相同):
            Const NCOLS = 4
            Dim margin = 36.0F
            Dim gap = 18.0F
            Dim page = doc.NewPage()
            page.Landscape = True
            Dim colHeight = (page.Size.Height - margin * 2 - gap * (NCOLS - 1)) / NCOLS
            tl.MaxWidth = page.Size.Width
            tl.MaxHeight = page.Size.Height
            tl.MarginLeft = margin
            tl.MarginRight = margin
            tl.MarginTop = margin
            tl.MarginBottom = margin + (colHeight + gap) * (NCOLS - 1)
            '' 我们可以指定任意矩形,让文本围绕其流动。
            '' 在本例中,我们添加 3 个区域来绘制一些图像:
            tl.ObjectRects = New List(Of ObjectRect) From {
                New ObjectRect(page.Size.Width - margin - 267, margin, 267, 200),
                New ObjectRect(margin + 100, margin + 60, 133, 100),
                New ObjectRect(margin, page.Size.Height - margin - 301, 200, 301)
            }
            '' 将对象矩形转换为图像区域,调整以提供美观的填充:
            Dim rClouds = tl.ObjectRects(0).ToRectangleF()
            rClouds.Inflate(-4, -3)
            Dim rFirth = tl.ObjectRects(1).ToRectangleF()
            rFirth.Inflate(-4, -3)
            Dim rLavender = tl.ObjectRects(2).ToRectangleF()
            rLavender.Inflate(-4, -3)
            page.Graphics.DrawImage(clouds, rClouds, Nothing, ia)
            page.Graphics.DrawImage(firth, rFirth, Nothing, ia)
            page.Graphics.DrawImage(lavender, rLavender, Nothing, ia)

            '' 调用:它计算绘制文本所需的字形,并将其布局:
            tl.PerformLayout(True)

            '' 当仍有文本要渲染时循环:
            Dim done = False
            While Not done
                For col = 1 To NCOLS
                    Dim nextcol = If(col < NCOLS, col, 0)
                    '' TextSplitOptions 告诉 TextLayout.Split() 如何布局剩余的文本。
                    '' 在本例中,我们通过更新顶部和底部边距从一列前进到另一列:
                    Dim tso = New TextSplitOptions(tl) With {
                    .RestMarginTop = margin + (colHeight + gap) * nextcol,
                    .RestMarginBottom = margin + (colHeight + gap) * (NCOLS - 1 - nextcol)
                }
                    Dim rest As TextLayout = Nothing
                    Dim split = tl.Split(tso, rest)
                    page.Graphics.DrawTextLayout(tl, PointF.Empty)
                    If split <> SplitResult.Split Then
                        done = True
                        Exit For
                    End If
                    tl = rest
                Next
                If Not done Then
                    page = doc.NewPage()
                    page.Landscape = True
                    '' 我们只想在第一页渲染图像,所以清除ObjectRect:
                    If tl.ObjectRects IsNot Nothing Then
                        tl.ObjectRects = Nothing
                        '' 我们需要重做布局,但不需要重新计算字形:
                        tl.PerformLayout(False)
                    End If
                End If
            End While
            ''
            '' 完毕:
            doc.Save(stream)
            Return doc.Pages.Count
        End Using
    End Function
End Class