Using Uniscribe from VB.NET

Introduction

Uniscribe provides powerful Unicode scripting capabilities which give access to information beyond what is found in GDI. The modern and more powerful DirectWrite is now replacing and providing even greater capability to obtain more accurate date in floating point format as opposed to dialog unit integers. This same functionality is also found in Microsoft's XPS writer library, and the WPF platform all of which are recent technologies. If one requires data that is not in dialog units, then DirectWrite or writing your own font rendering engine become the only real options and given the difficult of rendering complex scripts, it becomes a major project such that even finding a 3^rd party library to do it would be more beneficial.

Background

Familiarity with Unicode, Uniscribe, GDI and VB.NET as well as Windows API marshalling is needed to understand this topic. Uniscribe has been available since Internet Explorer 5 and Windows 2000 and thus is well established and supported, and moreso than any other technology to accomplish this task most of which are supported in Vista or later.

Using the Code

The code here is an example that will look for combining symbols or diacritical characters or zero width characters and pull out any special vertical or horizontal offset alignment. The marshalling attributes handles most of the situations though the flags values are bitfields in C++ and must be either made constants or computed and accessed through property accessors of the flag integers. Some return values are not checked so the code should be hardened before being put into production.

<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> _
Public Structure GCP_RESULTS
Public StructSize As UInteger
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.LPTStr)> _
Public OutString As String
Public Order As IntPtr
Public Dx As IntPtr
Public CaretPos As IntPtr
Public [Class] As IntPtr
Public Glyphs As IntPtr
Public GlyphCount As UInteger
Public MaxFit As Integer
End Structure
<Runtime.InteropServices.DllImport_
("gdi32.dll", EntryPoint:="GetCharacterPlacement", _
SetLastError:=True, CharSet:=Runtime.InteropServices.CharSet.Auto)> _
Public Shared Function GetCharacterPlacement(hdc As IntPtr, _
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.LPTStr)> _
lpString As String, nCount As Integer, nMaxExtent As Integer, <Runtime.InteropServices.In(), _
Runtime.InteropServices.Out()> ByRef lpResults As GCP_RESULTS, dwFlags As UInteger) As UInteger
End Function
<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> _
Public Structure SCRIPT_CONTROL
Public ScriptControlFlags As UInteger
End Structure
<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> _
Public Structure SCRIPT_STATE
Public ScriptStateFlags As UShort
End Structure
<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> _
Public Structure SCRIPT_ANALYSIS
Public ScriptAnalysisFlags As UShort
Public s As SCRIPT_STATE
End Structure
<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> _
Public Structure SCRIPT_VISATTR
Public ScriptVisAttrFlags As UShort
End Structure
<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> _
Public Structure SCRIPT_ITEM
Public iCharPos As Integer
Public a As SCRIPT_ANALYSIS
End Structure
<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> _
Public Structure GOFFSET
Public du As Integer
Public dv As Integer
End Structure
<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> _
Public Structure ABC
Public abcA As Integer
Public abcB As UInteger
Public abcC As Integer
End Structure
Public Const E_OUTOFMEMORY As Integer = &H8007000E
Public Const E_PENDING As Integer = &H8000000A
Public Const USP_E_SCRIPT_NOT_IN_FONT As Integer = &H80040200
<Runtime.InteropServices.DllImport_
("Usp10.dll", EntryPoint:="ScriptItemize")> _
Public Shared Function ScriptItemize(<Runtime.InteropServices.MarshalAs_
(Runtime.InteropServices.UnmanagedType.LPWStr)> wcInChars As String, _
cInChars As Integer, cMaxItems As Integer, psControl As SCRIPT_CONTROL, _
psState As SCRIPT_STATE, <Runtime.InteropServices.MarshalAs_
(Runtime.InteropServices.UnmanagedType.LPArray, SizeParamIndex:=2), _
Runtime.InteropServices.Out()> pItems() As SCRIPT_ITEM, _
<Runtime.InteropServices.Out()> ByRef pcItems As Integer) As Integer
End Function
<Runtime.InteropServices.DllImport_
("Usp10.dll", EntryPoint:="ScriptShape")> _
Public Shared Function ScriptShape(hdc As IntPtr, ByRef psc As IntPtr, _
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.LPWStr)> _
wcChars As String, cChars As Integer, cMaxGlyphs As Integer, ByRef psa As SCRIPT_ANALYSIS, _
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.LPArray, _
SizeParamIndex:=4), Runtime.InteropServices.Out()> wOutGlyphs() As UShort, _
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.LPArray, _
SizeParamIndex:=3), Runtime.InteropServices.Out()> wLogClust() As UShort, _
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.LPArray, _
SizeParamIndex:=4), Runtime.InteropServices.Out()> psva() As SCRIPT_VISATTR, _
<Runtime.InteropServices.Out()> ByRef cGlyphs As Integer) As Integer
End Function
<Runtime.InteropServices.DllImport_
("Usp10.dll", EntryPoint:="ScriptPlace")> _
Public Shared Function ScriptPlace(hdc As IntPtr, ByRef psc As IntPtr, _
wGlyphs() As UShort, cGlyphs As Integer, psva() As SCRIPT_VISATTR, _
ByRef psa As SCRIPT_ANALYSIS, <Runtime.InteropServices.MarshalAs_
(Runtime.InteropServices.UnmanagedType.LPArray, SizeParamIndex:=3), _
Runtime.InteropServices.Out()> iAdvance() As Integer, _
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.LPArray, _
SizeParamIndex:=3), Runtime.InteropServices.Out()> pGoffset() As GOFFSET, _
<Runtime.InteropServices.Out()> ByRef pABC As ABC) As Integer
End Function
<Runtime.InteropServices.DllImport("Usp10.dll", EntryPoint:="ScriptFreeCache")> _
Public Shared Function ScriptFreeCache(ByRef psc As IntPtr) As Integer
End Function
<Runtime.InteropServices.DllImport("User32.dll", EntryPoint:="GetDC")> _
Public Shared Function GetDC(hWnd As IntPtr) As IntPtr
End Function
<Runtime.InteropServices.DllImport("User32.dll", EntryPoint:="ReleaseDC")> _
Public Shared Function ReleaseDC(hWnd As IntPtr, hdc As IntPtr) As Integer
End Function
<Runtime.InteropServices.DllImport("gdi32.dll", EntryPoint:="SelectObject")> _
Public Shared Function SelectObject(ByVal hdc As IntPtr, ByVal hObject As IntPtr) As IntPtr
End Function
<Runtime.InteropServices.DllImport("gdi32.dll", EntryPoint:="SetMapMode")> _
Public Shared Function SetMapMode(hdc As IntPtr, fnMapMode As Integer) As Integer
End Function
Const MM_TEXT As Integer = 5
Structure CharPosInfo
Public Index As Integer
Public Width As Integer
Public PriorWidth As Integer
Public X As Integer
Public Y As Integer
End Structure
Public Shared Function GetWordDiacriticPositions(Str As String, useFont As Font) As CharPosInfo()
Dim hdc As IntPtr
Dim CharPosInfos As New List(Of CharPosInfo)
hdc = GetDC(IntPtr.Zero) 'desktop device context
Dim oldMapMode As Integer = SetMapMode(hdc, MM_TEXT)
Dim oldFont As IntPtr = SelectObject(hdc, useFont.ToHfont())
Dim MaxItems As Integer = 16
Dim Control As New SCRIPT_CONTROL With {.ScriptControlFlags = 0}
Dim State As New SCRIPT_STATE With {.ScriptStateFlags = 1} '0 LTR, 1 RTL
Dim Items() As SCRIPT_ITEM = Nothing
Dim ItemCount As Integer
Dim Result As Integer
Do
ReDim Items(MaxItems - 1)
Result = ScriptItemize(Str, Str.Length, MaxItems, Control, State, Items, ItemCount)
If Result = 0 Then
ReDim Preserve Items(ItemCount) 'there is a dummy last item so adding one here
Exit Do
ElseIf Result = E_OUTOFMEMORY Then
End If
MaxItems *= 2
Loop While True
If Result = 0 Then
'last item is dummy item pointing to end of string
Dim Cache As IntPtr = IntPtr.Zero
For Count = 0 To ItemCount - 2
Dim Logs() As UShort = Nothing
Dim Glyphs() As UShort = Nothing
Dim VisAttrs() As SCRIPT_VISATTR = Nothing
ReDim Glyphs((Items(Count + 1).iCharPos - Items(Count).iCharPos) * 3 \ 2 + 16 - 1)
ReDim VisAttrs((Items(Count + 1).iCharPos - Items(Count).iCharPos) * 3 \ 2 + 16 - 1)
ReDim Logs(Items(Count + 1).iCharPos - Items(Count).iCharPos - 1)
Dim dc As IntPtr = IntPtr.Zero
Do
Dim GlyphsUsed As Integer
Result = ScriptShape(dc, Cache, Str.Substring(Items(Count).iCharPos), _
    Items(Count + 1).iCharPos - Items(Count).iCharPos, Glyphs.Length, _
    Items(Count).a, Glyphs, Logs, VisAttrs, GlyphsUsed)
