Click here to Skip to main content
15,867,895 members
Articles / Programming Languages / Visual Basic
Tip/Trick

Rendering Qur'anic (Complex Arabic) Scripts with Unicode in a PDF

Rate me:
Please Sign up or sign in to vote.
5.00/5 (4 votes)
9 Mar 2015CPOL2 min read 11.3K   2   1
Rendering Qur'anic (complex Arabic) scripts with Unicode in a PDF

Introduction

Most PDFs with complex Arabic generally used for the Qur'an use special fonts or images or sacrifice being raw Unicode text in various ways. Qur'anic Arabic renders fine with a complex script rendering engine present in most web browers or document editors now through GDI or for more accuracy than DirectWrite or a custom complex script library. iTextSharp is one of the best libraries for doing the task. The result will be fully copy and pastable Unicode Qur'anic Arabic text.

Background

VB.NET, .NET, DirectWrite, PDF, iTextSharp, Qur'anic Arabic and ligaturizing are useful to know to understand this. DirectWrite provides accurate calculations and Unicode ligature conversions to properly and correctly align the diacritics. iTextSharp is used in this example to write the diacritics out one by one.

Required are Unicode standard data (currently v7.0.0) UnicodeData.txt and ArabicShaping.txt which are loaded to generate complete ligature and Arabic information in the most comprehensive standards based method freely available from (which should be put in a directory called metadata):

Using the Code

Example:

C#
'Before rendering complex Arabic text, call the following:
Text = WriteArabicPdfDiacritics(Doc, Writer, DrawFont, FixedFont, Text, Rect, 
		Baseline, False, Forms, FontFace)

The code which also includes a FitText scaling function and GetTextWidthDraw pre-calculation function:

