Just Breathe Bold ObliqueSeven (TrueType)

Just Breathe Bold ObliqueSeven (OpenType)

Just Breathe Bold ObliqueSeven (OpenType)

Just Breathe Bold ObliqueSeven

JustBreatheBdObl7

Just Breathe BdObl7

Dim fontUri As New Uri("C:\JustBreatheBoldObliqueseven-7vgw.otf", UriKind.Absolute)
Dim gtf As New System.Windows.Media.GlyphTypeface(fontUri)
Dim fontName As String = String.Join(" "c, gtf.FamilyNames.Values)
Dim fontFaceNames As String = String.Join(" "c, gtf.FaceNames.Values)
Dim fullName As String = $"{fontName} {fontFaceNames}"
Console.WriteLine(fullName)

Just Breathe

NINGUNO (VALOR VACÍO EN ESTE CASO CONCRETO)

#If NETCOREAPP Then
Imports System.Buffers.Binary
#End If
 
Imports System.ComponentModel
Imports System.Diagnostics.CodeAnalysis
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Runtime.Versioning
Imports System.Security
Imports System.ServiceProcess
Imports System.Text
 
Imports Microsoft.Win32
 
Imports Microsoft.WindowsAPICodePack.Shell
 
Imports DevCase.Win32
Imports DevCase.Win32.Enums

#Region " Constants "
 
Namespace DevCase.Win32.Common.Constants
 
    <HideModuleName>
    Friend Module Constants
 
