Web Wiz - Green Windows Web Hosting

  New Posts New Posts RSS Feed - Grammar/spelling function
  FAQ FAQ  Forum Search   Events   Register Register  Login Login

Grammar/spelling function

 Post Reply Post Reply
Author
Gullanian View Drop Down
Senior Member
Senior Member
Avatar

Joined: 04 January 2002
Location: England
Status: Offline
Points: 4373
Post Options Post Options   Thanks (0) Thanks(0)   Quote Gullanian Quote  Post ReplyReply Direct Link To This Post Topic: Grammar/spelling function
    Posted: 11 November 2003 at 6:48pm

For some software im writting I decided to create a simple grammatical/spelling fixer function.  I thought some of you might find it useful, so here it is.  If you have any improvements please post them here so I can improve it!

'Function to proper case a string and fix simple grammatical errors

Public function properCase(byVal strInput)

Dim lngStringLength 'Holds length of string

Dim strTemp 'Holds temporary string

Dim strTemp2 'Secondary temp

Dim intWordsToCheck 'Number of words to check

Dim strSpellingErrors(7) 'Spelling errors array

Dim strSpellingFix(7) 'Spelling fixes

Dim intLengthOfError 'Holds length of error

Dim intArraySize 'Array size for convenience

'Initialise

intWordsToCheck = 0

strSpellingErrors(0) = "isnt"

strSpellingFix(0) = "isn't"

strSpellingErrors(1) = "alot"

strSpellingFix(1) = "a lot"

strSpellingErrors(2) = "its"

strSpellingFix(2) = "it's"

strSpellingErrors(3) = "theyre"

strSpellingFix(3) = "they're"

strSpellingErrors(4) = "whos"

strSpellingFix(4) = "who's"

strSpellingErrors(5) = "dont"

strSpellingFix(5) = "don't"

strSpellingErrors(6) = "lets"

strSpellingFix(6) = "let's"

strSpellingErrors(7) = "thier"

strSpellingFix(7) = "their"

intArraySize = 7

intArraySize = intArraySize + 1

'Set entire string to lower case

strInput = trim(lCase(strInput))

'Replace little i with I

strInput = replace(strInput," i "," I ")

'Common grammatical error fixes

'MID SENTENCE

intWordsToCheck = 0

Do until intWordsToCheck = intArraySize

strInput = replace(strInput," " & strSpellingErrors(intWordsToCheck) & " "," " & strSpellingFix(intWordsToCheck) & " ")

'Add to counter

intWordsToCheck = intWordsToCheck + 1

Loop

'Loop through all errors and fixes

'SENTENCE START

intWordsToCheck =0

Do until intWordsToCheck = intArraySize

'Get properties

intLengthOfError = len(strSpellingErrors(intWordsToCheck)) + 1

If left(strInput,intLengthOfError) = strSpellingErrors(intWordsToCheck) & " " then

lngStringLength = len(strInput)

strTemp = right(strInput,lngStringLength-intLengthOfError)

strInput = strSpellingFix(intWordsToCheck) & " " & strTemp

End if

'Add to counter

intWordsToCheck = intWordsToCheck + 1

Loop

'Loop through all errors and fixes

'SENTENCE END

intWordsToCheck =0

Do until intWordsToCheck = intArraySize

'Get properties

intLengthOfError = len(strSpellingErrors(intWordsToCheck)) + 1

If right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) then

lngStringLength = len(strInput)

strTemp = left(strInput,lngStringLength-intLengthOfError)

strInput = strTemp & " " & strSpellingFix(intWordsToCheck)

'Check for full stops, etc

Else

'Get properties

intLengthOfError = len(strSpellingErrors(intWordsToCheck)) + 2

If right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) & "." OR right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) & "?" OR right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) & "!" OR right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) & ":" OR right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) & ";" then

lngStringLength = len(strInput)

strTemp2 = right(strInput,1)

strTemp = left(strInput,lngStringLength-intLengthOfError)

strInput = strTemp & " " & strSpellingFix(intWordsToCheck) & strTemp2

End if

End if

'Add to counter

intWordsToCheck = intWordsToCheck + 1

Loop

'Check for a full stop

strTemp = right(strInput,1)

If strTemp <> "?" AND strTemp <> "!" AND strTemp <> "." AND strTemp <> """" AND strTemp <> ":" AND strTemp <> ";" AND strTemp <> "'" then

strInput = strInput & "."

End if

'Get length

lngStringLength = len(strInput)

'Set temp

strTemp = right(strInput,lngStringLength-1)

'Set first letter

strInput = uCase(left(strInput,1))

'Reset

strInput = strInput & strTemp

'Return value

properCase = strInput

End function

Back to Top
ljamal View Drop Down
Mod Builder Group
Mod Builder Group


Joined: 16 April 2003
Status: Offline
Points: 888
Post Options Post Options   Thanks (0) Thanks(0)   Quote ljamal Quote  Post ReplyReply Direct Link To This Post Posted: 11 November 2003 at 8:24pm
One problem, "its" isn't always an error.
Back to Top
 Post Reply Post Reply

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 12.08
Copyright ©2001-2026 Web Wiz Ltd.


Become a Fan on Facebook Follow us on X Connect with us on LinkedIn Web Wiz Blogs
About Web Wiz | Contact Web Wiz | Terms & Conditions | Cookies | Privacy Notice

Web Wiz is the trading name of Web Wiz Ltd. Company registration No. 05977755. Registered in England and Wales.
Registered office: Web Wiz Ltd, Unit 18, The Glenmore Centre, Fancy Road, Poole, Dorset, BH12 4FB, UK.

Prices exclude VAT at 20% unless otherwise stated. VAT No. GB988999105 - $, € prices shown as a guideline only.

Copyright ©2001-2026 Web Wiz Ltd. All rights reserved.