VB.NET
Public Class ArabicData
    <serializable> _
    Public Structure ArabicCombo
        Public UnicodeName As String()
        Public Symbol As Char()
        Public Shaping() As Char
        Public ReadOnly Property Connecting As Boolean
            Get
                If Not Shaping Is Nothing And Shaping.Length = 1 Then Return ArabicLetters(FindLetterBySymbol(Shaping(0))).Connecting
                Return (Not Shaping Is Nothing AndAlso (Shaping(1) <> Nothing Or Shaping(3) <> Nothing))
            End Get
        End Property
        Public ReadOnly Property Terminating As Boolean
            Get
                If Not Shaping Is Nothing And Shaping.Length = 1 _
                Then Return ArabicLetters(FindLetterBySymbol(Shaping(0))).Terminating
                Return (Not Shaping Is Nothing AndAlso ((Shaping(0) <> _
                Nothing Or Shaping(1) <> Nothing) And Shaping(2) = Nothing And Shaping(3) = Nothing))
            End Get
        End Property
    End Structure
    Public Shared _ArabicCombos() As ArabicCombo
    <serializable> _
    Public Structure ArabicSymbol
        Public UnicodeName As String
        Public Symbol As Char
        Public Shaping() As Char
        Public JoiningStyle As String
        Public CombiningClass As Integer
        Public ReadOnly Property Connecting As Boolean
            Get
                Return JoiningStyle <> "T" AndAlso _
                (JoiningStyle = "final" Or JoiningStyle = "medial" Or JoiningStyle = "C" _
                Or (Not Shaping Is Nothing AndAlso (Shaping(1) <> Nothing Or Shaping(3) <> Nothing)))
            End Get
        End Property
        Public ReadOnly Property Terminating As Boolean
            Get
                Return JoiningStyle <> "T" AndAlso _
                (JoiningStyle = "isolated" Or JoiningStyle = "final" Or JoiningStyle = "U" _
                Or (Not Shaping Is Nothing AndAlso ((Shaping(0) <> Nothing Or Shaping(1) <> _
                Nothing) And Shaping(2) = Nothing And Shaping(3) = Nothing)))
            End Get
        End Property
    End Structure
    Public Shared _ArabicLetters() As ArabicSymbol
    Public Shared Sub LoadArabic()
        If Not DiskCache.GetCacheItem("ArabicLetters", DateTime.MinValue) Is Nothing _
        And Not DiskCache.GetCacheItem("ArabicCombos", DateTime.MinValue) Is Nothing Then
            _ArabicLetters = CType((New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter)._
            Deserialize(New IO.MemoryStream(DiskCache.GetCacheItem("ArabicLetters", _
            DateTime.MinValue))), ArabicData.ArabicSymbol())
            _ArabicCombos = CType((New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter)._
            Deserialize(New IO.MemoryStream(DiskCache.GetCacheItem("ArabicCombos", _
            DateTime.MinValue))), ArabicData.ArabicCombo())
            Return
        End If
        Dim CharArr As New ArrayList
        Dim Letters As New ArrayList
        Dim Combos As New ArrayList
        Dim Ranges As ArrayList = MakeUniCategory(ALCategories)
        For Count = 0 To Ranges.Count - 1
            Dim Range As ArrayList = CType(Ranges(Count), ArrayList)
            If Range.Count = 1 Then
                CharArr.Add(Range(0))
            Else
                For SubCount = 0 To Range.Count - 1
                    CharArr.Add(Range(SubCount))
                Next
            End If
        Next
        For Count = 0 To CharArr.Count - 1
            If _DecData.ContainsKey(ChrW(CInt(CharArr(Count)))) AndAlso Not _DecData.Item_
            (ChrW(CInt(CharArr(Count)))).Chars Is Nothing AndAlso _DecData.Item_
            (ChrW(CInt(CharArr(Count)))).Chars.Length <> 0 Then
                Dim ComCount As Integer
                For ComCount = 0 To Combos.Count - 1
                    If String.Join(String.Empty, Array.ConvertAll(CType(Combos(ComCount), _
                    ArabicCombo).Symbol, Function(Sym As Char) CStr(Sym))) = String.Join_
                    (String.Empty, Array.ConvertAll(_DecData.Item(ChrW(CInt(CharArr(Count)))).Chars, _
                    Function(Sym As Char) CStr(Sym))) Then Exit For
                Next
                Dim ArComb As ArabicCombo
                If ComCount = Combos.Count Then
                    ArComb = New ArabicCombo
                    ArComb.Shaping = {Nothing, Nothing, Nothing, Nothing}
                    ArComb.UnicodeName = {Nothing, Nothing, Nothing, Nothing}
                    ArComb.Symbol = _DecData.Item(ChrW(CInt(CharArr(Count)))).Chars
                Else
                    ArComb = CType(Combos(ComCount), ArabicCombo)
                End If
                Dim Idx As Integer = Array.IndexOf(ShapePositions, _DecData.Item(ChrW(CInt(CharArr(Count)))).JoiningStyle)
                If Idx = -1 Then
                    ArComb.UnicodeName = {_Names.Item(ChrW(CInt(CharArr(Count))))(0)}
                    ArComb.Shaping = {ChrW(CInt(CharArr(Count)))}
                    Dim ArabicLet As New ArabicSymbol
                    ArabicLet.Symbol = ChrW(CInt(CharArr(Count)))
                    ArabicLet.UnicodeName = _Names.Item(ArabicLet.Symbol)(0)
                    ArabicLet.JoiningStyle = _DecData.Item(ArabicLet.Symbol).JoiningStyle
                    ArabicLet.Shaping = _DecData.Item(ArabicLet.Symbol).Shapes
                    Letters.Add(ArabicLet)
                Else
                    ArComb.UnicodeName(Idx) = _Names.Item(ChrW(CInt(CharArr(Count))))(0)
                    ArComb.Shaping(Idx) = ChrW(CInt(CharArr(Count)))
                End If
                If ComCount = Combos.Count Then Combos.Add(ArComb)
            Else
                Dim ArabicLet As New ArabicSymbol
                ArabicLet.Symbol = ChrW(CInt(CharArr(Count)))
                If Array.IndexOf(CombineCategories, _UniClass(ArabicLet.Symbol)) _
                <> -1 Then ArabicLet.JoiningStyle = "T"
                If Array.IndexOf(CausesJoining, ArabicLet.Symbol) <> -1 _
                Then ArabicLet.JoiningStyle = "C"
                If _DecData.ContainsKey(ChrW(CInt(CharArr(Count)))) Then
                    ArabicLet.JoiningStyle = _DecData.Item(ArabicLet.Symbol).JoiningStyle
                    ArabicLet.Shaping = _DecData.Item(ArabicLet.Symbol).Shapes
                End If
                ArabicLet.UnicodeName = _Names.Item(ArabicLet.Symbol)(0)
                Letters.Add(ArabicLet)
            End If
        Next
        CharArr = New ArrayList
        Ranges = MakeUniCategory(WeakCategories)
        For Count = 0 To Ranges.Count - 1
            Dim Range As ArrayList = CType(Ranges(Count), ArrayList)
            If Range.Count = 1 Then
                CharArr.Add(Range(0))
            Else
                For SubCount = 0 To Range.Count - 1
                    CharArr.Add(Range(SubCount))
                Next
            End If
        Next
        For Count = 0 To CharArr.Count - 1
            Dim ArabicLet As New ArabicSymbol
            ArabicLet.Symbol = ChrW(CInt(CharArr(Count)))
            ArabicLet.JoiningStyle = If(Array.IndexOf(CombineCategories, _UniClass(ArabicLet.Symbol)) _
            <> -1, "T", If(Array.IndexOf(CausesJoining, ArabicLet.Symbol) <> -1, _
            "C", "U"))
            ArabicLet.UnicodeName = _Names.Item(ArabicLet.Symbol)(0)
            Letters.Add(ArabicLet)
        Next
        CharArr = New ArrayList
        Ranges = MakeUniCategory(NeutralCategories)
        For Count = 0 To Ranges.Count - 1
            Dim Range As ArrayList = CType(Ranges(Count), ArrayList)
            If Range.Count = 1 Then
                CharArr.Add(Range(0))
            Else
                For SubCount = 0 To Range.Count - 1
                    CharArr.Add(Range(SubCount))
                Next
            End If
        Next
        For Count = 0 To CharArr.Count - 1
            Dim ArabicLet As New ArabicSymbol
            ArabicLet.Symbol = ChrW(CInt(CharArr(Count)))
            ArabicLet.JoiningStyle = If(Array.IndexOf(CombineCategories, _UniClass(ArabicLet.Symbol)) _
            <> -1, "T", If(Array.IndexOf(CausesJoining, ArabicLet.Symbol) <> -1, _
            "C", "U"))
            ArabicLet.UnicodeName = _Names.Item(ArabicLet.Symbol)(0)
            Letters.Add(ArabicLet)
        Next
        _ArabicLetters = CType(Letters.ToArray(GetType(ArabicSymbol)), ArabicSymbol())
        _ArabicCombos = CType(Combos.ToArray(GetType(ArabicCombo)), ArabicCombo())
        Dim MemStream As New IO.MemoryStream
        Dim Ser As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
        Ser.Serialize(MemStream, _ArabicLetters)
        DiskCache.CacheItem("ArabicLetters", Now, MemStream.ToArray())
        MemStream.Close()
        MemStream = New IO.MemoryStream
        Ser.Serialize(MemStream, _ArabicCombos)
        DiskCache.CacheItem("ArabicCombos", Now, MemStream.ToArray())
        MemStream.Close()
    End Sub
    Public Shared ReadOnly Property ArabicCombos As ArabicCombo()
        Get
            If _ArabicCombos Is Nothing Then
                LoadArabic()
            End If
            Return _ArabicCombos
        End Get
    End Property
    Public Shared ReadOnly Property ArabicLetters As ArabicSymbol()
        Get
            If _ArabicLetters Is Nothing Then
                LoadArabic()
            End If
            Return _ArabicLetters
        End Get
    End Property
    Public Shared Function GetUnicodeName(Character As Char) As String
        Dim Str As New System.Text.StringBuilder(512)
        Try
            NativeMethods.GetUName(CUShort(AscW(Character)), Str)
        Catch e As System.DllNotFoundException
            If FindLetterBySymbol(Character) = -1 Then Return String.Empty
            Dim Res As String = Utility.LoadResourceString("unicode_" + _
            ArabicLetters(FindLetterBySymbol(Character)).UnicodeName)
            If Res.Length <> 0 Then Return Res
            Return ArabicLetters(FindLetterBySymbol(Character)).UnicodeName
        End Try
        Return Str.ToString()
    End Function
    Public Shared Function ToCamelCase(Str As String) As String
        Return System.Text.RegularExpressions.Regex.Replace(Str, "([A-Z])([A-Z]+)(-| |$)", _
        Function(CamCase As System.Text.RegularExpressions.Match) CamCase.Groups(1).Value + _
        CamCase.Groups(2).Value.ToLower())
    End Function
    Public Shared Function IsTerminating(Str As String, Index As Integer) As Boolean
        Dim bIsEnd = True 'default to non-connecting end
        'should probably check for any non-arabic letters also
        For CharCount As Integer = Index + 1 To Str.Length - 1
            Dim Idx As Integer = FindLetterBySymbol(Str(CharCount))
            If Idx = -1 OrElse ArabicLetters(Idx).JoiningStyle <> "T" Then
                bIsEnd = Idx = -1 OrElse Not ArabicLetters(Idx).Connecting
                Exit For
            End If
        Next
        Return bIsEnd
    End Function
    Public Shared Function IsLastConnecting(Str As String, Index As Integer) As Boolean
        Dim bLastConnects = False 'default to non-connecting beginning 
        For CharCount As Integer = Index - 1 To 0 Step -1
            Dim Idx As Integer = FindLetterBySymbol(Str(CharCount))
            If Idx <> -1 AndAlso ArabicLetters(Idx).JoiningStyle <> "T" Then
                bLastConnects = Idx <> -1 AndAlso Not ArabicLetters(Idx).Terminating
                Exit For
            End If
        Next
        Return bLastConnects
    End Function
    Public Shared Function GetShapeIndex(bConnects As Boolean, _
    bLastConnects As Boolean, bIsEnd As Boolean) As Integer
        If Not bLastConnects And (Not bConnects Or bConnects And bIsEnd) Then
            Return 0
        ElseIf bLastConnects And (Not bConnects Or bConnects And bIsEnd) Then
            Return 1
        ElseIf Not bLastConnects And bConnects And Not bIsEnd Then
            Return 2
        ElseIf bLastConnects And bConnects And Not bIsEnd Then
            Return 3
        End If
        Return -1
    End Function
    Public Shared Function GetShapeIndexFromString(Str As String, _
    Index As Integer, Length As Integer) As Integer
        'ignore all transparent characters
        'isolated - non-connecting + (non-connecting letter | connecting letter + end)
        'final - connecting + (non-connecting letter | connecting letter + end)
        'initial - non-connecting + connecting letter + not end
        'medial - connecting + connecting letter + not end
        Dim bIsEnd = IsTerminating(Str, Index + Length - 1)
        Dim Idx As Integer = FindLetterBySymbol(Str.Chars(Index + Length - 1))
        Dim bConnects As Boolean = Not ArabicLetters(Idx).Terminating
        Dim bLastConnects As Boolean = ArabicLetters(Idx).Connecting And IsLastConnecting(Str, Index)
        Return GetShapeIndex(bConnects, bLastConnects, bIsEnd)
    End Function
    Public Shared Function TransformChars(Str As String) As String
        For Count As Integer = 0 To ArabicCombos.Length - 1
            If ArabicCombos(Count).Shaping.Length = 1 Then
                Str = Str.Replace(String.Join(String.Empty, Array.ConvertAll(ArabicCombos_
                (Count).Symbol, Function(Sym As Char) CStr(Sym))), ArabicCombos(Count).Shaping(0))
            End If
        Next
        Return Str
    End Function
    Public Structure LigatureInfo
        Public Ligature As String
        Public Indexes() As Integer
    End Structure
    Public Shared Function GetFormsRange(BeginIndex As Char, EndIndex As Char) As Char()
        Dim Forms As New List(Of Char)
        For Count As Integer = 0 To ArabicCombos.Length - 1
            If Not ArabicCombos(Count).Shaping Is Nothing Then
                Array.ForEach(ArabicCombos(Count).Shaping, Sub(Shape As Char) _
                If Shape >= BeginIndex AndAlso Shape <= EndIndex Then Forms.Add(Shape))
            End If
        Next
        For Count As Integer = 0 To ArabicLetters.Length - 1
            If Not ArabicLetters(Count).Shaping Is Nothing Then
                Array.ForEach(ArabicLetters(Count).Shaping, Sub(Shape As Char) _
                If Shape >= BeginIndex AndAlso Shape <= EndIndex Then Forms.Add(Shape))
            End If
        Next
        Return Forms.ToArray()
    End Function
    Public Shared _PresentationForms() As Char
    Public Shared _PresentationFormsA() As Char
    Public Shared _PresentationFormsB() As Char
    Public Shared ReadOnly Property GetPresentationForms As Char()
        Get
            If _PresentationForms Is Nothing Then
                Dim Forms As New List(Of Char)
                Forms.AddRange(GetPresentationFormsA())
                Forms.AddRange(GetPresentationFormsB())
                _PresentationForms = Forms.ToArray()
            End If
            Return _PresentationForms
        End Get
    End Property
    Public Shared ReadOnly Property GetPresentationFormsA() As Char()
        Get
            If _PresentationFormsA Is Nothing Then
                _PresentationFormsA = GetFormsRange(ChrW(&HFB50), ChrW(&HFDFF))
            End If
            Return _PresentationFormsA
        End Get
    End Property
    Public Shared ReadOnly Property GetPresentationFormsB() As Char()
        Get
            If _PresentationFormsB Is Nothing Then
                _PresentationFormsB = GetFormsRange(ChrW(&HFE70), ChrW(&HFEFF))
            End If
            Return _PresentationFormsB
        End Get
    End Property
    Public Shared Function CheckLigatureMatch(Str As String, CurPos As Integer, _
    ByRef Positions As Integer()) As Integer
        'if first is 2 diacritics or letter + diacritic
        'letter + diacritic done only unless a space present as 2 diacritics 
        'could be nexted in required ligature which would be skipped
        'must check space with 2 diacritics first, second check will already capture space with diacritic
        If Str.Length > 2 AndAlso FindLetterBySymbol(Str(1)) <> -1 _
        AndAlso ArabicLetters(FindLetterBySymbol(Str(1))).JoiningStyle = "T" _
        AndAlso ArabicLetters(FindLetterBySymbol(Str(2))).JoiningStyle = "T" _
        AndAlso (LigatureLookups.ContainsKey(Str.Substring(0, 3)) Or _
        LigatureLookups.ContainsKey(Str(0) + Str(2) + Str(1))) Then
            Positions = {CurPos, CurPos + 1, CurPos + 2}
            Return LigatureLookups.Item(If(LigatureLookups.ContainsKey(Str.Substring(0, 3)), _
            Str.Substring(0, 3), Str(0) + Str(2) + Str(1)))
        ElseIf Str.Length > 1 AndAlso FindLetterBySymbol(Str(1)) <> -1 _
        AndAlso ArabicLetters(FindLetterBySymbol(Str(1))).JoiningStyle = "T" _
        AndAlso LigatureLookups.ContainsKey(Str.Substring(0, 2)) Then
            Positions = {CurPos, CurPos + 1}
            Return LigatureLookups.Item(Str.Substring(0, 2))
        End If
        If FindLetterBySymbol(Str(0)) <> -1 AndAlso ArabicLetters_
        (FindLetterBySymbol(Str(0))).JoiningStyle <> "T" Then
            'only 3 letters or 2 letters has possible parsing, or several 4 and a multiword 8 and 18
            Dim StrCount As Integer = 0
            Positions = {CurPos + StrCount}
            For Count = 1 To 18
                StrCount += 1
                While StrCount <> Str.Length AndAlso FindLetterBySymbol(Str(StrCount)) _
                <> -1 AndAlso ArabicLetters(FindLetterBySymbol(Str(StrCount))).JoiningStyle = "T"
                    StrCount += 1
                End While
                If StrCount = Str.Length Then Exit For
                ReDim Preserve Positions(Count)
                Positions(Count) = CurPos + StrCount
            Next
            If Positions.Length = 1 Then Positions = {}
            While Positions.Length <> 0
                If LigatureLookups.ContainsKey(String.Join(String.Empty, _
                Array.ConvertAll(Positions, Function(Pos As Integer) CStr(Str(Pos - CurPos))))) Then
                    Return LigatureLookups.Item(String.Join(String.Empty, _
                    Array.ConvertAll(Positions, Function(Pos As Integer) CStr(Str(Pos - CurPos)))))
                End If
                ReDim Preserve Positions(Positions.Length - 2)
            End While
        End If
        'if first is diacritic or letter
        'check space diacritic first
        If Str.Length > 1 AndAlso FindLetterBySymbol(Str(1)) <> -1 _
        AndAlso ArabicLetters(FindLetterBySymbol(Str(1))).JoiningStyle = "T" _
        AndAlso (LigatureLookups.ContainsKey(" " + Str.Substring(0, 2)) Or _
        LigatureLookups.ContainsKey(" " + Str(1) + Str(0))) Then
            Positions = {CurPos, CurPos + 1}
            Return LigatureLookups.Item(" " + If(LigatureLookups.ContainsKey_
            (" " + Str.Substring(0, 2)), Str.Substring(0, 2), Str(1) + Str(0)))
        ElseIf Str.Length > 2 AndAlso FindLetterBySymbol(Str(1)) <> -1 _
        AndAlso ArabicLetters(FindLetterBySymbol(Str(1))).JoiningStyle = "T" _
        AndAlso ArabicLetters(FindLetterBySymbol(Str(2))).JoiningStyle = "T" _
        AndAlso (LigatureLookups.ContainsKey(Str(0) + Str(2))) Then
            'Tatweel with a Hamza Above followed by diacritic
            Positions = {CurPos, CurPos + 2}
            Return LigatureLookups.Item(Str(0) + Str(2))
        ElseIf LigatureLookups.ContainsKey(Str.Substring(0, 1)) Then
            Positions = {CurPos}
            Return LigatureLookups.Item(Str.Substring(0, 1))
        ElseIf LigatureLookups.ContainsKey(" " + Str.Substring(0, 1)) Then
            Positions = {CurPos}
            Return LigatureLookups.Item(" " + Str.Substring(0, 1))
        End If
        Return -1
    End Function
    Public Shared _LigatureCombos() As ArabicCombo
    Public Shared ReadOnly Property LigatureCombos As ArabicCombo()
        Get
            If _LigatureCombos Is Nothing Then
                ReDim _LigatureCombos(ArabicLetters.Length + ArabicCombos.Length - 1)
                ArabicCombos.CopyTo(_LigatureCombos, 0)
                For Count = 0 To ArabicLetters.Length - 1
                    'do not need to transfer UnicodeName as it is not used here
                    _LigatureCombos(ArabicCombos.Length + Count).Symbol = {ArabicLetters(Count).Symbol}
                    _LigatureCombos(ArabicCombos.Length + Count).Shaping = ArabicLetters(Count).Shaping
                Next
                Array.Sort(_LigatureCombos, Function(Com1 As ArabicCombo, Com2 As ArabicCombo) _
                If(Com1.Symbol.Length = Com2.Symbol.Length, String.Join(String.Empty, _
                Array.ConvertAll(Com1.Symbol, Function(Sym As Char) CStr(Sym))).CompareTo_
                (String.Join(String.Empty, Array.ConvertAll(Com2.Symbol, Function(Sym As Char) CStr(Sym)))), _
                If(Com1.Symbol.Length > Com2.Symbol.Length, -1, 1)))
            End If
            Return _LigatureCombos
        End Get
    End Property
    Public Shared _LigatureShapes As Dictionary(Of Char, Integer)
    Public Shared ReadOnly Property LigatureShapes As Dictionary(Of Char, Integer)
        Get
            If _LigatureShapes Is Nothing Then
                Dim Combos As ArabicCombo() = LigatureCombos
                _LigatureShapes = New Dictionary(Of Char, Integer)
                For Count As Integer = 0 To Combos.Length - 1
                    If Not Combos(Count).Shaping Is Nothing Then
                        For SubCount As Integer = 0 To Combos(Count).Shaping.Length - 1
                            _LigatureShapes.Add(Combos(Count).Shaping(SubCount), Count)
                        Next
                    End If
                Next
            End If
            Return _LigatureShapes
        End Get
    End Property
    Public Shared _LigatureLookups As Dictionary(Of String, Integer)
    Public Shared ReadOnly Property LigatureLookups As Dictionary(Of String, Integer)
        Get
            If _LigatureLookups Is Nothing Then
                _LigatureLookups = New Dictionary(Of String, Integer)
                Dim Combos As ArabicCombo() = LigatureCombos
                For Count = 0 To Combos.Length - 1
                    'If there is only an isolated form then the combos 
                    'which come before letters would take precedence
                    If Not Combos(Count).Shaping Is Nothing And Not _LigatureLookups.ContainsKey_
                    (String.Join(String.Empty, Array.ConvertAll(Combos(Count).Symbol, Function(Sym As Char) CStr(Sym)))) Then
                        _LigatureLookups.Add(String.Join(String.Empty, Array.ConvertAll_
                        (Combos(Count).Symbol, Function(Sym As Char) CStr(Sym))), Count)
                    End If
                Next
            End If
            Return _LigatureLookups
        End Get
    End Property
    Public Shared Function GetLigatures(Str As String, Dir As Boolean, _
    SupportedForms As Char()) As LigatureInfo()
        Dim Count As Integer
        Dim SubCount As Integer
        Dim Ligatures As New List(Of LigatureInfo)
        Dim Combos As ArabicCombo() = LigatureCombos
        'Division seleciton between Presentation A and B forms can be done 
        'here though wasl and gunnah need consideration
        Count = 0
        While Count <> Str.Length
            If Dir Then
                If LigatureShapes.ContainsKey(Str.Chars(Count)) Then
                    'ZWJ and ZWNJ could be used to preserve deliberately improper _
                    shaped Arabic or other strategies beyond just default shaping
                    Ligatures.Add(New LigatureInfo With {.Ligature = _
                    Combos(LigatureShapes.Item(Str.Chars(Count))).Symbol, .Indexes = {Count}})
                End If
            Else
                Dim Indexes As Integer() = Nothing
                SubCount = CheckLigatureMatch(Str.Substring(Count), Count, Indexes)
                'transform ligatures are not processed here
                If SubCount <> -1 AndAlso Combos(SubCount).Shaping <> _
                Nothing AndAlso Combos(SubCount).Shaping.Length <> 1 Then
                    Dim Index As Integer = Array.FindIndex(Combos(SubCount).Symbol, _
                    Function(Ch As Char) Ch = " " Or FindLetterBySymbol(Ch) <> -1 _
                    AndAlso (ArabicLetters(FindLetterBySymbol(Ch)).JoiningStyle = "T" _
                    Or ArabicLetters(FindLetterBySymbol(Ch)).JoiningStyle = "C"))
                    'diacritics always use isolated form sitting on a space which is actually optional
                    Dim Shape As Integer = If(Index = 0, If(FindLetterBySymbol(Combos(SubCount).Symbol_
			(Index)) <> -1 AndAlso ArabicLetters(FindLetterBySymbol_
			(Combos(SubCount).Symbol(Index))).JoiningStyle = _
                    "C", 3, 0), GetShapeIndexFromString(Str, Count, Indexes(Indexes.Length - 1) - Count + _
                    1 - If(Index = -1, 0, Index)))
                    If Combos(SubCount).Shaping(Shape) <> ChrW(0) AndAlso Array.IndexOf_
                    (SupportedForms, Combos(SubCount).Shaping(Shape)) <> -1 Then
                        Ligatures.Add(New LigatureInfo With {.Ligature = _
                        Combos(SubCount).Shaping(Shape), .Indexes = Indexes})
                        'Ligatures can surround other ligatures which represents significant challenge
                    End If
                End If
            End If
            Count += 1
            While Array.FindIndex(Ligatures.ToArray(), Function(Lig As LigatureInfo) _
            Array.IndexOf(Lig.Indexes, Count) <> -1) <> -1
                Count += 1
            End While
        End While
        Return Ligatures.ToArray()
    End Function
    Public Shared Function ConvertLigatures(Str As String, Dir As Boolean, SupportedForms As Char()) As String
        Dim Ligatures() As LigatureInfo = GetLigatures(Str, Dir, SupportedForms)
        For Count = Ligatures.Length - 1 To 0 Step -1
            For Index = 0 To Ligatures(Count).Indexes.Length - 1
                Str = Str.Remove(Ligatures(Count).Indexes(Index), _
                1).Insert(Ligatures(Count).Indexes(0), Ligatures(Count).Ligature)
            Next
        Next
        Return Str
    End Function
    Public Shared _ArabicLetterMap As Dictionary(Of Char, Integer)
    Public Shared ReadOnly Property ArabicLetterMap As Dictionary(Of Char, Integer)
        Get
            If _ArabicLetterMap Is Nothing Then
                _ArabicLetterMap = New Dictionary(Of Char, Integer)
                For Index = 0 To ArabicLetters.Length - 1
                    If ArabicLetters(Index).Symbol <> ChrW(0) Then
                        _ArabicLetterMap.Add(ArabicLetters(Index).Symbol, Index)
                    End If
                Next
            End If
            Return _ArabicLetterMap
        End Get
    End Property
    Public Shared Function FindLetterBySymbol(Symbol As Char) As Integer
        Return If(ArabicLetterMap.ContainsKey(Symbol), ArabicLetterMap.Item(Symbol), -1)
    End Function
    Public Const Space As Char = ChrW(&H20)
    Public Const ExclamationMark As Char = ChrW(&H21)
    Public Const QuotationMark As Char = ChrW(&H22)
    Public Const Comma As Char = ChrW(&H2C)
    Public Const FullStop As Char = ChrW(&H2E)
    Public Const HyphenMinus As Char = ChrW(&H2D)
    Public Const Colon As Char = ChrW(&H3A)
    Public Const LeftParenthesis As Char = ChrW(&H5B)
    Public Const RightParenthesis As Char = ChrW(&H5D)
    Public Const LeftSquareBracket As Char = ChrW(&H5B)
    Public Const RightSquareBracket As Char = ChrW(&H5D)
    Public Const LeftCurlyBracket As Char = ChrW(&H7B)
    Public Const RightCurlyBracket As Char = ChrW(&H7D)
    Public Const NoBreakSpace As Char = ChrW(&HA0)
    Public Const LeftPointingDoubleAngleQuotationMark As Char = ChrW(&HAB)
    Public Const RightPointingDoubleAngleQuotationMark As Char = ChrW(&HBB)
    Public Const ArabicComma As Char = ChrW(&H60C)
    Public Const ArabicLetterHamza As Char = ChrW(&H621)
    Public Const ArabicLetterAlefWithMaddaAbove As Char = ChrW(&H622)
    Public Const ArabicLetterAlefWithHamzaAbove As Char = ChrW(&H623)
    Public Const ArabicLetterWawWithHamzaAbove As Char = ChrW(&H624)
    Public Const ArabicLetterAlefWithHamzaBelow As Char = ChrW(&H625)
    Public Const ArabicLetterYehWithHamzaAbove As Char = ChrW(&H626)
    Public Const ArabicLetterAlef As Char = ChrW(&H627)
    Public Const ArabicLetterBeh As Char = ChrW(&H628)
    Public Const ArabicLetterTehMarbuta As Char = ChrW(&H629)
    Public Const ArabicLetterTeh As Char = ChrW(&H62A)
    Public Const ArabicLetterTheh As Char = ChrW(&H62B)
    Public Const ArabicLetterJeem As Char = ChrW(&H62C)
    Public Const ArabicLetterHah As Char = ChrW(&H62D)
    Public Const ArabicLetterKhah As Char = ChrW(&H62E)
    Public Const ArabicLetterDal As Char = ChrW(&H62F)
    Public Const ArabicLetterThal As Char = ChrW(&H630)
    Public Const ArabicLetterReh As Char = ChrW(&H631)
    Public Const ArabicLetterZain As Char = ChrW(&H632)
    Public Const ArabicLetterSeen As Char = ChrW(&H633)
    Public Const ArabicLetterSheen As Char = ChrW(&H634)
    Public Const ArabicLetterSad As Char = ChrW(&H635)
    Public Const ArabicLetterDad As Char = ChrW(&H636)
    Public Const ArabicLetterTah As Char = ChrW(&H637)
    Public Const ArabicLetterZah As Char = ChrW(&H638)
    Public Const ArabicLetterAin As Char = ChrW(&H639)
    Public Const ArabicLetterGhain As Char = ChrW(&H63A)
    Public Const ArabicTatweel As Char = ChrW(&H640)
    Public Const ArabicLetterFeh As Char = ChrW(&H641)
    Public Const ArabicLetterQaf As Char = ChrW(&H642)
    Public Const ArabicLetterKaf As Char = ChrW(&H643)
    Public Const ArabicLetterLam As Char = ChrW(&H644)
    Public Const ArabicLetterMeem As Char = ChrW(&H645)
    Public Const ArabicLetterNoon As Char = ChrW(&H646)
    Public Const ArabicLetterHeh As Char = ChrW(&H647)
    Public Const ArabicLetterWaw As Char = ChrW(&H648)
    Public Const ArabicLetterAlefMaksura As Char = ChrW(&H649)
    Public Const ArabicLetterYeh As Char = ChrW(&H64A)

    Public Const ArabicFathatan As Char = ChrW(&H64B)
    Public Const ArabicDammatan As Char = ChrW(&H64C)
    Public Const ArabicKasratan As Char = ChrW(&H64D)
    Public Const ArabicFatha As Char = ChrW(&H64E)
    Public Const ArabicDamma As Char = ChrW(&H64F)
    Public Const ArabicKasra As Char = ChrW(&H650)
    Public Const ArabicShadda As Char = ChrW(&H651)
    Public Const ArabicSukun As Char = ChrW(&H652)
    Public Const ArabicMaddahAbove As Char = ChrW(&H653)
    Public Const ArabicHamzaAbove As Char = ChrW(&H654)
    Public Const ArabicHamzaBelow As Char = ChrW(&H655)
    Public Const ArabicVowelSignDotBelow As Char = ChrW(&H65C)
    Public Const Bullet As Char = ChrW(&H2022)
    Public Const ArabicLetterSuperscriptAlef As Char = ChrW(&H670)
    Public Const ArabicLetterAlefWasla As Char = ChrW(&H671)
    Public Const ArabicSmallHighLigatureSadWithLamWithAlefMaksura As Char = ChrW(&H6D6)
    Public Const ArabicSmallHighLigatureQafWithLamWithAlefMaksura As Char = ChrW(&H6D7)
    Public Const ArabicSmallHighMeemInitialForm As Char = ChrW(&H6D8)
    Public Const ArabicSmallHighLamAlef As Char = ChrW(&H6D9)
    Public Const ArabicSmallHighJeem As Char = ChrW(&H6DA)
    Public Const ArabicSmallHighThreeDots As Char = ChrW(&H6DB)
    Public Const ArabicSmallHighSeen As Char = ChrW(&H6DC)
    Public Const ArabicEndOfAyah As Char = ChrW(&H6DD)
    Public Const ArabicStartOfRubElHizb As Char = ChrW(&H6DE)
    Public Const ArabicSmallHighRoundedZero As Char = ChrW(&H6DF)
    Public Const ArabicSmallHighUprightRectangularZero As Char = ChrW(&H6E0)
    Public Const ArabicSmallHighMeemIsolatedForm As Char = ChrW(&H6E2)
    Public Const ArabicSmallLowSeen As Char = ChrW(&H6E3)
    Public Const ArabicSmallWaw As Char = ChrW(&H6E5)
    Public Const ArabicSmallYeh As Char = ChrW(&H6E6)
    Public Const ArabicSmallHighNoon As Char = ChrW(&H6E8)
    Public Const ArabicPlaceOfSajdah As Char = ChrW(&H6E9)
    Public Const ArabicEmptyCentreLowStop As Char = ChrW(&H6EA)
    Public Const ArabicEmptyCentreHighStop As Char = ChrW(&H6EB)
    Public Const ArabicRoundedHighStopWithFilledCentre As Char = ChrW(&H6EC)
    Public Const ArabicSmallLowMeem As Char = ChrW(&H6ED)
    Public Const ArabicSemicolon As Char = ChrW(&H61B)
    Public Const ArabicLetterMark As Char = ChrW(&H61C)
    Public Const ArabicQuestionMark As Char = ChrW(&H61F)
    Public Const ArabicLetterPeh As Char = ChrW(&H67E)
    Public Const ArabicLetterTcheh As Char = ChrW(&H686)
    Public Const ArabicLetterVeh As Char = ChrW(&H6A4)
    Public Const ArabicLetterGaf As Char = ChrW(&H6AF)
    Public Const ArabicLetterNoonGhunna As Char = ChrW(&H6BA)
    Public Const ZeroWidthSpace As Char = ChrW(&H200B)
    Public Const ZeroWidthNonJoiner As Char = ChrW(&H200C)
    Public Const ZeroWidthJoiner As Char = ChrW(&H200D)
    Public Const LeftToRightMark As Char = ChrW(&H200E)
    Public Const RightToLeftMark As Char = ChrW(&H200F)
    Public Const PopDirectionalFormatting As Char = ChrW(&H202C)
    Public Const LeftToRightOverride As Char = ChrW(&H202D)
    Public Const RightToLeftOverride As Char = ChrW(&H202E)
    Public Const NarrowNoBreakSpace As Char = ChrW(&H202F)
    Public Const DottedCircle As Char = ChrW(&H25CC)
    Public Const OrnateLeftParenthesis As Char = ChrW(&HFD3E)
    Public Const OrnateRightParenthesis As Char = ChrW(&HFD3F)
    'http://www.unicode.org/Public/7.0.0/ucd/UnicodeData.txt
    Public Shared LTRCategories As String() = New String() {"L"}
    Public Shared RTLCategories As String() = New String() {"R", "AL"}
    Public Shared ALCategories As String() = New String() {"AL"}
    Public Shared CombineCategories As String() = New String() {"Mn", "Me", "Cf"}
    Public Shared NeutralCategories As String() = New String() {"B", _
    "S", "WS", "ON"}
    Public Shared WeakCategories As String() = New String() {"EN", _
    "ES", "ET", "AN", "CS", "NSM", "BN"}
    Public Shared ExplicitCategories As String() = New String() {"LRE", _
    "LRO", "RLE", "RLO", "PDF", "LRI", _
    "RLI", "FSI", "PDI"}
    Public Shared CausesJoining As Char() = New Char() {ArabicTatweel, ZeroWidthJoiner}
    Public Shared Function GetUniCats() As String()
        Return {"function IsLTR(c) { " + MakeUniCategoryJS(LTRCategories) + " }", _
        "function IsRTL(c) { " + MakeUniCategoryJS(RTLCategories) + " }", _
        "function IsAL(c) { " + MakeUniCategoryJS(ALCategories) + " }", _
        "function IsNeutral(c) { " + MakeUniCategoryJS(NeutralCategories) + " }", _
        "function IsWeak(c) { " + MakeUniCategoryJS(WeakCategories) + " }", _
        "function IsExplicit(c) { " + MakeUniCategoryJS(ExplicitCategories) + " }"}
    End Function
    Public Shared Function GetJoiningData() As Dictionary(Of Char, String)
        Dim Strs As String() = IO.File.ReadAllLines(Utility.GetFilePath("metadata\ArabicShaping.txt"))
        Dim Joiners As New Dictionary(Of Char, String)
        For Count = 0 To Strs.Length - 1
            If Strs(Count)(0) <> "#" Then
                Dim Vals As String() = Strs(Count).Split(";"c)
                'C Join_Causing on Tatweel and ZeroWidthJoiner could be considered as Dual_Joining
                'General Category Mn, Me, or Cf are T Transparent and all others are U Non_Joining
                Joiners.Add(ChrW(Integer.Parse(Vals(0), Globalization.NumberStyles.AllowHexSpecifier)), Vals(4))
            End If
        Next
        Return Joiners
    End Function
    Structure DecData
        Public JoiningStyle As String
        Public Chars As Char()
        Public Shapes As Char()
    End Structure
    Public Shared ShapePositions As String() = {"isolated", _
    "final", "initial", "medial"}
    Public Shared _CombPos As Dictionary(Of Char, Integer)
    Public Shared _UniClass As Dictionary(Of Char, String)
    Public Shared _DecData As Dictionary(Of Char, DecData)
    Public Shared _Ranges As Dictionary(Of String, ArrayList)
    Public Shared _Names As Dictionary(Of Char, String())
    Public Shared Sub GetDecompositionCombiningCatData()
        Dim Strs As String() = IO.File.ReadAllLines(Utility.GetFilePath("metadata\UnicodeData.txt"))
        _CombPos = New Dictionary(Of Char, Integer)
        _UniClass = New Dictionary(Of Char, String)
        _Ranges = New Dictionary(Of String, ArrayList)
        _DecData = New Dictionary(Of Char, DecData)
        _Names = New Dictionary(Of Char, String())
        For Count = 0 To Strs.Length - 1
            Dim Vals As String() = Strs(Count).Split(";"c)
            'All symbol categories not needed
            If (Vals(2)(0) = "S" And Vals(4) <> "ON") Or _
            Integer.Parse(Vals(0), Globalization.NumberStyles.AllowHexSpecifier) >= &H10000 Then Continue For
            Dim Ch As Char = ChrW(Integer.Parse(Vals(0), Globalization.NumberStyles.AllowHexSpecifier))
            _UniClass.Add(Ch, Vals(2))
            If Vals(5) <> "" Then
                Dim CombData As String() = Vals(5).Split(" "c)
                If Not _DecData.ContainsKey(Ch) Then _DecData.Add(Ch, _
                New DecData With {.Shapes = New Char() {Nothing, Nothing, Nothing, Nothing}})
                Dim Data As DecData = _DecData(Ch)
                If CombData(0).StartsWith("<") And CombData(0).EndsWith(">") Then
                    Data.JoiningStyle = CombData(0).Trim("<"c, ">"c)
                    ReDim Data.Chars(CombData.Length - 2)
                    For SubCount = 0 To CombData.Length - 2
                        Data.Chars(SubCount) = ChrW(Integer.Parse(CombData(SubCount + 1), _
                        Globalization.NumberStyles.AllowHexSpecifier))
                    Next
                    _DecData(Ch) = Data
                    If CombData.Length = 2 Then
                        If Not _DecData.ContainsKey(Data.Chars(0)) Then _DecData.Add(Data.Chars(0), _
                        New DecData With {.Shapes = New Char() {Nothing, Nothing, Nothing, Nothing}})
                        Dim ShapeData As DecData = _DecData(Data.Chars(0))
                        If Array.IndexOf(ShapePositions, Data.JoiningStyle) <> -1 Then _
                        ShapeData.Shapes(Array.IndexOf(ShapePositions, Data.JoiningStyle)) = Ch
                    End If
                Else
                    Data.Chars = Array.ConvertAll(CombData, Function(Dat As String) _
                    ChrW(If(Integer.Parse(Dat, Globalization.NumberStyles.AllowHexSpecifier) _
                    >= &H10000, 0, Integer.Parse(Dat, Globalization.NumberStyles.AllowHexSpecifier))))
                    _DecData(Ch) = Data
                End If
            End If
            If Vals(3) <> "" Then
                _CombPos.Add(Ch, Integer.Parse(Vals(3), Globalization.NumberStyles.Integer))
            End If
            If Vals(10) <> "" Then
                _Names.Add(Ch, {Vals(1), Vals(10)})
            Else
                _Names.Add(Ch, {Vals(1)})
            End If
            Dim NewRangeMatch As Integer = Integer.Parse(Vals(0), Globalization.NumberStyles.AllowHexSpecifier)
            If Not _Ranges.ContainsKey(Vals(4)) Then _Ranges.Add(Vals(4), New ArrayList)
            If _Ranges(Vals(4)).Count <> 0 AndAlso CInt(CType(_Ranges(Vals(4))(_Ranges(Vals(4)).Count - 1), _
            ArrayList)(CType(_Ranges(Vals(4))(_Ranges(Vals(4)).Count - 1), ArrayList).Count - 1)) + 1 = NewRangeMatch Then
                CType(_Ranges(Vals(4))(_Ranges(Vals(4)).Count - 1), ArrayList).Add(NewRangeMatch)
            Else
                _Ranges(Vals(4)).Add(New ArrayList From {NewRangeMatch})
            End If
        Next
    End Sub
    Public Shared Function MakeUniCategory(Cats As String()) As ArrayList
        If _Ranges Is Nothing Then GetDecompositionCombiningCatData()
        Dim Ranges As New ArrayList
        For Count = 0 To Cats.Length - 1
            If _Ranges.ContainsKey(Cats(Count)) Then
                Ranges.AddRange(_Ranges(Cats(Count)))
            End If
        Next
        Return Ranges
    End Function
