'Imports NHunspell
Imports System.Drawing
Imports System.IO
Imports System.Windows.Forms
Imports System.Reflection
''' <summary>
''' This class holds the text in the textbox, along with which words are spelling errors.
''' This class will also return the requested number of suggestions for misspelled words.
''' </summary>
''' <remarks></remarks>
Public Class SpellCheckControl
#Region "Variables"
Private FullText As String
Private _Text(,) As String
Public myNHunspell As Object = Nothing
Private _spellingErrors() As String
Private _spellingErrorRanges() As CharacterRange
#End Region
#Region "New"
Public Sub New(ByRef HunspellObject As Object)
'Create the Hunspell Object
'Get the calling assembly's location
'Dim USdic, USaff As String
Dim callingDir As String = Path.GetDirectoryName(Assembly.GetCallingAssembly.Location)
''Set the paths for the dic and aff files
'USdic = callingDir & "\SpellCheck\en_US.dic"
'USaff = callingDir & "\SpellCheck\en_US.aff"
''Check if the spell check directory already exists. If not, add it
'If Not Directory.Exists(callingDir & "\SpellCheck") Then
'Directory.CreateDirectory(callingDir & "\SpellCheck")
'Dim newDirInfo As New DirectoryInfo(callingDir & "\SpellCheck")
'newDirInfo.Attributes = FileAttributes.Hidden
'End If
''Check if the spell check files already exist. If not, add it
'If Not File.Exists(USaff) Then
'Try
'File.WriteAllBytes(USaff, My.Resources.en_US)
'Catch ex As Exception
'MessageBox.Show("Error writing en_US.aff file!" & vbNewLine & ex.Message)
'End Try
'End If
'If Not File.Exists(USdic) Then
'Try
'File.WriteAllBytes(USdic, My.Resources.en_US_dic)
'Catch ex As Exception
'MessageBox.Show("Error writing en_US.dic file!" & vbNewLine & ex.Message)
'End Try
'End If
''Create the new hunspell
'CreateNewHunspell:
'Try
'myNHunspell = New Hunspell(USaff, USdic)
'Catch ex As Exception
'If TypeOf ex Is System.DllNotFoundException Then
''Get where the dll is supposed to be
'Dim DLLpath As String = Trim(Strings.Mid(ex.Message, InStr(ex.Message, "DLL not found:") + 14))
'Dim DLLName As String = Path.GetFileName(DLLpath)
''Find out which DLL is missing
'If DLLName = "Hunspellx64.dll" Then
''Copy the dll to the directory
'Try
'File.WriteAllBytes(DLLpath, My.Resources.Hunspellx64)
'Catch ex2 As Exception
'MessageBox.Show("Error writing Hunspellx64.dll" & vbNewLine & ex2.Message)
'End Try
''Try again
'GoTo CreateNewHunspell
'ElseIf DLLName = "Hunspellx86.dll" Then 'x86 dll
''Copy the dll to the directory
'Try
'File.WriteAllBytes(DLLpath, My.Resources.Hunspellx86)
'Catch ex3 As Exception
'MessageBox.Show("Error writing Hunspellx86.dll" & vbNewLine & ex3.Message)
'End Try
''Try again
'GoTo CreateNewHunspell
'ElseIf DLLName = "NHunspell.dll" Then
'Try
'File.WriteAllBytes(DLLpath, My.Resources.NHunspell)
'Catch ex4 As Exception
'MessageBox.Show("Error writing NHunspell.dll" & vbNewLine & ex4.Message)
'End Try
'Else
'MessageBox.Show(ex.Message & ex.StackTrace)
'End If
'Else
'MessageBox.Show("SpellChecker cannot be created." & vbNewLine & "Spell checking will be disabled." & _
'vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
'myNHunspell = Nothing
'End If
'End Try
myNHunspell = HunspellObject
'See if there are any words to add
If File.Exists(callingDir & "\SpellCheck\AddedWords.dat") Then
Using r As New StreamReader(callingDir & "\SpellCheck\AddedWords.dat")
While Not r.EndOfStream
myNHunspell.Add(Trim(Replace(r.ReadLine, vbNewLine, "")))
End While
r.Close()
End Using
End If
ReDim _Text(1, -1)
ReDim _spellingErrors(-1)
FullText = ""
End Sub
#End Region
#Region "Adding or Removing Text"
''' <summary>
''' Parse the input string into its separate words
''' </summary>
''' <param name="Input"></param>
''' <remarks></remarks>
Public Sub SetText(ByVal Input As String)
'If we have already handled this with the keypress or keydown events
'This will allow for the text to change based on non-user input
If FullText = Input Then Return
'The idea here is that we need to know the start of a new word, and if the last letter
'was part of another word. wordStarted is used to determine if we have already had
'a letter or digit preceding the current char.
Dim wordStart As Integer = 1
Dim wordStarted As Boolean = False
ReDim _Text(1, -1)
ReDim _spellingErrors(-1)
ReDim _spellingErrorRanges(-1)
'set FullText
FullText = Input
Dim resetSpellingRanges As Boolean = False
'Go through every char in the textbox one by one
For i = 1 To Input.Length
If Not Char.IsLetterOrDigit(Mid(Input, i, 1)) Then
'We know it's not a letter or digit so it could be the end of a word
'Check if it's an apostrophe or hyphen, if it is, it's not the end of a word
If (Mid(Input, i, 1) = "'" Or Mid(Input, i, 1) = "-") And i <> Input.Length Then
If Char.IsLetterOrDigit(Mid(Input, i + 1, 1)) Then
'is an apostrophe or hyphen, then we just go to the next character
GoTo FoundApostrophe
End If
End If
'Check if we think this is the beginning of a word. If wordStart = i, then
'we're possibly at the beginning of a word
If wordStart <> i Then
wordStarted = False
'Now see if the word has already been added (we're not adding words
'more than once. This way we only have to spell check each word once)
Dim boolFound As Boolean = False
For j = 0 To UBound(_Text, 2)
If _Text(0, j) = Trim(Mid(Input, wordStart, i - wordStart)) Then
boolFound = True
_Text(1, j) = _Text(1, j) + 1
Exit For
End If
Next
'If the word hasn't been added, add it and then spell check it
If Not boolFound Then
ReDim Preserve _Text(1, UBound(_Text, 2) + 1)
_Text(0, UBound(_Text, 2)) = Trim(Mid(Input, wordStart, i - wordStart))
_Text(1, UBound(_Text, 2)) = 1
'Spell check it
Dim foundWord As Boolean = False
For j = 0 To UBound(_spellingErrors)
If _spellingErrors(j) = Trim(Mid(Input, wordStart, i - wordStart)) Then
foundWord = True
Exit For
End If
Next
If Not myNHunspell.Spell(_Text(0, UBound(_Text, 2))) And Not foundWord Then
ReDim Preserve _spellingErrors(UBound(_spellingErrors) + 1)
_spellingErrors(UBound(_spellingErrors)) = _Text(0, UBound(_Text, 2))
resetSpellingRanges = True
End If
End If
wordStart = i + 1
End If
Else
If Not wordStarted Then wordStart = i
wordStarted = True
End If
FoundApostrophe:
Next
'We have to check the last character separately or the last word won't be added
If Not Char.IsLetterOrDigit(Right(Input, 1)) Then
GoTo ResetSpelling
End If
'Check the last word and see it is had been added
Dim boolFound2 As Boolean = False
For j = 0 To UBound(_Text, 2)
If _Text(0, j) = Trim(Mid(Input, wordStart, Input.Length - wordStart + 1)) Then
boolFound2 = True
_Text(1, j) = _Text(1, j) + 1
Exit For
End If
Next
'If it hasn't been added, add it and spell check it
If Not boolFound2 Then
ReDim Preserve _Text(1, UBound(_Text, 2) + 1)
_Text(0, UBound(_Text, 2)) = Trim(Mid(Input, wordStart, Input.Length - wordStart + 1))
_Text(1, UBound(_Text, 2)) = 1
'Spell check it
Dim foundWord As Boolean = False
For j = 0 To UBound(_spellingErrors)
If _spellingErrors(j) = _Text(0, UBound(_Text, 2)) Then
foundWord = True
Exit For
End If
Next
If Not myNHunspell.Spell(_Text(0, UBound(_Text, 2))) And Not foundWord Then
ReDim Preserve _spellingErrors(UBound(_spellingErrors) + 1)
_spellingErrors(UBound(_spellingErrors)) = _Text(0, UBound(_Text, 2))
resetSpellingRanges = True
End If
End If
ResetSpelling:
If resetSpellingRanges Then
SetSpellingErrorRanges()
End If
End Sub
#End Region
#Region "FindPositions"
''' <summary>
''' Given a starting point, we're looking at the characters before it to find the
''' position of the first character in the word containing the starting point
''' </summary>
''' <param name="SelectionStart">0-based starting point</param>
''' <returns>0-based index of the first character in the word</returns>
''' <remarks></remarks>
Private Function FindFirstLetterOrDigitFromPosition(ByVal SelectionStart As Long) As Long
For i = SelectionStart - 1 To 0 Step -1
If Not Char.IsLetterOrDigit(FullText(i)) Then
'Need to check if it's an apostrophe or hyphen
Dim foundApOrHyph As Boolean = False
If (FullText(i) = "'" Or FullText(i) = "-") And i <> 0 Then
If Char.IsLetterOrDigit(FullText(i - 1)) Then
foundApOrHyph = True
End If
End If
If Not foundApOrHyph Then
Return i + 1
End If
End If
Next
Return 0
End Function
''' <summary>
''' Given a starting position, this will return the 0-based index representing
''' the end of a word containing the character at the starting position
''' </summary>
''' <param name="SelectionStart">0-based index</param>
''' <returns>0-based index of the last character in the word</returns>
''' <remarks></remarks>
Private Function FindLastLetterOrDigitFromPosition(ByVal SelectionStart As Long) As Long
'Character array is 0 based in this function
For i = SelectionStart To FullText.Length - 1
If Not Char.IsLetterOrDigit(FullText(i)) Then
'Need to check if it's an apostrophe or hyphen
Dim foundApOrHyph As Boolean = False
If (FullText(i) = "'" Or FullText(i) = "-") And i <> FullText.Length Then
If Char.IsLetterOrDigit(FullText(i + 1)) Then
foundApOrHyph = True
End If
End If
If Not foundApOrHyph Then
'We found the character after the end of the last word
Return i - 1
End If
End If
Next
Return FullText.Length - 1
End Function
#End Region
#Region "Spelling Functions and Subs"
''' <summary>
''' Returns the ranges of characters associated with misspelled words.
''' This is used by the CustomPaint to know where to paint the squiggly lines
''' </summary>
''' <returns>CharacterRange</returns>
''' <remarks></remarks>
Public Function GetSpellingErrorRanges() As CharacterRange()
Return _spellingErrorRanges
End Function
''' <summary>
''' Returns whether or not the text has any spelling errors
''' </summary>
''' <returns>A boolean representing whether there are spelling errors</returns>
''' <remarks></remarks>
Public Function HasSpellingErrors() As Boolean
Return (UBound(_spellingErrors) > -1)
End Function
''' <summary>
''' Sets the character ranges of the spelling errors
''' </summary>
''' <remarks></remarks>
Public Sub SetSpellingErrorRanges()
ReDim _spellingErrorRanges(-1)
If Not HasSpellingErrors() Then Return
'The idea here is that we need to know the start of a new word, and if the last letter
'was part of another word
Dim wordStart As Integer = 1
Dim wordStarted As Boolean = False
'Go through every char in FullText one by one
For i = 1 To FullText.Length
If Not Char.IsLetterOrDigit(Mid(FullText, i, 1)) Then
'We know it's not a letter or digit so it could be the end of a word
'Check if it's an apostrophe or hyphen, if it is, it's not the end of a word
If (Mid(FullText, i, 1) = "'" Or Mid(FullText, i, 1) = "-") And i <> FullText.Length Then
If Char.IsLetterOrDigit(Mid(FullText, i + 1, 1)) Then
'is an apostrophe or hyphen
GoTo FoundApostrophe
End If
End If
'Check if we think this is the beginning of a word
If wordStart <> i Then
wordStarted = False
Dim currentWord As String = Trim(Mid(FullText, wordStart, i - wordStart))
'Spell check it
For j = 0 To UBound(_spellingErrors)
If _spellingErrors(j) = currentWord Then
'Add it to the array
ReDim Preserve _spellingErrorRanges(UBound(_spellingErrorRanges) + 1)
_spellingErrorRanges(UBound(_spellingErrorRanges)) = _
New CharacterRange(wordStart - 1, currentWord.Length)
End If
Next
End If
Else
If Not wordStarted Then wordStart = i
wordStarted = True
End If
FoundApostrophe:
Next
'We have to check the last character separately or the last word won't be added
If Not Char.IsLetterOrDigit(Right(FullText, 1)) Then
Return
End If
Dim lastWord As String = Trim(Mid(FullText, wordStart, FullText.Length - wordStart + 1))
'Spell check it
For j = 0 To UBound(_spellingErrors)
If _spellingErrors(j) = lastWord Then
'Add it to the array
ReDim Preserve _spellingErrorRanges(UBound(_spellingErrorRanges) + 1)
_spellingErrorRanges(UBound(_spellingErrorRanges)) = New CharacterRange(wordStart - 1, lastWord.Length)
End If
Next
End Sub
#End Region
End Class
Submit an article or tip