#Region " Window Messaging "
 
        ''' <summary>
        ''' Handle to use with window messaging functions.
        ''' <para></para>
        ''' When used, the message is sent to all top-level windows in the system, 
        ''' including disabled or invisible unowned windows, overlapped windows, and pop-up windows; 
        ''' but the message is not sent to child windows.
        ''' </summary>
        Friend ReadOnly HWND_BROADCAST As New IntPtr(65535US)
 
#End Region
 
    End Module
 
End Namespace
 
#End Region

#Region " Window Messages "
 
Namespace DevCase.Win32.Enums
 
    Friend Enum WindowMessages As Integer
 
        ''' <summary>
        ''' An application sends the message to all top-level windows in the system after changing the 
        ''' pool of font resources.
        ''' </summary>
        WM_FontChange = &H1D
 
    End Enum
 
End Namespace
 
#End Region

#Region " NativeMethods "
 
Namespace DevCase.Win32.NativeMethods
 
    <SuppressUnmanagedCodeSecurity>
    Friend Module Gdi32
 
        <DllImport("GDI32.dll", SetLastError:=False, CharSet:=CharSet.Auto, ThrowOnUnmappableChar:=True, BestFitMapping:=False)>
        Friend Function AddFontResource(fileName As String
        ) As Integer
        End Function
 
        <DllImport("GDI32.dll", SetLastError:=True, CharSet:=CharSet.Auto, ThrowOnUnmappableChar:=True, BestFitMapping:=False)>
        Friend Function RemoveFontResource(fileName As String
        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function
 
    End Module
 
    <SuppressUnmanagedCodeSecurity>
    Friend Module User32
 
        <DllImport("User32.dll", SetLastError:=True)>
        Friend Function SendMessage(hWnd As IntPtr,
                                    msg As WindowMessages,
                                    wParam As IntPtr,
                                    lParam As IntPtr
        ) As IntPtr
        End Function
 
    End Module
 
End Namespace
 
#End Region

Public Class UtilFonts
 
    ''' <summary>
    ''' Magic number located at the beginning of a TrueType font (.ttf) file header.
    ''' </summary>
    Private Shared ReadOnly TT_MAGIC As Byte() = {
        &H0, &H1, &H0, &H0
    }
 
    ''' <summary>
    ''' Magic number located at the beginning of a TrueType font (.ttf) file header 
    ''' that starts with ASCII string "true".
    ''' </summary>
    Private Shared ReadOnly TT_MAGIC_TRUE As Byte() = {
        &H74, &H72, &H75, &H65  ' "true"
    }
 
    ''' <summary>
    ''' Magic number located at the beginning of an OpenType font with CFF (PostScript) outlines (.otf) file header.
    ''' <para></para>
    ''' This distinguishes them from OpenType-TT fonts.
    ''' </summary>
    Private Shared ReadOnly OT_MAGIC As Byte() = {
        &H4F, &H54, &H54, &H4F ' "OTTO"
    }
 
    ''' <summary>
    ''' Retrieves a user-friendly name for a given font file, 
    ''' that is identical to the 'Title' property shown by Windows Explorer, 
    ''' allowing to provide consistent font identification in your application.  
    ''' </summary>
    ''' 
    ''' <param name="fontFile">
    ''' The path to the font file (e.g., <b>"C:\font.ttf"</b>).
    ''' </param>
    ''' 
    ''' <param name="includeSuffix">
    ''' If <see langword="True"/>, includes a suffix that specifies 
    ''' the underlying font technology (e.g., "Font name <c>(TrueType)</c>", "Font name <c>(OpenType)</c>"),
    ''' ensuring that the font name matches exactly the name shown in Microsoft's Windows Font Viewer (FontView.exe) title bar. 
    ''' </param>
    ''' 
    ''' <returns>
    ''' The user-friendly name for the given font file.
    ''' </returns>
    <DebuggerStepThrough>
    Public Shared Function GetFontFriendlyName(fontFile As String, includeSuffix As Boolean) As String
 
        If Not File.Exists(fontFile) Then
            Dim msg As String = $"The font file does not exist: '{fontFile}'"
            Throw New FileNotFoundException(msg, fontFile)
        End If
 
        Dim fontTitle As String = ShellFile.FromFilePath(fontFile).Properties.System.Title.Value.Trim()
        If String.IsNullOrWhiteSpace(fontTitle) Then
            Dim msg As String = "'Title' property for the given font is empty."
            Throw New FormatException(msg)
        End If
 
        If includeSuffix Then
            Dim fontType As FontType = UtilFonts.GetFontType(fontFile)
            Select Case fontType
 
                Case FontType.Invalid
                    Dim msg As String = "File does not seems a valid font file (file size is too small)."
                    Throw New FileFormatException(msg)
 
                Case FontType.Unknown
                    Dim msg As String = "Font file type is not recognized. " &
                                        "It might be an unsupported format, corrupted file Or Not a valid font file."
                    Throw New FileFormatException(msg)
 
                Case FontType.TrueType
                    Return $"{fontTitle} (TrueType)"
 
                Case FontType.OpenTypeCFF, FontType.OpenTypeTT
                    Return $"{fontTitle} (OpenType)"
 
                Case Else ' FontType.Raster
                    ' Nothing to do.
            End Select
        End If
 
        Return fontTitle
    End Function
 
    ''' <summary>
    ''' Determines the type of a font file.
    ''' <para></para>
    ''' Supports TrueType (.ttf), OpenType (.otf/.ttf) and Raster/Bitmap (.fon).
    ''' </summary>
    ''' 
    ''' <param name="fontFile">
    ''' The path to the font file (e.g., <b>"C:\font.ttf"</b>).
    ''' </param>
    ''' 
    ''' <returns>
    ''' A <see cref="FontType"/> value indicating the font type of the given file. 
    ''' <para></para>
    ''' If the font type cannot be recognized, it returns <see cref="FontType.Unknown"/>.
    ''' <para></para>
    ''' If the given file does not meet the criteria to be treated as a font file, it returns <see cref="FontType.Invalid"/>.
    ''' </returns>
    <DebuggerStepThrough>
    Public Shared Function GetFontType(fontFile As String) As FontType
 
        If Not File.Exists(fontFile) Then
            Dim msg As String = $"The font file does not exist: '{fontFile}'"
            Throw New FileNotFoundException(msg, fontFile)
        End If
 
        ' 512 bytes is the minimum length I found sufficient
        ' to reliably read the header of any raster (.fon) font file
        ' to find its string markers that identifies this file type.
        Const minFontFileLength As Short = 512
 
        Dim fi As New FileInfo(fontFile)
        If fi.Length <= minFontFileLength Then
            Return FontType.Invalid
        End If
 
        Try
            Using fs As FileStream = fi.OpenRead(),
                  br As New BinaryReader(fs)
 
                Dim headerBytes As Byte() = br.ReadBytes(4)
 
                ' TrueType check.
                If headerBytes.SequenceEqual(UtilFonts.TT_MAGIC) OrElse
                   headerBytes.SequenceEqual(UtilFonts.TT_MAGIC_TRUE) Then
 
                    ' OpenType-TT check
                    br.BaseStream.Seek(4, SeekOrigin.Begin)
#If NETCOREAPP Then
                    Dim numTables As UShort = BinaryPrimitives.ReverseEndianness(br.ReadUInt16())
#Else
                    ' Read two bytes directly.
                    Dim bytes As Byte() = br.ReadBytes(2)
                    ' If the system is little-endian, reverse the bytes to interpret as big-endian.
                    If BitConverter.IsLittleEndian Then
                        Array.Reverse(bytes)
                    End If
                    ' Now get the UShort value in big-endian.
                    Dim swapped As UShort = BitConverter.ToUInt16(bytes, 0)
                    Dim numTables As UShort = swapped
#End If
                    br.BaseStream.Seek(6, SeekOrigin.Current) ' skip: searchRange, entrySelector, rangeShift
                    ' Search advanced OpenType tables.
                    For i As Integer = 0 To numTables - 1
                        Dim tag As String = Encoding.ASCII.GetString(br.ReadBytes(4))
                        br.ReadBytes(12) ' checkSum, offset, length
                        If tag = "GSUB" OrElse tag = "GPOS" OrElse tag = "GDEF" OrElse tag = "BASE" Then
                            Return FontType.OpenTypeTT
                        End If
                    Next
 
                    Return FontType.TrueType
                End If
 
                ' OpenType CFF check.
                If headerBytes.SequenceEqual(UtilFonts.OT_MAGIC) Then
                    Return FontType.OpenTypeCFF
                End If
 
                ' Raster/Bitmap check.
                br.BaseStream.Seek(0, SeekOrigin.Begin)
                headerBytes = br.ReadBytes(minFontFileLength)
                Dim headerText As String = Encoding.ASCII.GetString(headerBytes)
                If headerText.Contains("FONTDIR") AndAlso
                   headerText.Contains("FONTRES") Then
                    Return FontType.Raster
                End If
 
            End Using
 
        Catch ex As Exception
            Throw
 
        End Try
 
        Return FontType.Unknown
    End Function
 
    ''' <summary>
    ''' Specifies the type of a font file.
    ''' </summary>
    Public Enum FontType As Short
 
        ''' <summary>
        ''' A TrueType font (.ttf).
        ''' <para></para>
        ''' This is the traditional TrueType format developed by Apple™.
        ''' </summary>
        TrueType
 
        ''' <summary>
        ''' An OpenType font with PostScript (CFF) outlines (.otf).
        ''' <para></para>
        ''' These fonts use the .otf container from the OpenType format jointly developed by Adobe™ and Microsoft™.
        ''' </summary>
        OpenTypeCFF
 
        ''' <summary>
        ''' An OpenType font with TrueType outlines (.ttf).
        ''' <para></para>
        ''' Technically OpenType, but uses TrueType outlines inside a .ttf container.
        ''' <para></para>
        ''' Sometimes called 'OpenType-TT' for distinction.
        ''' </summary>
        OpenTypeTT
 
        ''' <summary>
        ''' A Raster / Bitmap font (.fon) with fixed-size glyphs.
        ''' <para></para>
        ''' Raster fonts store each character as a pixel grid, not as scalable outlines.
        ''' <para></para>
        ''' These were commonly used in older versions of Windows and DOS, and are mostly legacy fonts today.
        ''' </summary>
        Raster
 
        ''' <summary>
        ''' Font file type is not recognized.
        ''' <para></para>
        ''' It might be an unsupported format, corrupted file or not a valid font file.
        ''' </summary>
        Unknown
 
        ''' <summary>
        ''' File does not seems a valid font file (file size is too small).
        ''' </summary>
        Invalid
 
    End Enum
 
    ''' <summary>
    ''' Determines whether a font file is already installed in the current computer.
    ''' </summary>
    ''' 
    ''' <param name="fontFilePathOrName">
    ''' Either the full path to the font file or just the file name 
    ''' (e.g., <b>"C:\font.ttf"</b> or else <b>"font.ttf"</b>).
    ''' </param>
    ''' 
    ''' <param name="systemWide">
    ''' If <see langword="True"/>, performs a system-wide search for the font installation (under <c>HKEY_LOCAL_MACHINE</c> base key).
    ''' otherwise, searches only the current user's installed fonts (under <c>HKEY_CURRENT_USER</c> base key).
    ''' </param>
    ''' 
    ''' <returns>
    ''' If the font file is not installed, returns <see cref="CheckFontInstallationResults.NotInstalled"/>; 
    ''' otherwise, can return a combination of <see cref="CheckFontInstallationResults"/> values.
    ''' </returns>
    <DebuggerStepThrough>
    Public Shared Function CheckFontInstallation(fontFilePathOrName As String, systemWide As Boolean) As CheckFontInstallationResults
 
        Dim fontFilePath As String = UtilFonts.BuildFullFontFilePath(fontFilePathOrName, systemWide)
        Dim fontFileName As String = Path.GetFileName(fontFilePath)
        Dim fontTitle As String = UtilFonts.GetFontFriendlyName(fontFilePath, includeSuffix:=False)
 
        Dim fontTitleTT As String = $"{fontTitle} (TrueType)"
        Dim fontTitleOT As String = $"{fontTitle} (OpenType)"
 
        Dim result As CheckFontInstallationResults = CheckFontInstallationResults.NotInstalled
 
        Dim baseKey As RegistryKey = If(systemWide, Registry.LocalMachine, Registry.CurrentUser)
        Dim regKeyPath As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts"
 
        Try
            Using key As RegistryKey = baseKey.OpenSubKey(regKeyPath, writable:=False)
                ' Fonts registry key does not exists.
                If key Is Nothing Then
                    Exit Try
                End If
 
                Dim valueFontTitle As Object = CStr(key.GetValue(fontTitle))
                Dim valueFontTitleTT As Object = CStr(key.GetValue(fontTitleTT))
                Dim valueFontTitleOT As Object = CStr(key.GetValue(fontTitleOT))
 
                Dim fontTitles() As String = {fontTitle, fontTitleTT, fontTitleOT}
                For Each title As String In fontTitles
 
                    Dim regValue As Object = key.GetValue(title, Nothing, RegistryValueOptions.DoNotExpandEnvironmentNames)
 
                    ' Font title found in registry
                    If regValue IsNot Nothing Then
                        result = result Or CheckFontInstallationResults.FontTitleFound
 
                        ' Font file matches?
                        If String.Equals(CStr(regValue), fontFileName, StringComparison.OrdinalIgnoreCase) Then
                            result = result Or CheckFontInstallationResults.FileNameFound
                        End If
                    End If
 
                    If result = (CheckFontInstallationResults.FontTitleFound Or CheckFontInstallationResults.FileNameFound) Then
                        Exit For
                    End If
                Next
 
                If Not result.HasFlag(CheckFontInstallationResults.FileNameFound) Then
                    ' Additional check required for consistency because the font file name
                    ' could be specified in a value name that differs from the compared font title vale names.
                    Dim valueNames As String() = Array.ConvertAll(key.GetValueNames(), Function(str As String) str.ToLowerInvariant())
                    If valueNames.Contains(fontFileName.ToLowerInvariant()) Then
                        result = result Or CheckFontInstallationResults.FileNameFound
                    End If
                End If
 
            End Using
 
        Catch ex As Exception
            Throw
 
        End Try
 
        Return result
    End Function
 
    ''' <summary>
    ''' Specifies the installation status of a font file on the current computer.
    ''' </summary>
    <Flags>
    Public Enum CheckFontInstallationResults As Short
 
        ''' <summary>
        ''' The font is not installed.
        ''' </summary>
        NotInstalled = 0S
 
        ''' <summary>
        ''' A registry value with the font file name is present in the Windows <b>Fonts</b> registry key.
        ''' </summary>
        FileNameFound = 1S << 0S
 
        ''' <summary>
        ''' A registry value name with the font title 
        ''' (which also may have suffix: "<b>(TrueType)</b>" or "<b>(OpenType)</b>")
        ''' is present in the Windows <b>Fonts</b> registry key.
        ''' </summary>
        FontTitleFound = 1S << 1S
 
    End Enum
 
    ''' <summary>
    ''' Installs a font file permanently on the current computer.
    ''' </summary>
    ''' 
    ''' <param name="fontFile">
    ''' The path to the font file to install (e.g., <b>"C:\font.ttf"</b>).
    ''' </param>
    ''' 
    ''' <param name="systemWide">
    ''' If <see langword="True"/>, performs a system-wide installation; 
    ''' otherwise, installs the font for the current user only.
    ''' </param>
    ''' 
    ''' <param name="useTrueTypeNameSuffix">
    ''' If <see langword="True"/>, appends the "<b>(TrueType)</b>" suffix when 
    ''' naming the font registry value for TrueType and OpenType fonts. 
    ''' This is what Microsoft Windows does by default.
    ''' <para></para>
    ''' If <see langword="False"/>, appends the appropriate suffix for the font type: "<b>(TrueType)</b>" or "<b>(OpenType)</b>".
    ''' <para></para>
    ''' This setting does not apply to .fon files.
    ''' </param>
    ''' 
    ''' <param name="addFontToSystemTable">
    ''' If <see langword="True"/>, the font resource is loaded into memory and immediately available to other applications.
    ''' </param>
    <DebuggerStepThrough>
    Public Shared Sub InstallFont(fontFile As String, systemWide As Boolean, useTrueTypeNameSuffix As Boolean, addFontToSystemTable As Boolean)
 
        Dim isFontInstalled As Boolean
        Try
            isFontInstalled = (UtilFonts.CheckFontInstallation(fontFile, systemWide) <> UtilFonts.CheckFontInstallationResults.NotInstalled)
 
        Catch ex As FileNotFoundException
            ' Use this exception message for readness, since CheckFontInstallation calls BuildFullFontFilePath, which modifies the path.
            Dim msg As String = $"The font file does not exist: '{fontFile}'"
            Throw New FileNotFoundException(msg, fontFile)
 
        Catch ex As Exception
            Throw
        End Try
 
        If isFontInstalled Then
            Dim msg As String = $"The font file is already installed: '{fontFile}'"
            Throw New InvalidOperationException(msg)
        End If
 
        Dim fontFileName As String = Path.GetFileName(fontFile)
        Dim fontTitle As String = UtilFonts.GetFontFriendlyName(fontFile, includeSuffix:=True)
        If useTrueTypeNameSuffix Then
            fontTitle = fontTitle.Replace(" (OpenType)", " (TrueType)")
        End If
 
        Dim fontsDir As String = If(systemWide,
            Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Fonts"),
            Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "Microsoft\Windows\Fonts"))
 
        If Not Directory.Exists(fontsDir) Then
            Directory.CreateDirectory(fontsDir)
        End If
 
        Dim fontFileDestPath As String = Path.Combine(fontsDir, fontFileName)
        If File.Exists(fontFileDestPath) Then
            Dim msg As String = $"Font file already exists in Fonts directory: {fontFileDestPath}"
            Throw New InvalidOperationException(msg)
        End If
 
        Try
            File.Copy(fontFile, fontFileDestPath, overwrite:=False)
        Catch ex As Exception
            Dim msg As String = $"Error copying font file to Fonts directory: '{fontFileDestPath}'"
            Throw New IOException(msg, ex)
        End Try
 
        Dim baseKey As RegistryKey = If(systemWide, Registry.LocalMachine, Registry.CurrentUser)
        Dim regKeyPath As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts"
 
        Dim registrySuccess As Boolean
        Try
            Using key As RegistryKey = baseKey.CreateSubKey(regKeyPath, writable:=True)
                key.SetValue(fontTitle, fontFileName, RegistryValueKind.String)
            End Using
            registrySuccess = True
 
        Catch ex As Exception
            Throw
 
        Finally
            If Not registrySuccess Then
                ' Attempt to delete the copied font file in Fonts directory
                ' when registry manipulation has failed.
                Try
                    File.Delete(fontFileDestPath)
                Catch
                    ' Ignore deletion exceptions; cleanup best effort.
                End Try
            End If
        End Try
 
        ' Add the font to the system font table. 
        If addFontToSystemTable Then
            Dim fontsAdded As Integer = DevCase.Win32.NativeMethods.AddFontResource(fontFileDestPath)
            Dim win32Err As Integer = Marshal.GetLastWin32Error()
 
            If fontsAdded = 0 OrElse win32Err <> 0 Then
                Dim msg As String = $"Failed to add font to the system font table '{fontFileDestPath}'"
                Throw New InvalidOperationException(msg, New Win32Exception(win32Err))
            End If
 
            ' Notify all top-level windows so they can immediately list the added font.
            DevCase.Win32.NativeMethods.SendMessage(DevCase.Win32.Common.Constants.HWND_BROADCAST, WindowMessages.WM_FontChange, IntPtr.Zero, IntPtr.Zero)
        End If
 
    End Sub
 
    ''' <summary>
    ''' Uninstalls a font file from the current computer.
    ''' </summary>
    ''' 
    ''' <param name="fontFilePathOrName">
    ''' Either the full path to the font file or just the file name 
    ''' (e.g., <b>"C:\font.ttf"</b> or else <b>"font.ttf"</b>).
    ''' </param>
    ''' 
    ''' <param name="systemWide">
    ''' If <see langword="True"/>, performs a system-wide uninstallation; 
    ''' otherwise, uninstalls the font for the current user only.
    ''' </param>
    ''' 
    ''' <param name="deleteFile">
    ''' If <see langword="True"/>, permanently deletes the font file from disk.
    ''' <para></para>
    ''' Note: The font file deletion will be performed after deleting associated registry values with the font file.
    ''' </param>
    <DebuggerStepThrough>
    Public Shared Sub UninstallFont(fontFilePathOrName As String, systemWide As Boolean, deleteFile As Boolean)
 
        Dim fontFilePath As String = UtilFonts.BuildFullFontFilePath(fontFilePathOrName, systemWide)
        Dim fontFileName As String = Path.GetFileName(fontFilePath)
 
        Dim checkFontInstallation As CheckFontInstallationResults = UtilFonts.CheckFontInstallation(fontFilePath, systemWide)
        Dim isFontInstalled As Boolean = (checkFontInstallation <> UtilFonts.CheckFontInstallationResults.NotInstalled)
        If Not isFontInstalled Then
            Dim msg As String = $"The font file is not installed: '{fontFilePath}'"
            Throw New InvalidOperationException(msg)
        End If
 
        Dim fontTitle As String = UtilFonts.GetFontFriendlyName(fontFilePath, includeSuffix:=False)
        Dim fontTitleTT As String = $"{fontTitle} (TrueType)"
        Dim fontTitleOT As String = $"{fontTitle} (OpenType)"
 
        Dim baseKey As RegistryKey = If(systemWide, Registry.LocalMachine, Registry.CurrentUser)
        Dim regKeyPath As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts"
 
        Try
            Using key As RegistryKey = baseKey.OpenSubKey(regKeyPath, writable:=True)
 
                Dim valueNames As String() = key.GetValueNames()
 
                ' Compare font title.
                If checkFontInstallation.HasFlag(CheckFontInstallationResults.FontTitleFound) Then
                    If valueNames.Contains(fontTitle) Then
                        key.DeleteValue(fontTitle, throwOnMissingValue:=True)
 
                    ElseIf valueNames.Contains(fontTitleTT) Then
                        key.DeleteValue(fontTitleTT, throwOnMissingValue:=True)
 
                    ElseIf valueNames.Contains(fontTitleOT) Then
                        key.DeleteValue(fontTitleOT, throwOnMissingValue:=True)
 
                    End If
 
                ElseIf checkFontInstallation.HasFlag(CheckFontInstallationResults.FileNameFound) Then
                    For Each valueName As String In valueNames
                        ' Compare font file name.
                        Dim value As String = CStr(key.GetValue(valueName))
                        If String.Equals(value, fontFileName, StringComparison.OrdinalIgnoreCase) Then
                            key.DeleteValue(valueName, throwOnMissingValue:=True)
                            Exit For
                        End If
                    Next
 
                End If
 
            End Using
 
        Catch ex As Exception
            Throw
 
        End Try
 
        If deleteFile Then
            Dim fontsDir As String = If(systemWide,
                Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Fonts"),
                Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "Microsoft\Windows\Fonts"))
 
            Dim fontFileDestPath As String = Path.Combine(fontsDir, fontFileName)
 
            ' First attempt to delete the file.
            Try
                File.Delete(fontFileDestPath)
            Catch
            End Try
 
            If File.Exists(fontFileDestPath) Then
                ' Remove the font from the system font table,
                ' because in case of 'AddFontResource' was called for this font file in the current user session,
                ' the font will remain loaded in memory and cannot be deleted until unloaded from memory.
                Dim result As Boolean = DevCase.Win32.NativeMethods.RemoveFontResource(fontFileDestPath)
                Dim win32Err As Integer = Marshal.GetLastWin32Error()
 
                If result Then
                    ' Notify all top-level windows so they can immediately delist the removed font.
                    DevCase.Win32.NativeMethods.SendMessage(DevCase.Win32.Common.Constants.HWND_BROADCAST, WindowMessages.WM_FontChange, IntPtr.Zero, IntPtr.Zero)
                Else
                    ' Ignore throwing an exception, since we don't really know if the font file was loaded in memory.
 
                    'Dim msg As String = $"Failed to remove font file from the system font table: '{fontFileDestPath}'"
                    'Throw New InvalidOperationException(msg, New Win32Exception(win32Err))
                End If
 
                ' Second attempt to delete the file.
                Try
                    File.Delete(fontFileDestPath)
                Catch
                End Try
 
            End If
 
            If File.Exists(fontFileDestPath) Then
 
                ' Ensure that the 'FontCache' service is stopped, as it could habe blocked the font file.
                Using sc As New ServiceController("FontCache")
                    Dim previousStatus As ServiceControllerStatus = sc.Status
                    If (sc.Status <> ServiceControllerStatus.Stopped) AndAlso
                       (sc.Status <> ServiceControllerStatus.StopPending) Then
                        Try
                            sc.Stop()
                            sc.WaitForStatus(ServiceControllerStatus.Stopped, TimeSpan.FromSeconds(3))
                        Catch ex As Exception
                            ' Ignore throwing an exception,
                            ' since we don't really know if the 'FontCache' service have blocked the font file at all.
 
                            'If sc.Status <> ServiceControllerStatus.Stopped Then
                            '    Dim msg As String = "Unable to stop 'FontCache' service."
                            '    Throw New InvalidOperationException(msg, ex)
                            'End If
                        End Try
                    End If
 
                    ' Third and last attempt to delete the file.
                    Try
                        File.Delete(fontFileDestPath)
 
                    Catch ex As Exception
                        Dim msg As String = $"Error deleting font file from Fonts directory: '{fontFileDestPath}'"
                        Throw New IOException(msg, ex)
 
                    Finally
                        ' Restore previous 'FontCache' service status if it was started and not in automatic mode.
                        If sc.StartType <> ServiceStartMode.Automatic AndAlso (
                              (previousStatus = ServiceControllerStatus.Running) OrElse
                              (previousStatus = ServiceControllerStatus.StartPending)
                           ) AndAlso sc.Status <> ServiceControllerStatus.Running Then
                            Try
                                sc.Start()
                                sc.WaitForStatus(ServiceControllerStatus.Running, TimeSpan.FromSeconds(0.25))
                            Catch
                                ' Ignore throwing an exception; best effort.
                            End Try
                        End If
                    End Try
                End Using
            End If
 
        End If
 
    End Sub
 
    ''' <summary>
    ''' Builds a full path to a font file from the given value in <paramref name="fontFilePathOrName"/> parameter. 
    ''' <para></para>
    ''' If the provided file path exists, it is returned as-is; otherwise, 
    ''' the function constructs and returns a full file path based on 
    ''' the value of <paramref name="systemWide"/> parameter.
    ''' <para></para>
    ''' Note: This function does not check whether the resulting file path exists.
    ''' </summary>
    ''' 
    ''' <param name="fontFilePathOrName">
    ''' Either the full path to the font file or just the file name 
    ''' (e.g., <b>"C:\font.ttf"</b> or else <b>"font.ttf"</b>).
    ''' <para></para>
    ''' If the provided path exists, the function returns this path as-is.
    ''' </param>
    ''' 
    ''' <param name="systemWide">
    ''' If <see langword="True"/>, the function constructs a full font file path from the system's Fonts directory 
    ''' (<b>%WINDIR%\Fonts</b>); otherwise, it constructs a full font file path from the current user's local Fonts directory 
    ''' (<b>%LOCALAPPDATA%\Microsoft\Windows\Fonts</b>).
    ''' <para></para>
    ''' Note: The <paramref name="systemWide"/> parameter is ignored if 
    ''' <paramref name="fontFilePathOrName"/> already specifies an existing file path.
    ''' </param>
    ''' 
    ''' <returns>
    ''' The resulting full path to the font file.
    ''' </returns>
    <DebuggerStepThrough>
    Private Shared Function BuildFullFontFilePath(fontFilePathOrName As String, systemWide As Boolean) As String
 
        If File.Exists(fontFilePathOrName) Then
            Return fontFilePathOrName
        End If
 
        Dim fontFileName As String = Path.GetFileName(fontFilePathOrName)
        If String.IsNullOrWhiteSpace(fontFileName) Then
            Throw New ArgumentException("The font file path or name is malformed or empty.", NameOf(fontFilePathOrName))
        End If
 
        Dim fontsDir As String = If(systemWide,
            Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Fonts"),
            Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "Microsoft\Windows\Fonts"))
 
        Return Path.Combine(fontsDir, fontFileName)
    End Function
 