End Class
    Structure CharPosInfo
        Public Index As Integer
        Public Length As Integer
        Public Width As Single
        Public PriorWidth As Single
        Public X As Single
        Public Y As Single
        Public Height As Single 'For End of Ayah marker
    End Structure
    Const ERROR_INSUFFICIENT_BUFFER As Integer = 122
    Class TextSource
        Implements SharpDX.DirectWrite.TextAnalysisSource
        Public Sub New(Str As String, Factory As SharpDX.DirectWrite.Factory)
            _Str = Str
            _Factory = Factory
        End Sub
        Dim _Str As String
        Public _Factory As SharpDX.DirectWrite.Factory
        Public Function GetLocaleName(textPosition As Integer, ByRef textLength As Integer) _
        As String Implements SharpDX.DirectWrite.TextAnalysisSource.GetLocaleName
            Return Threading.Thread.CurrentThread.CurrentCulture.Name
        End Function
        Public Function GetNumberSubstitution(textPosition As Integer, ByRef textLength As Integer) _
        As SharpDX.DirectWrite.NumberSubstitution _
        Implements SharpDX.DirectWrite.TextAnalysisSource.GetNumberSubstitution
            Return New SharpDX.DirectWrite.NumberSubstitution_
            (_Factory, SharpDX.DirectWrite.NumberSubstitutionMethod.None, Nothing, True)
        End Function
        Public Function GetTextAtPosition(textPosition As Integer) _
        As String Implements SharpDX.DirectWrite.TextAnalysisSource.GetTextAtPosition
            Return _Str.Substring(textPosition)
        End Function
        Public Function GetTextBeforePosition(textPosition As Integer) _
        As String Implements SharpDX.DirectWrite.TextAnalysisSource.GetTextBeforePosition
            Return _Str.Substring(0, textPosition - 1)
        End Function
        Public ReadOnly Property ReadingDirection As SharpDX.DirectWrite.ReadingDirection _
        Implements SharpDX.DirectWrite.TextAnalysisSource.ReadingDirection
            Get
                Return SharpDX.DirectWrite.ReadingDirection.RightToLeft
            End Get
        End Property
        Public Property Shadow As IDisposable Implements SharpDX.ICallbackable.Shadow
