Create Unicode text or embed composite fonts in PDF files using VB

'
' Copyright (c) 2001-2021 by PDFTron Systems Inc. All Rights Reserved.
'

Imports System
Imports System.IO
Imports System.Text
Imports pdftron
Imports pdftron.Common
Imports pdftron.Filters
Imports pdftron.SDF
Imports pdftron.PDF

' This example illustrates how to create Unicode text and how to embed composite fonts.
Module UnicodeWriteTestVB
	Dim pdfNetLoader As PDFNetLoader
	Sub New()
		pdfNetLoader = pdftron.PDFNetLoader.Instance()
	End Sub

	' Note: This demo assumes that 'arialuni.ttf' is present in '/Samples/TestFiles' 
	' directory. Arial Unicode MS is about 24MB in size and it comes together with Windows and 
	' MS Office.
	' 
	' For more information about Arial Unicode MS, please consult the following Microsoft Knowledge 
	' Base Article: WD2002: General Information About the Arial Unicode MS Font
	'  http://support.microsoft.com/support/kb/articles/q287/2/47.asp
	'
	' For more information consult: 
	'    http://office.microsoft.com/search/results.aspx?Scope=DC&Query=font&CTT=6&Origin=EC010331121033
	'    http://www.microsoft.com/downloads/details.aspx?FamilyID=1F0303AE-F055-41DA-A086-A65F22CB5593
	' 
	' In case you don't have access to Arial Unicode MS you can use cyberbit.ttf 
	' (ftp://ftp.netscape.com/pub/communicator/extras/fonts/windows/) instead.
	'
	Sub Main()

		PDFNet.Initialize(PDFTronLicense.Key)

		' Relative path to the folder containing test files.
		Dim input_path As String = "../../../../TestFiles/"
		Dim output_path As String = "../../../../TestFiles/Output/"

		Try
			Using doc As PDFDoc = New PDFDoc
				Using eb As ElementBuilder = New ElementBuilder
					Using writer As ElementWriter = New ElementWriter

						' Start a new page ------------------------------------
						Dim page As Page = doc.PageCreate(New Rect(0, 0, 612, 794))

						writer.Begin(page)		  ' begin writing to this page

						Dim fnt As Font
						Try

							' Full font embedding
							Dim myfont As System.Drawing.Font = New System.Drawing.Font("Arial Unicode MS", 12)
							fnt = Font.CreateCIDTrueTypeFont(doc.GetSDFDoc(), myfont, True, True)

							' To embed the font file directly use:
							' fnt = Font.CreateCIDTrueTypeFont(doc, input_path + "arialuni.ttf", true, true)

							' Example of font substitution
							' fnt = Font.CreateCIDTrueTypeFont(doc, input_path + "arialuni.ttf", false)
						Catch e As PDFNetException
						End Try

						If fnt Is Nothing Then
							Try
								fnt = Font.CreateCIDTrueTypeFont(doc, input_path & "ARIALUNI.TTF", True, True)
							Catch e As PDFNetException
							End Try
						End If

						If fnt Is Nothing Then
							Try
								fnt = Font.CreateCIDTrueTypeFont(doc, "C:/Windows/Fonts/ARIALUNI.TTF", True, True)
							Catch e As PDFNetException
							End Try
						End If

						If fnt Is Nothing Then
							Console.WriteLine("Note: using system font substitution for unshaped unicode text")
							fnt = Font.Create(doc, "Helvetica", "")
						Else
							Console.WriteLine("Note: using Arial Unicode for unshaped unicode text")
						End If

						Dim element As Element = eb.CreateTextBegin(fnt, 1)
						element.SetTextMatrix(10, 0, 0, 10, 50, 600)
						element.GetGState().SetLeading(2)			' Set the spacing between lines
						writer.WriteElement(element)

						' Hello World!!!
						Dim hello As String = "Hello World!"
						writer.WriteElement(eb.CreateUnicodeTextRun(hello))
						writer.WriteElement(eb.CreateTextNewLine())

						' Latin
						Dim latin As Char() = { _
						 "a"c, "A"c, "b"c, "B"c, "c"c, "C"c, "d"c, "D"c, ChrW(&H45), ChrW(&H46), ChrW(&HC0), _
						 ChrW(&HC1), ChrW(&HC2), ChrW(&H143), ChrW(&H144), ChrW(&H145), ChrW(&H152), "1"c, "2"c _
						 }			 ' etc.

						writer.WriteElement(eb.CreateUnicodeTextRun(New String(latin)))
						writer.WriteElement(eb.CreateTextNewLine())

						' Greek
						Dim greek As Char() = { _
						 ChrW(&H39E), ChrW(&H39F), ChrW(&H3A0), ChrW(&H3A1), ChrW(&H3A3), ChrW(&H3A6), ChrW(&H3A8), ChrW(&H3A9) _
						 }			 ' etc.

						writer.WriteElement(eb.CreateUnicodeTextRun(New String(greek)))
						writer.WriteElement(eb.CreateTextNewLine())

						' Cyrillic
						Dim cyrillic As Char() = { _
						 ChrW(&H409), ChrW(&H40A), ChrW(&H40B), ChrW(&H40C), ChrW(&H40E), ChrW(&H40F), ChrW(&H410), ChrW(&H411), _
						 ChrW(&H412), ChrW(&H413), ChrW(&H414), ChrW(&H415), ChrW(&H416), ChrW(&H417), ChrW(&H418), ChrW(&H419) _
						 }			 ' etc.

						writer.WriteElement(eb.CreateUnicodeTextRun(New String(cyrillic)))
						writer.WriteElement(eb.CreateTextNewLine())

						' Hebrew
						Dim hebrew As Char() = { _
						 ChrW(&H5D0), ChrW(&H5D1), ChrW(&H5D3), ChrW(&H5D3), ChrW(&H5D4), ChrW(&H5D5), ChrW(&H5D6), ChrW(&H5D7), ChrW(&H5D8), _
						 ChrW(&H5D9), ChrW(&H5DA), ChrW(&H5DB), ChrW(&H5DC), ChrW(&H5DD), ChrW(&H5DE), ChrW(&H5DF), ChrW(&H5E0), ChrW(&H5E1) _
						 }			 ' etc. 

						writer.WriteElement(eb.CreateUnicodeTextRun(New String(hebrew)))
						writer.WriteElement(eb.CreateTextNewLine())

						' Arabic
						Dim arabic As Char() = { _
						 ChrW(&H624), ChrW(&H625), ChrW(&H626), ChrW(&H627), ChrW(&H628), ChrW(&H629), ChrW(&H62A), ChrW(&H62B), ChrW(&H62C), _
						 ChrW(&H62D), ChrW(&H62E), ChrW(&H62F), ChrW(&H630), ChrW(&H631), ChrW(&H632), ChrW(&H633), ChrW(&H634), ChrW(&H635) _
						 }			 ' etc. 

						writer.WriteElement(eb.CreateUnicodeTextRun(New String(arabic)))
						writer.WriteElement(eb.CreateTextNewLine())

						' Thai 
						Dim thai As Char() = { _
						 ChrW(&HE01), ChrW(&HE02), ChrW(&HE03), ChrW(&HE04), ChrW(&HE05), ChrW(&HE06), ChrW(&HE07), ChrW(&HE08), ChrW(&HE09), _
						 ChrW(&HE0A), ChrW(&HE0B), ChrW(&HE0C), ChrW(&HE0D), ChrW(&HE0E), ChrW(&HE0F), ChrW(&HE10), ChrW(&HE11), ChrW(&HE12) _
						 }			 ' etc. 

						writer.WriteElement(eb.CreateUnicodeTextRun(New String(thai)))
						writer.WriteElement(eb.CreateTextNewLine())

						' Hiragana - Japanese 
						Dim hiragana As Char() = { _
						 ChrW(&H3041), ChrW(&H3042), ChrW(&H3043), ChrW(&H3044), ChrW(&H3045), ChrW(&H3046), ChrW(&H3047), ChrW(&H3048), ChrW(&H3049), _
						 ChrW(&H304A), ChrW(&H304B), ChrW(&H304C), ChrW(&H304D), ChrW(&H304E), ChrW(&H304F), ChrW(&H3051), ChrW(&H3051), ChrW(&H3052) _
						 }			 ' etc. 

						writer.WriteElement(eb.CreateUnicodeTextRun(New String(hiragana)))
						writer.WriteElement(eb.CreateTextNewLine())

						' CJK Unified Ideographs
						Dim cjk_uni As Char() = { _
						 ChrW(&H5841), ChrW(&H5842), ChrW(&H5843), ChrW(&H5844), ChrW(&H5845), ChrW(&H5846), ChrW(&H5847), ChrW(&H5848), ChrW(&H5849), _
						 ChrW(&H584A), ChrW(&H584B), ChrW(&H584C), ChrW(&H584D), ChrW(&H584E), ChrW(&H584F), ChrW(&H5850), ChrW(&H5851), ChrW(&H5852) _
						 }			 ' etc. 

						writer.WriteElement(eb.CreateUnicodeTextRun(New String(cjk_uni)))
						writer.WriteElement(eb.CreateTextNewLine())

						Dim chinese_simplified As Char() = {ChrW(&H4e16), ChrW(&H754c), ChrW(&H60a8),ChrW(&H597D)}
						writer.WriteElement(eb.CreateUnicodeTextRun(New String(chinese_simplified)))
					    	writer.WriteElement(eb.CreateTextNewLine())
    
						' Finish the block of text
						writer.WriteElement(eb.CreateTextEnd())
						Console.WriteLine("Now using text shaping logic to place text")

						Dim indexedFont As Font = Font.CreateCIDTrueTypeFont(doc, input_path & "NotoSans_with_hindi.ttf", True, True, Font.Encoding.e_Indices)
						element = eb.CreateTextBegin(indexedFont, 10.0)
						writer.WriteElement(element)
						Dim linePos As Double = 350.0
						Dim lineSpace As Double = 20.0
						Dim shapedText As ShapedText = indexedFont.GetShapedText("Shaped Hindi Text:")
						element = eb.CreateShapedTextRun(shapedText)
						element.SetTextMatrix(1.5, 0, 0, 1.5, 50, linePos)
						linePos -= lineSpace
						writer.WriteElement(element)
						Dim hindiTextLines As String() = File.ReadAllLines(input_path & "hindi_sample_utf16le.txt", Encoding.UTF8)

						Console.WriteLine("Read in " & hindiTextLines.Length & " lines of Unicode text from file")
						For Each textLine As String In hindiTextLines
							shapedText = indexedFont.GetShapedText(textLine)
							element = eb.CreateShapedTextRun(shapedText)
							element.SetTextMatrix(1.5, 0, 0, 1.5, 50, linePos)
							linePos -= lineSpace
							writer.WriteElement(element)
							Console.WriteLine("Wrote shaped line to page")
						Next
						writer.WriteElement(eb.CreateTextEnd())
						writer.End()			  ' save changes to the current page
						doc.PagePushBack(page)

						doc.Save(output_path + "unicodewrite.pdf", SDF.SDFDoc.SaveOptions.e_remove_unused Or SDF.SDFDoc.SaveOptions.e_hex_strings)
						Console.WriteLine("Done. Result saved in unicodewrite.pdf...")
					End Using
				End Using
			End Using

		Catch ex As PDFNetException

			Console.WriteLine(ex.Message)
			Console.WriteLine()

		Catch ex As Exception

			MsgBox(ex.Message)

		End Try
		PDFNet.Terminate()
	End Sub

End Module