End Class

Imports System.ComponentModel
Imports System.Drawing
Imports System.Drawing.Text
Imports System.IO
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
 
Imports DevCase.Win32
Imports DevCase.Win32.Enums
Imports DevCase.Win32.Structures

#Region " Constants "
 
Namespace DevCase.Win32.Common.Constants
 
    <HideModuleName>
    Friend Module Constants
 
#Region " GDI32 "
 
    ''' <summary>
    ''' Error return value for some GDI32 functions.
    ''' </summary>
    Public Const GDI_ERROR As UInteger = &HFFFFFFFFUI
 
    ''' <summary>
    ''' Error return value for some GDI32 functions.
    ''' </summary>
    Public ReadOnly HGDI_ERROR As New IntPtr(-1)
 
#End Region
 
    End Module
 
End Namespace
 
#End Region

#Region " Enums "
 
Namespace DevCase.Win32.Enums
 
    ''' <remarks>
    ''' List of System Error Codes: <see href="https://docs.microsoft.com/en-us/windows/desktop/Debug/system-error-codes"/>.
    ''' </remarks>
    Public Enum Win32ErrorCode As Integer
 
        ''' <summary>
        ''' The operation completed successfully.
        ''' </summary>
        ERROR_SUCCESS = &H0 
    End Enum
 
    ''' <remarks>
    ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-wcrange"/>
    ''' </remarks>
    <Flags>
    Public Enum GetGlyphIndicesFlags ' GGI
 
        ''' <summary>
        ''' Marks unsupported glyphs with the hexadecimal value 0xFFFF.
        ''' </summary>
        MarkNonExistingGlyphs = 1 ' GGI_MARK_NONEXISTING_GLYPHS
    End Enum
 
    ''' <remarks>
    ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getglyphoutlinew"/>
    ''' </remarks>
    Public Enum GetGlyphOutlineFormat ' GGO
        Metrics = 0
        Bitmap = 1
 
        ''' <summary>
        ''' The function retrieves the curve data points in the rasterizer's native format and uses the font's design units.
        ''' </summary>
        Native = 2
 
        Bezier = 3
        BitmapGray2 = 4
        BitmapGray4 = 5
        BitmapGray8 = 6
        GlyphIndex = &H80
        Unhinted = &H100
    End Enum
 
