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
'' 使用具有水平列的布局绘制从右到左的垂直日语文本。
'' 另请参阅ArabicColumns、MultiLang 和VerticalText。
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