#Region "IDisposable Support"
        Private disposedValue As Boolean ' To detect redundant calls

        ' IDisposable
        Protected Overridable Sub Dispose(disposing As Boolean)
            If Not Me.disposedValue Then
                If disposing Then
                    ' TODO: dispose managed state (managed objects).
                End If

                ' TODO: free unmanaged resources (unmanaged objects) and override Finalize() below.
                ' TODO: set large fields to null.
            End If
            Me.disposedValue = True
        End Sub

        ' TODO: override Finalize() only if Dispose(ByVal disposing As Boolean) 
        ' above has code to free unmanaged resources.
        'Protected Overrides Sub Finalize()
        '    ' Do not change this code.  Put cleanup code in Dispose(ByVal disposing As Boolean) above.
        '    Dispose(False)
        '    MyBase.Finalize()
        'End Sub

        ' This code added by Visual Basic to correctly implement the disposable pattern.
        Public Sub Dispose() Implements IDisposable.Dispose
            ' Do not change this code.  Put cleanup code in Dispose(disposing As Boolean) above.
            Dispose(True)
            GC.SuppressFinalize(Me)
        End Sub
#End Region
    End Class
    Class TextSink
        Implements SharpDX.DirectWrite.TextAnalysisSink
        Public Sub SetBidiLevel(textPosition As Integer, textLength As Integer, _
        explicitLevel As Byte, resolvedLevel As Byte) _
        Implements SharpDX.DirectWrite.TextAnalysisSink.SetBidiLevel
            _explicitLevel = explicitLevel
            _resolvedLevel = resolvedLevel
        End Sub
        Public Sub SetLineBreakpoints(textPosition As Integer, textLength As Integer, _
        lineBreakpoints() As SharpDX.DirectWrite.LineBreakpoint) _
        Implements SharpDX.DirectWrite.TextAnalysisSink.SetLineBreakpoints
            _lineBreakpoints = lineBreakpoints
        End Sub
        Public Sub SetNumberSubstitution(textPosition As Integer, textLength As Integer, _
        numberSubstitution As SharpDX.DirectWrite.NumberSubstitution) _
        Implements SharpDX.DirectWrite.TextAnalysisSink.SetNumberSubstitution
            _numberSubstitution = numberSubstitution
        End Sub
        Public Sub SetScriptAnalysis(textPosition As Integer, textLength As Integer, _
        scriptAnalysis As SharpDX.DirectWrite.ScriptAnalysis) _
        Implements SharpDX.DirectWrite.TextAnalysisSink.SetScriptAnalysis
            _scriptAnalysis = scriptAnalysis
        End Sub
        Public _scriptAnalysis As SharpDX.DirectWrite.ScriptAnalysis
        Public _numberSubstitution As SharpDX.DirectWrite.NumberSubstitution
        Public _lineBreakpoints() As SharpDX.DirectWrite.LineBreakpoint
        Public _explicitLevel As Byte
        Public _resolvedLevel As Byte
        Public Property Shadow As IDisposable Implements SharpDX.ICallbackable.Shadow