End Namespace
 
#End Region

#Region " Structures "
 
    Namespace DevCase.Win32.Structures
 
    #Region " GlyphMetrics "
 
        ''' <remarks>
        ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-glyphmetrics"/>
        ''' </remarks>
        <StructLayout(LayoutKind.Sequential)>
        Public Structure GlyphMetrics
            Public BlackBoxX As UInteger
            Public BlackBoxY As UInteger
            Public GlyphOrigin As NativePoint
            Public CellIncX As Short
            Public CellIncY As Short
        End Structure
 
    #End Region
 
    #Region " NativePoint (POINT) "
 
    ''' <summary>
    ''' Defines the x- and y- coordinates of a point.
    ''' </summary>
    '''
    ''' <remarks>
    ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd162805%28v=vs.85%29.aspx"/>
    ''' </remarks>
    <DebuggerStepThrough>
    <StructLayout(LayoutKind.Sequential)>
    Public Structure NativePoint
 
#Region " Fields "
 
        Public X As Integer
        Public Y As Integer
 
#End Region
 
#Region " Constructors "
 
        Public Sub New(x As Integer, y As Integer)
            Me.X = x
            Me.Y = y
        End Sub
 
        Public Sub New(pt As Point)
            Me.New(pt.X, pt.Y)
        End Sub
 