If Result = 0 Then
ReDim Preserve Glyphs(GlyphsUsed - 1)
ReDim Preserve VisAttrs(GlyphsUsed - 1)
Exit Do
ElseIf Result = E_PENDING Then
dc = hdc
ElseIf Result = E_OUTOFMEMORY Then
ReDim Glyphs(Glyphs.Length * 2 - 1)
ReDim VisAttrs(VisAttrs.Length * 2 - 1)
ElseIf Result = USP_E_SCRIPT_NOT_IN_FONT Then
Else
End If
Loop While True
If Result = 0 Then
Dim Advances(Glyphs.Length - 1) As Integer
Dim Offsets(Glyphs.Length - 1) As GOFFSET
Dim abc As New ABC With {.abcA = 0, .abcB = 0, .abcC = 0}
dc = IntPtr.Zero
Do
Result = ScriptPlace(dc, Cache, Glyphs, Glyphs.Length, _
    VisAttrs, Items(Count).a, Advances, Offsets, abc)
If Result <> E_PENDING Then Exit Do
dc = hdc
Loop While True
If Result = 0 Then
Dim LastPriorWidth As Integer = 0
Dim RunStart As Integer = 0
For CharCount = 0 To Logs.Length - 1
Dim PriorWidth As Integer = 0
Dim RunCount As Integer = 0
For ResCount As Integer = Logs(CharCount) To _
    If(CharCount = Logs.Length - 1, 0, Logs(CharCount + 1)) Step -1