#Region "IDisposable Support"
        Private disposedValue As Boolean ' To detect redundant calls

        ' IDisposable
        Protected Overridable Sub Dispose(disposing As Boolean)
            If Not Me.disposedValue Then
                If disposing Then
                    ' TODO: dispose managed state (managed objects).
                End If

                ' TODO: free unmanaged resources (unmanaged objects) and override Finalize() below.
                ' TODO: set large fields to null.
            End If
            Me.disposedValue = True
        End Sub

        ' TODO: override Finalize() only if Dispose(ByVal disposing As Boolean) above has code to free unmanaged resources.
        'Protected Overrides Sub Finalize()
        '    ' Do not change this code.  Put cleanup code in Dispose(ByVal disposing As Boolean) above.
        '    Dispose(False)
        '    MyBase.Finalize()
        'End Sub

        ' This code added by Visual Basic to correctly implement the disposable pattern.
        Public Sub Dispose() Implements IDisposable.Dispose
            ' Do not change this code.  Put cleanup code in Dispose(disposing As Boolean) above.
            Dispose(True)
            GC.SuppressFinalize(Me)
        End Sub
#End Region
    End Class
    Public Shared Function GetWordDiacriticPositionsDWrite(Str As String, useFont As Font, _
    Forms As Char(), IsRTL As Boolean, ByRef BaseLine As Single, ByRef Pos As CharPosInfo()) As SizeF
        If Str = String.Empty Then Return New SizeF(0, 0)
        Dim Factory As New SharpDX.DirectWrite.Factory()
        Dim Analyze As New SharpDX.DirectWrite.TextAnalyzer(Factory)
        Dim Font As SharpDX.DirectWrite.Font = Factory.GdiInterop.FromSystemDrawingFont(useFont)
        Dim FontFace As New SharpDX.DirectWrite.FontFace(Font)
        Dim Analysis As New SharpDX.DirectWrite.ScriptAnalysis
        Dim Sink As New TextSink
        Dim Source As New TextSource(Str, Factory)
        Analyze.AnalyzeScript(Source, 0, Str.Length, Sink)
        Analysis = Sink._scriptAnalysis
        Dim GlyphCount As Integer = Str.Length * 3 \ 2 + 16
        Dim ClusterMap(Str.Length - 1) As Short
        Dim TextProps(Str.Length - 1) As SharpDX.DirectWrite.ShapingTextProperties
        Dim GlyphIndices(GlyphCount - 1) As Short
        Dim GlyphProps(GlyphCount - 1) As SharpDX.DirectWrite.ShapingGlyphProperties
        Dim ActualGlyphCount As Integer = 0
        'OpenType font table 'GSUB' Glyph Substitution Table 
        'contains 'ccmp' Glyph Composition/Decomposition
        ' 'isol' Isolated Forms, 'fina' Terminal Forms, 'medi' 
        'Medial Forms, 'init' Initial Forms
        ' 'rlig' Required Ligatures, 'liga' Standard Ligatures, 'dlig' 
        'Discretionary Ligatures, 'calt' Contextual Alternates
        ' 'ss01' Style Set 1
        'iTextSharp only handles Required Ligatures, could add the others with special routines
        Dim FeatureDisabler() As SharpDX.DirectWrite.FontFeature = {
            New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.GlyphCompositionDecomposition, 1),
            New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.DiscretionaryLigatures, 0),
            New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StandardLigatures, 0),
            New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.ContextualAlternates, 0),
            New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet1, 0)
            }
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.Default, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.ContextualLigatures, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.DiscretionaryLigatures, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StandardLigatures, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.AlternateAnnotationForms, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.ExpertForms, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.TraditionalForms, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.SimplifiedForms, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.HistoricalForms, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.FullWidth, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.HalfWidth, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.ThirdWidths, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.QuarterWidths, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.AlternateHalfWidth, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.ProportionalAlternateWidth, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.ProportionalWidths, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.Ordinals, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticAlternates, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet2, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet3, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet4, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet5, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet6, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet7, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet8, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet9, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet10, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet11, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet12, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet13, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet14, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet15, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet16, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet17, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet18, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet19, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.StylisticSet20, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.Subscript, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.Superscript, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.Swash, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.ContextualSwash, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.MarkPositioning, 0),
        'New SharpDX.DirectWrite.FontFeature(SharpDX.DirectWrite.FontFeatureTag.MarkToMarkPositioning, 0)}
        Do
            Try
                Analyze.GetGlyphs(Str, Str.Length, FontFace, False, IsRTL, Analysis, Nothing, Nothing, _
                New SharpDX.DirectWrite.FontFeature()() {FeatureDisabler}, New Integer() _
                {Str.Length}, GlyphCount, ClusterMap, TextProps, GlyphIndices, GlyphProps, ActualGlyphCount)
                Exit Do
            Catch ex As SharpDX.SharpDXException
                If ex.ResultCode = SharpDX.Result.GetResultFromWin32Error(ERROR_INSUFFICIENT_BUFFER) Then
                    GlyphCount *= 2
                    ReDim GlyphIndices(GlyphCount - 1)
                    ReDim GlyphProps(GlyphCount - 1)
                End If
            End Try
        Loop While True
        ReDim Preserve GlyphIndices(ActualGlyphCount - 1)
        ReDim Preserve GlyphProps(ActualGlyphCount - 1)
        Dim GlyphAdvances(ActualGlyphCount - 1) As Single
        Dim GlyphOffsets(ActualGlyphCount - 1) As SharpDX.DirectWrite.GlyphOffset
        Analyze.GetGlyphPlacements(Str, ClusterMap, TextProps, Str.Length, GlyphIndices, _
        GlyphProps, ActualGlyphCount, FontFace, useFont.Size, False, IsRTL, Analysis, Nothing, _
        New SharpDX.DirectWrite.FontFeature()() {FeatureDisabler}, New Integer() _
        {Str.Length}, GlyphAdvances, GlyphOffsets)
        Dim CharPosInfos As New List(Of CharPosInfo)
        Dim LastPriorWidth As Single = 0
        Dim PriorWidth As Single = 0
        Dim RunStart As Integer = 0
        Dim RunRes As Integer = ClusterMap(0)
        'Dim Forms As Char() = ArabicData.GetPresentationForms()
        'Dim SupportedGlyphs As Short() = FontFace.GetGlyphIndices_
        (Array.ConvertAll(Forms, Function(Ch As Char) AscW(Ch)))
        'For Count = 0 To SupportedGlyphs.Length - 1
        '    If SupportedGlyphs(Count) = 0 Then Forms(Count) = ChrW(0)
        'Next
        If IsRTL And Not Pos Is Nothing Then
            Dim LigArray() As ArabicData.LigatureInfo = ArabicData.GetLigatures(Str, False, Forms)
            For CharCount = 0 To ClusterMap.Length - 1
                Dim RunCount As Integer = 0
                For ResCount As Integer = ClusterMap(CharCount) To If(CharCount = _
                ClusterMap.Length - 1, ActualGlyphCount - 1, ClusterMap(CharCount + 1) - 1)
                    'GlyphProps(ResCount).IsDiacritic Or GlyphProps(ResCount).IsZeroWidthSpace
                    If GlyphAdvances(ResCount) = 0 And (ClusterMap.Length <= RunStart + _
                    RunCount OrElse ClusterMap(RunStart) = ClusterMap(RunStart + RunCount)) Then
                        Dim Index As Integer = Array.FindIndex(LigArray, Function(Lig As _
                        ArabicData.LigatureInfo) Lig.Indexes(0) = RunStart + RunCount)
                        Dim LigLen As Integer = 1
                        If Index <> -1 Then
                            While LigLen <> LigArray(Index).Indexes.Length _
                            AndAlso LigArray(Index).Indexes(LigLen - 1) + 1 = LigArray(Index).Indexes(LigLen)
                                LigLen += 1
                            End While
                            If LigLen <> 1 Then
                                'the case of multiple ligaturized diacritics in a row needs to be studied
                                Dim CheckGlyphCount As Integer = 0
                                Dim CheckClusterMap(RunCount + LigLen - 1) As Short
                                Dim CheckTextProps(RunCount + LigLen - 1) As SharpDX.DirectWrite.ShapingTextProperties
                                Dim CheckGlyphIndices(GlyphCount - 1) As Short
                                Dim CheckGlyphProps(GlyphCount - 1) As SharpDX.DirectWrite.ShapingGlyphProperties
                                Analyze.GetGlyphs(Str.Substring(RunStart, RunCount + LigLen), RunCount + LigLen, _
                                FontFace, False, IsRTL, Analysis, Nothing, Nothing, _
                                New SharpDX.DirectWrite.FontFeature()() {FeatureDisabler}, New Integer() _
                                {RunCount + LigLen}, GlyphCount, CheckClusterMap, CheckTextProps, _
                                CheckGlyphIndices, CheckGlyphProps, CheckGlyphCount)
                                If CheckGlyphCount <> LigLen And CheckGlyphCount <> _
                                LigLen - If(GlyphProps(RunRes).Justification <> _
                                SharpDX.DirectWrite.ScriptJustify.Blank And GlyphProps(RunRes).Justification <> _
                                SharpDX.DirectWrite.ScriptJustify.ArabicBlank, 0, 1) _
                                Then LigLen = 1 'if ligature not being composed
                            End If
                        End If
                        If Not GlyphProps(ResCount).IsDiacritic Or Not GlyphProps(ResCount).IsZeroWidthSpace _
                        Or Not GlyphProps(ResCount).IsClusterStart Then
                            'a bounding box to bounding box transformation should be done 
                            'generally here to handle all special cases
                            If LigLen = 1 AndAlso System.Text.RegularExpressions.Regex.Match_
                            (Str(RunStart + RunCount), "[\p{IsArabic}\p{IsArabicPresentationForms-A}\p_
                            {IsArabicPresentationForms-B}]").Success And Char.GetUnicodeCategory_
                            (Str(RunStart + RunCount)) = Globalization.UnicodeCategory.DecimalDigitNumber Then
                                Dim _Mets As SharpDX.DirectWrite.GlyphMetrics() = _
                                FontFace.GetDesignGlyphMetrics(GlyphIndices, False)
                                CharPosInfos.Add(New CharPosInfo With {.Index = RunStart + _
                                RunCount, .Length = If(Index = -1, 1, LigLen), .PriorWidth = PriorWidth, _
                                .Width = 2 * CSng((_Mets(ResCount).AdvanceWidth) * useFont.SizeInPoints / _
                                FontFace.Metrics.DesignUnitsPerEm), .X = GlyphOffsets(ResCount).AdvanceOffset - _
                                GlyphAdvances(RunRes) - CSng((_Mets(ResCount).AdvanceWidth) * useFont.SizeInPoints / _
                                FontFace.Metrics.DesignUnitsPerEm) / 4, .Y = GlyphOffsets(ResCount).AscenderOffset, _
                                .Height = CSng((_Mets(ResCount).AdvanceHeight + _Mets(ResCount)._
                                BottomSideBearing - _Mets(ResCount).TopSideBearing) * useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm)})
                            Else
                                Dim _Mets As SharpDX.DirectWrite.GlyphMetrics() = FontFace.GetDesignGlyphMetrics(GlyphIndices, False)
                                'Madda on small waw and Madda, Fatha, Kasra or Shadda-Kasra on small yeh
                                CharPosInfos.Add(New CharPosInfo With {.Index = RunStart + RunCount, .Length = _
                                If(Index = -1, 1, LigLen), .PriorWidth = PriorWidth - _
                                If(GlyphProps(RunRes).Justification = SharpDX.DirectWrite.ScriptJustify._
                                ArabicKashida And RunCount = 1 And If(CharCount = ClusterMap.Length - 1, _
                                ActualGlyphCount, ClusterMap(CharCount + 1)) - ClusterMap(CharCount) = _
                                CharCount - RunStart, GlyphAdvances(RunRes), 0), .Width = GlyphAdvances(RunRes) + _
                                If(GlyphProps(RunRes).IsClusterStart And GlyphProps(RunRes).IsDiacritic, _
                                CSng((_Mets(RunRes).AdvanceWidth) * useFont.SizeInPoints / _
                                FontFace.Metrics.DesignUnitsPerEm), 0), .X = GlyphOffsets(ResCount).AdvanceOffset, _
                                .Y = GlyphOffsets(ResCount).AscenderOffset + If(GlyphProps(RunRes).IsClusterStart _
                                And GlyphProps(RunRes).IsDiacritic, CSng((_Mets(RunRes).AdvanceHeight - _Mets_
                                (RunRes).TopSideBearing - _Mets(RunRes).VerticalOriginY) * useFont.SizeInPoints / _
                                FontFace.Metrics.DesignUnitsPerEm), 0)})
                                If GlyphProps(RunRes).Justification = SharpDX.DirectWrite.ScriptJustify.ArabicKashida _
                                And RunCount = 1 And If(CharCount = ClusterMap.Length - 1, ActualGlyphCount, _
                                ClusterMap(CharCount + 1)) - ClusterMap(CharCount) = CharCount - RunStart Then
                                    CharPosInfos.Add(New CharPosInfo With {.Index = RunStart + RunCount + 1, _
                                    .Length = If(Index = -1, 1, LigLen), .PriorWidth = PriorWidth, .Width = _
                                    GlyphAdvances(RunRes) + If(GlyphProps(RunRes).IsClusterStart And _
                                    GlyphProps(RunRes).IsDiacritic, CSng((_Mets(RunRes).AdvanceWidth) * _
                                    useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm), 0), .X = _
                                    GlyphOffsets(ResCount).AdvanceOffset, .Y = GlyphOffsets(RunRes).AscenderOffset + _
                                    If(GlyphProps(RunRes).IsClusterStart And GlyphProps(RunRes).IsDiacritic, _
                                    CSng((_Mets(RunRes).AdvanceHeight - _Mets(RunRes).TopSideBearing - _Mets_
                                    (RunRes).VerticalOriginY) * useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm), 0)})
                                End If
                            End If
                        Else
                            PriorWidth -= GlyphOffsets(ResCount).AdvanceOffset
                        End If
                    End If
                    If CharCount = ClusterMap.Length - 1 OrElse ClusterMap(CharCount) <> ClusterMap(CharCount + 1) Then
                        PriorWidth += GlyphAdvances(ResCount)
                        Dim Index As Integer = Array.FindIndex(LigArray, _
                        Function(Lig As ArabicData.LigatureInfo) Lig.Indexes(0) = RunStart)
                        If Index = -1 OrElse (GlyphProps(ResCount).Justification <> _
                        SharpDX.DirectWrite.ScriptJustify.Blank And GlyphProps(ResCount).Justification _
                        <> SharpDX.DirectWrite.ScriptJustify.ArabicBlank Or Array.IndexOf_
                        (LigArray(Index).Indexes, RunStart) = -1) And RunStart + RunCount <> _
                        Str.Length - 1 Then RunCount += 1
                        If Index <> -1 AndAlso (GlyphProps(ResCount).Justification <> _
                        SharpDX.DirectWrite.ScriptJustify.Blank And GlyphProps(ResCount).Justification <> _
                        SharpDX.DirectWrite.ScriptJustify.ArabicBlank Or _
                        Array.IndexOf(LigArray(Index).Indexes, RunStart) = -1) Then
                            While Array.IndexOf(LigArray(Index).Indexes, RunStart + RunCount) <> -1 _
                            And RunStart + RunCount <> Str.Length - 1
                                RunCount += 1
                            End While
                        End If
                        If ClusterMap(CharCount) <> ResCount And GlyphAdvances(ResCount) <> 0 Then
                            RunStart = CharCount
                            RunCount = 0
                            RunRes = ResCount
                        End If
                    End If
                Next
                If CharCount <> ClusterMap.Length - 1 AndAlso ClusterMap(CharCount) <> ClusterMap(CharCount + 1) Then
                    RunStart = CharCount + 1
                    If GlyphAdvances(ClusterMap(CharCount + 1)) <> 0 Or GlyphProps(ClusterMap_
                    (CharCount + 1)).IsClusterStart And GlyphProps(ClusterMap(CharCount + 1)).IsDiacritic _
                    Then RunRes = ClusterMap(CharCount + 1)
                End If
            Next
        End If
        'FontFace.GetGlyphRunOutline(useFont.SizeInPoints, GlyphIndices, _
		GlyphAdvances, GlyphOffsets, False, IsRTL, GeoSink)
        Dim Width As Single = 0 'Origin must be computed unlike the vertical one which is provided
        Dim Top As Single = 0
        Dim Bottom As Single = 0
        Dim Mets As SharpDX.DirectWrite.GlyphMetrics() = FontFace.GetDesignGlyphMetrics_
		(GlyphIndices, False)
        Dim Left As Single = If(IsRTL, 0, GlyphOffsets(0).AdvanceOffset - _
        CSng(Mets(0).LeftSideBearing * useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm))
        Dim Right As Single = If(IsRTL, GlyphOffsets(0).AdvanceOffset - _
        CSng(Mets(0).RightSideBearing * useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm), 0)
        For Count = 0 To Mets.Length - 1
            Left = If(IsRTL, Math.Max(Left, GlyphOffsets(Count).AdvanceOffset + Width - _
            CSng(Math.Max(0, Mets(Count).LeftSideBearing) * useFont.SizeInPoints / _
            FontFace.Metrics.DesignUnitsPerEm)), Math.Min(Left, GlyphOffsets(Count).AdvanceOffset + _
            Width - CSng(Mets(Count).LeftSideBearing * useFont.SizeInPoints / _
		FontFace.Metrics.DesignUnitsPerEm)))
            'must override combining character advance
            If GlyphAdvances(Count) <> 0 Then Width += If(IsRTL, -1, 1) * _
            CSng(Mets(Count).AdvanceWidth * useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm)
            Right = If(IsRTL, Math.Min(Right, GlyphOffsets(Count).AdvanceOffset + Width - _
            CSng(Mets(Count).RightSideBearing * useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm)), _
            Math.Max(Right, GlyphOffsets(Count).AdvanceOffset + Width - CSng(Math.Min(0, _
            Mets(Count).RightSideBearing) * useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm)))
            Top = Math.Max(Top, GlyphOffsets(Count).AscenderOffset + CSng((Mets(Count).VerticalOriginY - _
            Mets(Count).TopSideBearing) * useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm))
            Bottom = Math.Min(Bottom, GlyphOffsets(Count).AscenderOffset + CSng((Mets(Count).VerticalOriginY - _
            Mets(Count).AdvanceHeight + Mets(Count).BottomSideBearing) * useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm))
        Next
        If Not Pos Is Nothing Then Pos = CharPosInfos.ToArray()
        Dim Size As SizeF = New SizeF(If(IsRTL, Left - Right, Right - Left), Top - Bottom + _
        CSng(FontFace.Metrics.LineGap * useFont.SizeInPoints / FontFace.Metrics.DesignUnitsPerEm))
        BaseLine = Top
        Source.Shadow.Dispose()
        Sink.Shadow.Dispose()
        Source.Dispose()
        Source._Factory = Nothing
        Sink.Dispose()
        FontFace.Dispose()
        Font.Dispose()
        Analyze.Dispose()
        Factory.Dispose()
        Return Size
    End Function
    Public Shared Function FitText(Text As String, MaxWidth As Single, MaxSize As Single, _
    IsRTL As Boolean, DrawFont As Font, Forms As Char()) As Single
        Dim MinSize As Single = 0
        Dim Size As SizeF = GetWordDiacriticPositionsDWrite(Text, DrawFont, Forms, IsRTL, Nothing, Nothing)
        If Size.Width < MaxWidth Then Return DrawFont.SizeInPoints
        For Count = 0 To 50
            DrawFont = New Font(DrawFont.FontFamily, (MinSize + MaxSize) / 2, DrawFont.Style)
            Size = GetWordDiacriticPositionsDWrite(Text, DrawFont, Forms, IsRTL, Nothing, Nothing)
            If Size.Width < MaxWidth Then
                MinSize = DrawFont.SizeInPoints
                DrawFont.Dispose()
                If MaxSize - MinSize < DrawFont.SizeInPoints * 0.1F Then Exit For
            Else
                MaxSize = DrawFont.SizeInPoints
                DrawFont.Dispose()
            End If
        Next
        Return MinSize
    End Function
    Public Shared Function WriteArabicPdfDiacritics(Doc As iTextSharp.text.Document, _
    Writer As iTextSharp.text.pdf.PdfWriter, DrawFont As Font, FixedFont As iTextSharp.text.Font, _
    Text As String, Rect As RectangleF, Baseline As Single, FirstAdj As Boolean, Forms As Char(), _
    FontFace As SharpDX.DirectWrite.FontFace) As String
        Dim ct As iTextSharp.text.pdf.ColumnText
        Dim CharPosInfos() As CharPosInfo = {}
        Dim useFont As New Font(DrawFont.FontFamily, FixedFont.Size, DrawFont.Style)
        GetWordDiacriticPositionsDWrite(Text, useFont, Forms, True, Nothing, CharPosInfos)
        For Index As Integer = 0 To CharPosInfos.Length - 1
            ct = New iTextSharp.text.pdf.ColumnText(Writer.DirectContent)
            ct.RunDirection = iTextSharp.text.pdf.PdfWriter.RUN_DIRECTION_RTL
            ct.ArabicOptions = iTextSharp.text.pdf.ColumnText.AR_COMPOSEDTASHKEEL
            ct.UseAscender = False
            If GetWordDiacriticPositionsDWrite(ArabicData.ConvertLigatures(Text.Substring_
            (CharPosInfos(Index).Index, CharPosInfos(Index).Length), False, Forms)(0), _
            useFont, Forms, True, Nothing, Nothing).Width <> 0 Then
                ct.SetSimpleColumn(Rect.Left + Doc.LeftMargin + Rect.Width - 4 + 2 - _
                CharPosInfos(Index).PriorWidth - CharPosInfos(Index).Width - CharPosInfos(Index).X, _
                Doc.PageSize.Height - Doc.TopMargin - Rect.Bottom - Baseline + CharPosInfos(Index).Y - _
                If(FirstAdj, 2, 0), Rect.Right - 2 + Doc.LeftMargin - CharPosInfos(Index).PriorWidth - _
                CharPosInfos(Index).X, Doc.PageSize.Height - Doc.TopMargin - Rect.Top + 1 - Baseline + _
                CharPosInfos(Index).Y - If(FirstAdj, 2, 0), CSng(FontFace.Metrics.LineGap * _
                FixedFont.Size / FontFace.Metrics.DesignUnitsPerEm), _
                iTextSharp.text.Element.ALIGN_RIGHT Or iTextSharp.text.Element.ALIGN_BASELINE)
                If CharPosInfos(Index).Length = 1 AndAlso System.Text.RegularExpressions.Regex.Match_
                (Text(CharPosInfos(Index).Index), "[\p{IsArabic}\p{IsArabicPresentationForms-A}\p_
                {IsArabicPresentationForms-B}]").Success And Char.GetUnicodeCategory(Text_
                (CharPosInfos(Index).Index)) = Globalization.UnicodeCategory.DecimalDigitNumber Then
                    'using scaling to emulate the glyph substitutions on end of ayah marker combinations
                    Dim NewFont As New iTextSharp.text.Font(FixedFont)
                    NewFont.Size = NewFont.Size * GetWordDiacriticPositionsDWrite(ArabicData.ConvertLigatures_
                    (Text.Substring(CharPosInfos(Index).Index, CharPosInfos(Index).Length), False, Forms)(0), _
                    useFont, Forms, True, Nothing, Nothing).Height / CharPosInfos(Index).Height
                    Dim Chunk As New iTextSharp.text.Chunk(Text.Substring(CharPosInfos(Index).Index, _
                    CharPosInfos(Index).Length), NewFont)
                    Dim useNewFont As New Font(DrawFont.FontFamily, NewFont.Size, DrawFont.Style)
                    Chunk.SetHorizontalScaling(CharPosInfos(Index).Width / GetWordDiacriticPositionsDWrite_
                    (ArabicData.ConvertLigatures(Text.Substring(CharPosInfos(Index).Index, _
                    CharPosInfos(Index).Length), False, Forms)(0), useNewFont, Forms, True, Nothing, Nothing).Width)
                    useNewFont.Dispose()
                    ct.AddText(Chunk)
                Else
                    If Text(CharPosInfos(Index).Index) = " "c Then
                        ct.AddText(New iTextSharp.text.Chunk(Text.Substring(CharPosInfos_
                        (Index).Index + 1, CharPosInfos(Index).Length - 1), FixedFont))
                    Else
                        ct.AddText(New iTextSharp.text.Chunk(Text.Substring(CharPosInfos_
                        (Index).Index, CharPosInfos(Index).Length), FixedFont))
                    End If
                End If
                ct.Go()
            End If
        Next
        useFont.Dispose()
        For Index As Integer = CharPosInfos.Length - 1 To 0 Step -1
            If Text(CharPosInfos(Index).Index) = " "c Then
                Text = Text.Remove(CharPosInfos(Index).Index + 1, CharPosInfos(Index).Length - 1)
            Else
                Text = Text.Remove(CharPosInfos(Index).Index, CharPosInfos(Index).Length)
            End If
        Next
        Return Text
    End Function
    Public Shared Function AddDiacriticSpacing(Str As String, Forms As Char()) As String
        Return System.Text.RegularExpressions.Regex.Replace(Str, "(^|\s)([\p{IsArabic}|\_
        p{IsArabicPresentationForms-A}|\p{IsArabicPresentationForms-B}]+)", _
        Function(Match As System.Text.RegularExpressions.Match) Match.Groups(1).Value + _
        If(ArabicData.FindLetterBySymbol(Match.Groups(2).Value(0)) <> -1 _
        AndAlso ArabicData.ArabicLetters(ArabicData.FindLetterBySymbol_
	(Match.Groups(2).Value(0))).JoiningStyle = _
        "T" AndAlso Char.GetUnicodeCategory(Match.Groups(2).Value(0)) <> _
        Globalization.UnicodeCategory.Format And (Match.Groups(1).Value.Length = 0 OrElse _
        ArabicData.GetLigatures(" " + Match.Groups(2).Value, False, Forms).Length <> 0 _
        AndAlso ArabicData.GetLigatures(" " + Match.Groups(2).Value, False, _
        Forms)(0).Indexes(0) = 0), " ", String.Empty) + Match.Groups(2).Value)
    End Function
    Private Shared Function GetTextWidthDraw(DrawFont As Font, Forms As Char(), Str As String, _
    FontName As String, MaxWidth As Single, IsRTL As Boolean, ByRef s As SizeF, _
	ByRef Baseline As Single) As Integer
        If FontName <> String.Empty Then
            Dim PrivateFontColl As New Drawing.Text.PrivateFontCollection
            PrivateFontColl.AddFontFile(Utility.GetFilePath("files\" + _
            Utility.FontFile(Array.IndexOf(Utility.FontList, FontName))))
            Dim PrivFont As New Font(PrivateFontColl.Families(0), 100)
            s = Utility.GetTextExtent(Str, PrivFont)
            s.Width = CInt(Math.Ceiling(Math.Ceiling(s.Width + 1) * 96.0F / 72.0F))
            s.Height = CInt(Math.Ceiling(Math.Ceiling(s.Height + 1) * 96.0F / 72.0F))
            Baseline = 0
            PrivFont.Dispose()
            PrivateFontColl.Dispose()
            Return Str.Length
        End If
        s = GetWordDiacriticPositionsDWrite(AddDiacriticSpacing(Str, Forms), DrawFont, Forms, IsRTL, Baseline, Nothing)
        Dim Len As Integer = Str.Length
        Dim Search As Integer = Len
        'binary search the maximum characters
        If s.Width > MaxWidth Then
            While Search <> 1
                Search = Search \ 2
                If s.Width > MaxWidth Then
                    Len -= Search
                Else
                    Len += Search
                End If
                'cannot split arabic words except on word boundaries without thinking 
                'about shaping issues
                s = GetWordDiacriticPositionsDWrite(AddDiacriticSpacing(Str.Substring(0, _
                If(Str.IndexOf(" "c, Len - 1) = -1, Str.Length, Str.IndexOf(" "c, Len - 1) + 1)), _
                Forms), DrawFont, Forms, IsRTL, Baseline, Nothing)
            End While
            Len = If(Str.IndexOf(" "c, Len - 1) = -1, Str.Length, Str.IndexOf(" "c, Len - 1) + 1)
            If s.Width > MaxWidth Then
                Len = Str.LastIndexOf(" "c, Len - 1 - 1) + 1 'factor towards fitting not overflowing
                s = GetWordDiacriticPositionsDWrite(AddDiacriticSpacing(Str.Substring(0, Len), Forms), _
                DrawFont, Forms, IsRTL, Baseline, Nothing)
            End If
            If Len = 0 Then
                'non-Arabic scripts like Latin can be hyphenated here instead
                Len = If(Str.IndexOf(" ") <> -1, Str.IndexOf(" ") + 1, Str.Length)
                s.Width = MaxWidth
                DrawFont = New Font(DrawFont.FontFamily, FitText(AddDiacriticSpacing(Str.Substring(0, Len), _
                Forms), s.Width, DrawFont.SizeInPoints, IsRTL, DrawFont, Forms), DrawFont.Style)
                s = GetWordDiacriticPositionsDWrite(AddDiacriticSpacing(Str.Substring(0, Len), Forms), _
                DrawFont, Forms, IsRTL, Baseline, Nothing)
                DrawFont.Dispose()
                s.Width = MaxWidth
            End If
        End If
        Return Len
    End Function

Points of Interest

Limitations in this involve ligatures. Some special substitution ligatures revolving around the Arabic Small Waw and Arabic Small Yeh with a Maddah Above have a special glyph substitution. The name of Allah also has a special glyph substitution and though there is an Arabic presentation range accessible ligature which could be swapped out, it is difficult to align the diacritics onto it and it would break copying and pasting into the correct Arabic character range. These issues are handled through using the glyphs that are there with the best alignment possible.

The end of ayah marker is a special case where aligning the numbers inside of it requires special consideration and handling.

History

  • Initial version

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Software Developer (Senior)
United States United States
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions

 
Questioncan you give a demo? Pin
mouse71126-Mar-15 17:40
mouse71126-Mar-15 17:40 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.