#End Region
 
#Region " Operator Conversions "
 
        Public Shared Widening Operator CType(pt As NativePoint) As Point
            Return New Point(pt.X, pt.Y)
        End Operator
 
        Public Shared Widening Operator CType(pt As Point) As NativePoint
            Return New NativePoint(pt.X, pt.Y)
        End Operator
 
#End Region
 
    End Structure
 
    #End Region
 
    #Region " GlyphOutlineMatrix2 "
 
    ''' <remarks>
    ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-mat2"/>
    ''' </remarks>
    <StructLayout(LayoutKind.Sequential)>
    Public Structure GlyphOutlineMatrix2 ' MAT2
 
        Public M11 As Fixed
        Public M12 As Fixed
        Public M21 As Fixed
        Public M22 As Fixed
 
        ''' <summary>
        ''' Gets an <see cref="GlyphOutlineMatrix2"/> transformation in which the transformed graphical object is identical to the source object. 
        ''' This is called an identity matrix.
        ''' <para></para>
        ''' In this identity matrix,
        ''' the value of <see cref="GlyphOutlineMatrix2.M11"/> is 1, 
        ''' the value of <see cref="GlyphOutlineMatrix2.M12"/> is zero, 
        ''' the value of <see cref="GlyphOutlineMatrix2.M21"/> is zero, 
        ''' and the value of <see cref="GlyphOutlineMatrix2.M22"/> is 1.
        ''' </summary>
        ''' 
        ''' <returns>
        ''' The resulting <see cref="GlyphOutlineMatrix2"/>.
        ''' </returns>
        Public Shared Function GetIdentityMatrix() As GlyphOutlineMatrix2
            Return New GlyphOutlineMatrix2() With {
            .M11 = New Fixed With {.Value = 1},
            .M22 = New Fixed With {.Value = 1}
        }
        End Function
 
    End Structure
 
    #End Region
 
    #Region " Fixed "
 
    ''' <summary>
    ''' Contains the integral and fractional parts of a fixed-point real number.
    ''' <para></para>
    ''' Note: The <see cref="Fixed"/> structure is used to describe the elements of the <see cref="GlyphOutlineMatrix2"/> structure.
    ''' </summary>
    ''' 
    ''' <remarks>
    ''' <see href="https://docs.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-fixed"/>
    ''' </remarks>
    <StructLayout(LayoutKind.Sequential)>
    Public Structure Fixed
 
#Region " Public Fields "
 
        ''' <summary>
        ''' The fractional value.
        ''' </summary>
        Public Fraction As UShort
 
        ''' <summary>
        ''' The integral value.
        ''' </summary>
        Public Value As Short
 
#End Region
 
#Region " Operator Conversions "
 
        Public Shared Widening Operator CType(f As Fixed) As Decimal
 
            Return Decimal.Parse($"{f.Value.ToString(NumberFormatInfo.InvariantInfo)}{NumberFormatInfo.InvariantInfo.NumberDecimalSeparator}{f.Fraction.ToString(NumberFormatInfo.InvariantInfo)}", NumberFormatInfo.InvariantInfo)
        End Operator
 
        Public Shared Widening Operator CType(dec As Decimal) As Fixed
 
            Return New Fixed With {
                .Value = CShort(System.Math.Truncate(System.Math.Truncate(dec))),
                .Fraction = UShort.Parse(dec.ToString(NumberFormatInfo.InvariantInfo).Split({NumberFormatInfo.InvariantInfo.NumberDecimalSeparator}, StringSplitOptions.None)(1), NumberFormatInfo.InvariantInfo)
            }
        End Operator
 
#End Region
 
#Region " Public Methods "
 
        Public Overrides Function ToString() As String
 
            Return CDec(Me).ToString()
        End Function
 
#End Region
 
    End Structure
 
    #End Region
 
    End Namespace
 
#End Region
 

#Region " NativeMethods "
 
Namespace DevCase.Win32.NativeMethods
 
    <SuppressUnmanagedCodeSecurity>
    Friend Module Gdi32
 
        ''' <summary>
        ''' Creates a memory device context (DC) compatible with the specified device.
        ''' </summary>
        '''
        ''' <remarks>
        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd183489%28v=vs.85%29.aspx"/>
        ''' </remarks>
        <DllImport("gdi32.dll", SetLastError:=True)>
        Public Function CreateCompatibleDC(hdc As IntPtr
        ) As IntPtr
        End Function
 
        ''' <summary>
        ''' Deletes the specified device context (DC).
        ''' <para></para>
        ''' An application must not delete a DC whose handle was obtained by calling the <see cref="GetDC"/> function. 
        ''' instead, it must call the <see cref="ReleaseDC"/> function to free the DC.
        ''' </summary>
        '''
        ''' <remarks>
        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd183533%28v=vs.85%29.aspx"/>
        ''' </remarks>
        <DllImport("gdi32.dll")>
        Public Function DeleteDC(hdc As IntPtr
        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function
 
        ''' <summary>
        ''' Selects an object into a specified device context.
        ''' <para></para>
        ''' The new object replaces the previous object of the same type. 
        ''' </summary>
        '''
        ''' <remarks>
        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd162957%28v=vs.85%29.aspx"/>
        ''' </remarks>
        <DllImport("gdi32.dll", ExactSpelling:=False)>
        Public Function SelectObject(hdc As IntPtr,
                                     hObject As IntPtr
        ) As IntPtr
        End Function
 
        ''' <summary>
        ''' Deletes a logical pen, brush, font, bitmap, region, or palette,
        ''' freeing all system resources associated with the object.
        ''' <para></para>
        ''' After the object is deleted, the specified handle is no longer valid.
        ''' <para></para>
        ''' Do not delete a drawing object (pen or brush) while it is still selected into a DC.
        ''' <para></para>
        ''' When a pattern brush is deleted, the bitmap associated with the brush is not deleted. 
        ''' The bitmap must be deleted independently.
        ''' </summary>
        '''
        ''' <remarks>
        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/ms633540%28v=vs.85%29.aspx"/>
        ''' </remarks>
        <DllImport("gdi32.dll", ExactSpelling:=False, SetLastError:=True)>
        Public Function DeleteObject(hObject As IntPtr
        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function
 
        ''' <summary>
        ''' Translates a string into an array of glyph indices. 
        ''' <para></para>
        ''' The function can be used to determine whether a glyph exists in a font.
        ''' </summary>
        ''' 
        ''' <remarks>
        ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getglyphindicesw"/>
        ''' </remarks>
        <DllImport("gdi32.dll", SetLastError:=False, CharSet:=CharSet.Auto, BestFitMapping:=False, ThrowOnUnmappableChar:=True)>
        Public Function GetGlyphIndices(hdc As IntPtr,
                                        str As String,
                                        strLen As Integer,
                                        <[Out], MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=2)>
                                        glyphIndices As UShort(),
                               Optional flags As GetGlyphIndicesFlags = GetGlyphIndicesFlags.MarkNonExistingGlyphs
        ) As UInteger
        End Function
 
        ''' <summary>
        ''' Retrieves the outline or bitmap for a character in the TrueType font that is selected into the specified device context.
        ''' </summary>
        ''' 
        ''' <remarks>
        ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getglyphoutlinew"/>
        ''' </remarks>
        <DllImport("gdi32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
        Public Function GetGlyphOutline(hdc As IntPtr,
                                        ch As UInteger,
                                        format As GetGlyphOutlineFormat,
                            <Out> ByRef refMetrics As GlyphMetrics,
                                        bufferSize As UInteger,
                                        buffer As IntPtr,
                                  ByRef refMatrix2 As GlyphOutlineMatrix2
        ) As UInteger
        End Function
 
    End Module
 
End Namespace
 
#End Region

Public Class UtilFonts
 
    ''' <summary>
    ''' Prevents a default instance of the <see cref="UtilFonts"/> class from being created.
    ''' </summary>
    Private Sub New()
    End Sub
 
    ''' <summary>
    ''' Determines whether a glyph exists in the given font file 
    ''' for the specified character.
    ''' </summary>
    ''' 
    ''' <param name="fontFile">
    ''' Path to the font file used to check for glyph availability.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character that represents the glyph to check.
    ''' </param>
    ''' 
    ''' <returns>
    ''' <see langword="True"/> if a glyph exists in the font for the specified character; 
    ''' otherwise, <see langword="False"/>.
    ''' </returns>
    <DebuggerStepThrough>
    Public Shared Function FontHasGlyph(fontFile As String, ch As Char) As Boolean
 
        Return UtilFonts.FontHasGlyphs(fontFile, ch) = 1
    End Function
 
    ''' <summary>
    ''' Determines whether a glyph exists in the given font file 
    ''' for all the characters in the speciied string.
    ''' </summary>
    ''' 
    ''' <param name="fontFile">
    ''' Path to the font file used to check for glyphs availability.
    ''' </param>
    ''' 
    ''' <param name="str">
    ''' A <see cref="String"/> with the character(s) that represents the glyphs to check.
    ''' <para></para>
    ''' Each character (or surrogate pair) is checked for a existing glyph in the font.
    ''' </param>
    ''' 
    ''' <returns>
    ''' The count of characters from <paramref name="str"/> parameter that have a existing glyph in the font.
    ''' <para></para>
    ''' A count less than the length of <paramref name="str"/> indicates that the font does not have a existing glyph for one or more characters.
    ''' </returns>
    ''' 
    ''' <exception cref="FileNotFoundException">
    ''' Thrown when the font file is not found.
    ''' </exception>
    <DebuggerStepThrough>
    Public Shared Function FontHasGlyphs(fontFile As String, str As String) As UInteger
 
        If Not System.IO.File.Exists(fontFile) Then
            Throw New FileNotFoundException("Font file not found.", fileName:=fontFile)
        End If
 
        Using pfc As New PrivateFontCollection()
            pfc.AddFontFile(fontFile)
 
            Using f As New Font(pfc.Families(0), emSize:=1)
                Return FontExtensions.HasGlyphs(f, str)
            End Using
        End Using
    End Function
 
    ''' <summary>
    ''' Determines whether a glyph for the specified character in the given font file has an outline.
    ''' <para></para>
    ''' This is useful to determine whether the glyph is empty (no character is drawn),
    ''' but note that a glyph with outlines does not necessarily mean that the character is fully represented. 
    ''' Some fonts, for instance, only renders diacritical marks for accented vowels 
    ''' instead the full letter (e.g., "<b>´</b>" instead of "<b>í</b>"). 
    ''' This function solely determines whether the glyph draws an outline, nothing more. 
    ''' <para></para>
    ''' To determine whether a glyph exists in the given font file for the specified character, use
    ''' <see cref="UtilFonts.FontHasGlyph"/> or <see cref="UtilFonts.FontHasGlyphs"/> instead.
    ''' </summary>
    ''' 
    ''' <param name="fontFile">
    ''' Path to the font file used to check for glyph availability.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character that represents the glyph to check in the font.
    ''' </param>
    ''' 
    ''' <returns>
    ''' Returns <see langword="True"/> if the glyph has an outline (visible shape data exists).
    ''' <para></para>
    ''' Returns <see langword="False"/> if the glyph does not have an outline, 
    ''' meaning the glyph is empty/unsupported by the font.
    ''' </returns>
    ''' 
    ''' <exception cref="FileNotFoundException">
    ''' Thrown when the font file is not found.
    ''' </exception>
    <DebuggerStepThrough>
    Public Shared Function FontGlyphHasOutline(fontFile As String, ch As Char) As Boolean
 
        If Not System.IO.File.Exists(fontFile) Then
            Throw New FileNotFoundException("Font file not found.", fileName:=fontFile)
        End If
 
        Using pfc As New PrivateFontCollection()
            pfc.AddFontFile(fontFile)
 
            Using f As New Font(pfc.Families(0), emSize:=1)
                Return FontExtensions.GlyphHasOutline(f, ch)
            End Using
        End Using
    End Function
 
End Class

Module FontExtensions
 
    ''' <summary>
    ''' Determines whether a glyph exists in the given <see cref="System.Drawing.Font"/> 
    ''' for the specified character.
    ''' </summary>
    ''' 
    ''' <param name="font">
    ''' The <see cref="System.Drawing.Font"/> used to check for glyph availability.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character that represents the glyph to check.
    ''' </param>
    ''' 
    ''' <returns>
    ''' <see langword="True"/> if a glyph exists in the font for the specified character; 
    ''' otherwise, <see langword="False"/>.
    ''' </returns>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <DebuggerStepThrough>
    Public Function HasGlyph(font As Font, ch As Char) As Boolean
 
        Return FontExtensions.HasGlyphs(font, ch) = 1
    End Function
 
    ''' <summary>
    ''' Determines whether a glyph exists in the given <see cref="System.Drawing.Font"/> 
    ''' for all the characters in the speciied string.
    ''' </summary>
    ''' 
    ''' <param name="font">
    ''' The <see cref="System.Drawing.Font"/> used to check for glyphs availability.
    ''' </param>
    ''' 
    ''' <param name="str">
    ''' A <see cref="String"/> with the character(s) that represents the glyphs to check.
    ''' <para></para>
    ''' Each character (or surrogate pair) is checked for a existing glyph in the font.
    ''' </param>
    ''' 
    ''' <returns>
    ''' The count of characters from <paramref name="str"/> parameter that have a existing glyph in the font.
    ''' <para></para>
    ''' A count less than the length of <paramref name="str"/> indicates that the font does not have a existing glyph for one or more characters.
    ''' </returns>
    ''' 
    ''' <exception cref="ArgumentNullException">
    ''' Thrown when <paramref name="font"/> or <paramref name="str"/> are null.
    ''' </exception>
    ''' 
    ''' <exception cref="Win32Exception">
    ''' Thrown when a call to Windows API GDI32 functions (creating device context, selecting font, or retrieving glyph indices) fails.
    ''' </exception>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <DebuggerStepThrough>
    Public Function HasGlyphs(font As Font, str As String) As UInteger
 
        If font Is Nothing Then
            Throw New ArgumentNullException(paramName:=NameOf(font))
        End If
 
        If String.IsNullOrEmpty(str) Then
            Throw New ArgumentNullException(paramName:=NameOf(str))
        End If
 
        Dim hdc As IntPtr
        Dim hFont As IntPtr
        Dim oldObj As IntPtr
 
        Dim win32Err As Integer
 
        Try
            hFont = font.ToHfont()
            hdc = NativeMethods.CreateCompatibleDC(IntPtr.Zero)
            win32Err = Marshal.GetLastWin32Error()
            If hdc = IntPtr.Zero Then
                Throw New Win32Exception(win32Err)
            End If
 
            oldObj = NativeMethods.SelectObject(hdc, hFont)
            win32Err = Marshal.GetLastWin32Error()
            If oldObj = IntPtr.Zero OrElse oldObj = DevCase.Win32.Common.Constants.HGDI_ERROR Then
                Throw New Win32Exception(win32Err)
            End If
 
            ' Reserve output for each text unit (can be 1 or 2 chars if it's a surrogate pair).
            Dim strLen As Integer = str.Length
            Dim indices As UShort() = New UShort(strLen - 1) {}
            ' Get the glyph indices for the string in the given device context.
            Dim converted As UInteger = NativeMethods.GetGlyphIndices(hdc, str, strLen, indices, GetGlyphIndicesFlags.MarkNonExistingGlyphs)
            win32Err = Marshal.GetLastWin32Error()
            If converted = DevCase.Win32.Common.Constants.GDI_ERROR Then
                Throw New Win32Exception(win32Err)
            End If
 
            ' Count glyphs that exist (index <> 0xFFFF).
            ' If any glyph index is 0xFFFF, the glyph does not exist in that font.
            Dim count As UInteger
            For Each index As UShort In indices
                If index <> &HFFFFUS Then
                    count += 1UI
                End If
            Next
            Return count
 
        Finally
            If oldObj <> IntPtr.Zero Then
                NativeMethods.DeleteObject(oldObj)
            End If
            If hFont <> IntPtr.Zero Then
                NativeMethods.DeleteObject(hFont)
            End If
            If hdc <> IntPtr.Zero Then
                NativeMethods.DeleteDC(hdc)
            End If
 
        End Try
    End Function
 
 
    ''' <summary>
    ''' Determines whether a glyph for the specified character in the given <see cref="System.Drawing.Font"/> has an outline.
    ''' <para></para>
    ''' This is useful to determine whether the glyph is empty (no character is drawn),
    ''' but note that a glyph with outlines does not necessarily mean that the character is fully represented. 
    ''' Some fonts, for instance, only renders diacritical marks for accented vowels 
    ''' instead the full letter (e.g., "<b>´</b>" instead of "<b>í</b>"). 
    ''' This function solely determines whether the glyph draws an outline, nothing more. 
    ''' <para></para>
    ''' To determine whether a glyph exists in the given font file for the specified character, use
    ''' <see cref="FontExtensions.HasGlyph"/> or <see cref="FontExtensions.HasGlyphs"/> instead.
    ''' </summary>
    ''' 
    ''' <param name="font">
    ''' The <see cref="System.Drawing.Font"/> used to check for glyph availability.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character that represents the glyph to check in the font.
    ''' </param>
    ''' 
    ''' <returns>
    ''' Returns <see langword="True"/> if the glyph has an outline (visible shape data exists).
    ''' <para></para>
    ''' Returns <see langword="False"/> if the glyph does not have an outline, 
    ''' meaning the glyph is empty/unsupported by the font.
    ''' </returns>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <DebuggerStepThrough>
    Public Function GlyphHasOutline(font As Font, ch As Char) As Boolean
 
        If font Is Nothing Then
            Throw New ArgumentNullException(paramName:=NameOf(font))
        End If
 
        Dim hdc As IntPtr
        Dim hFont As IntPtr
        Dim oldObj As IntPtr
 
        Dim win32Err As Integer
 
        Try
            hFont = font.ToHfont()
            hdc = NativeMethods.CreateCompatibleDC(IntPtr.Zero)
            oldObj = NativeMethods.SelectObject(hdc, hFont)
            win32Err = Marshal.GetLastWin32Error()
            If oldObj = IntPtr.Zero OrElse oldObj = DevCase.Win32.Common.Constants.HGDI_ERROR Then
                Throw New Win32Exception(win32Err)
            End If
 
            Dim chCode As UInteger = CUInt(Convert.ToInt32(ch))
            Dim format As GetGlyphOutlineFormat = GetGlyphOutlineFormat.Native
            Dim matrix As GlyphOutlineMatrix2 = GlyphOutlineMatrix2.GetIdentityMatrix()
 
            Dim ptCount As UInteger = NativeMethods.GetGlyphOutline(hdc, chCode, format, Nothing, Nothing, Nothing, matrix)
            win32Err = Marshal.GetLastWin32Error()
            Select Case ptCount
 
                Case 0UI
                    ' Zero curve data points were returned, meaning the glyph is empty/invisible.
                    Return False
 
                Case DevCase.Win32.Common.Constants.GDI_ERROR
                    If win32Err = Win32ErrorCode.ERROR_SUCCESS Then
                        ' The function returned GDI_ERROR, but no error recorded by GetLastError, meaning the function succeeded.
                        ' Tests carried out have shown that when this happens the glyph simply does not exists. 
                        Return False
                    Else
                        Throw New Win32Exception(win32Err)
                    End If
 
                Case Else
                    Return True
 
            End Select
 
        Finally
            If oldObj <> IntPtr.Zero Then
                NativeMethods.DeleteObject(oldObj)
            End If
            If hFont <> IntPtr.Zero Then
                NativeMethods.DeleteObject(hFont)
            End If
            If hdc <> IntPtr.Zero Then
                NativeMethods.DeleteDC(hdc)
            End If
 
        End Try
 
        ' ===================================================
        '   ALTERNATIVE METHODOLOGY USING PURE MANAGED GDI+
        '
        ' (results are the same than using Windows API calls)
        ' ===================================================
        '
        '
        'If font Is Nothing Then
        '    Throw New ArgumentNullException(paramName:=NameOf(font))
        'End If
        '
        'If font.Unit = GraphicsUnit.Pixel AndAlso font.Size < 8 Then
        '    Dim msg As String =
        '        "Font size must be equals or greater than 8 pixels when using GraphicsUnit.Pixel to avoid unreliable pixel detection. " &
        '        "Suggested font size is 16 pixel size; A value of 32, 64 or bigger pixel size would produce the same results."
        '    Throw New ArgumentException(msg)
        '
        'ElseIf font.Size < 4 Then
        '    Dim msg As String =
        '        "Font size must be equals or greater than 4 to avoid unreliable pixel detection. " &
        '        "Suggested usage is GraphicsUnit.Pixel with a font size of 16 pixels; " &
        '        "A value of 32, 64 or bigger pixel size would produce the same results."
        '    Throw New ArgumentException(msg)
        '
        'End If
        '
        '' Measure the required size for the glyph.
        'Dim requiredSize As Size
        'Using tempBmp As New Bitmap(1, 1)
        '    Using g As Graphics = Graphics.FromImage(tempBmp)
        '        Dim sizeF As SizeF = g.MeasureString(ch, font)
        '        ' Add a small margin to avoid clipping due to rounding.
        '        requiredSize = New Size(CInt(System.Math.Ceiling(sizeF.Width)) + 4,
        '                                CInt(System.Math.Ceiling(sizeF.Height)) + 4)
        '    End Using
        'End Using
        '
        '' Create a bitmap big enough to render the glyph, 
        '' filling the bitmap background with white color and 
        '' drawing the character in black.
        'Using bmp As New Bitmap(requiredSize.Width, requiredSize.Height),
        '      g As Graphics = Graphics.FromImage(bmp)
        '    ' Using AntiAlias may help ensure that very thin glyph strokes 
        '    ' still produce detectable pixels, with gray edges.
        '    ' Without anti-aliasing, such strokes might render too faint or disappear entirely,
        '    ' causing the glyph to be misidentified as empty.
        '    g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
        '    g.Clear(Color.White)
        '    g.DrawString(ch, font, Brushes.Black, 0, 0)
        '
        '    Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
        '    Dim bmpData As BitmapData = bmp.LockBits(rect, Imaging.ImageLockMode.ReadOnly, Imaging.PixelFormat.Format32bppArgb)
        '
        '    Try
        '        Dim ptr As IntPtr = bmpData.Scan0
        '        Dim bytes As Integer = System.Math.Abs(bmpData.Stride) * bmp.Height
        '        Dim pixelValues(bytes - 1) As Byte
        '        Marshal.Copy(ptr, pixelValues, 0, bytes)
        '
        '        ' Iterate through each pixel.
        '        ' PixelFormat.Format32bppArgb stores pixels as [Blue][Green][Red][Alpha]
        '        ' i=Blue, i+1=Green, i+2=Red, i+3=Alpha
        '        For i As Integer = 0 To pixelValues.Length - 1 Step 4
        '            Dim red As Byte = pixelValues(i + 2)
        '
        '            ' Check if the pixel is darker than nearly-white (threshold 250)
        '            ' If so, we found a visible pixel, meaning the glyph is drawn.
        '            If red < 250 Then
        '                Return True
        '            End If
        '        Next
        '    Finally
        '        bmp.UnlockBits(bmpData)
        '
        '    End Try
        'End Using
        '
        '' No visible pixels found, meaning the glyph is empty/unsupported by the font.
        'Return False
 
    End Function
 
End Module

Dim fontFiles As IEnumerable(Of String) = Directory.EnumerateFiles("C:\Fonts", "*.ttf", SearchOption.TopDirectoryOnly)
Dim fontsToDelete As New HashSet(Of String)()
Dim chars As Char() = "áéíóú".ToCharArray()
 
For Each fontFile As String In fontFiles
    Dim missingChars As New HashSet(Of Char)()
 
    For Each ch As Char In chars
        If Not UtilFonts.FontHasGlyph(fontFile, ch) OrElse
           Not UtilFonts.FontGlyphHasOutline(fontFile, ch) Then
            missingChars.Add(ch)
        End If
    Next
 
    If missingChars.Count > 0 Then
        Console.WriteLine($"[{Path.GetFileName(fontFile)}] Missing glyphs: {String.Join(", ", missingChars)}")
        fontsToDelete.Add(fontFile)
    End If
Next
 
For Each fontFile As String In fontsToDelete
    ' Console.WriteLine($"Deleting font file: {fontFile}")
    ' Microsoft.VisualBasic.FileIO.FileSystem.DeleteFile(fontFile, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Next