'fDiacritic or fZeroWidth
If (VisAttrs(ResCount).ScriptVisAttrFlags And (32 Or 64)) <> 0 Then
CharPosInfos.Add(New CharPosInfo With {.Index = RunStart + RunCount, _
    .PriorWidth = LastPriorWidth, .Width = Advances(Logs(RunStart)), _
    .X = Offsets(ResCount).du, .Y = Offsets(ResCount).dv})
End If
If CharCount = Logs.Length - 1 OrElse Logs(CharCount) <> Logs(CharCount + 1) Then
PriorWidth += Advances(ResCount)
RunCount += 1
End If
Next
LastPriorWidth += PriorWidth
If CharCount = Logs.Length - 1 OrElse Logs(CharCount) <> Logs(CharCount + 1) Then
RunStart = CharCount + 1
End If
Next
End If
End If
Next
ScriptFreeCache(Cache)
End If
SetMapMode(hdc, oldMapMode)
SelectObject(hdc, oldFont)
ReleaseDC(IntPtr.Zero, hdc)
Return CharPosInfos.ToArray()
End Function

ScriptItemize is called in a loop as the number of items involving different scripts will be dynamically determined. ScriptShape is also called in a loop as the number of glyphs though intelligently guess-timated could be too small in some cases of ligaturizing. Empty device contexts are tried before using a desktop device context to make the calls as it is faster. There is a wealth of data that can be extracted using these APIs about the shaping and word boundaries if one is interested in it.

Points of Interest

Although the loops to allow for resizing of the arrays add some complexity, the task is not overly challenging and one should not give up and turn to C++ immediately given that it is relatively simple to get Uniscribe to work in VB.NET and the structures and arrays used are simple enough to be marshalled without any special code.

History

• Initial version