Attribute VB_Name = "Module2" Option Explicit Global gcsVOWELS As String Global gcsVOWELSY As String Global gcsWAY As String Global gcsAY As String Rem FROM http://www.snowcrest.net/donnelly/piglatin.html, translated to VB by Bob Function fTranslate(sTextIn As String, idir As Integer) As String Dim sPigLatin As String Dim sLine As String Dim sWord As String Dim sChar As String Dim sNewline As String Dim iMaxLength As Integer Dim bWord As Integer Dim i As Integer Dim s As String Dim iChar As Integer Dim sText As String On Error Resume Next sNewline = Chr(13) & Chr(10) iMaxLength = 10000 sText = sTextIn & " " Call strsub(sText, sNewline, "|") gcsVOWELS = "AEIOUaeiou" gcsVOWELSY = "AEIOUaeiouYy" gcsWAY = "way" gcsAY = "ay" bWord = True For iChar = 1 To Len(sText) sChar = Mid(sText, iChar, 1) If ((idir = -1 And sChar = "-") Or (sChar >= "A" And sChar <= "Z") Or sChar >= "a" And sChar <= "z" Or sChar = "'" And bWord And sWord <> "") Then If (Not bWord) Then sLine = sLine & sWord sWord = "" bWord = True End If sWord = sWord & sChar Else If bWord And sWord <> "" Then If idir = 1 Then sWord = fPigLatin(sWord) Else sWord = fUnPigLatin(sWord) End If sLine = sLine & sWord sWord = "" End If sWord = sWord & sChar bWord = False If (sChar = "|") Then sPigLatin = sPigLatin & sLine & sWord & sNewline sLine = "" sWord = "" End If End If Next sPigLatin = sPigLatin & sLine & sWord Call strsub(sPigLatin, "|", sNewline) Call strsub(sPigLatin, sNewline & sNewline, sNewline) fTranslate = sPigLatin End Function Function fUnPigLatin(psWord As String) As String Dim sWord As String Dim sFirst As String Dim sSuffix As String Dim sLast As String Dim bCapitalize As Integer Dim bCapsFlag As Integer Dim ichars As Integer On Error Resume Next sWord = Left(psWord, Len(psWord) - 2) 'MsgBox (sWord) sFirst = Left(sWord, 1) bCapitalize = (sFirst = UCase(sFirst)) sWord = LCase(sWord) ichars = InStrRev(sWord, "-") If ichars Then sSuffix = Mid(sWord, ichars + 1) sWord = Left(sWord, ichars - 1) End If If sSuffix = "w" Then sSuffix = "" sWord = sSuffix & sWord If bCapitalize Then sWord = UCase(Left(sWord, 1)) & Mid(sWord, 2) fUnPigLatin = sWord End Function Function fPigLatin(psWord As String) As String Dim sWord As String Dim sFirst As String Dim sSuffix As String Dim sLast As String Dim bCapitalize As Integer Dim bCapsFlag As Integer Dim ichars As Integer On Error Resume Next sWord = psWord sFirst = Left(sWord, 1) bCapitalize = (sFirst = UCase(sFirst)) sSuffix = "" If (InStr(gcsVOWELS, (sFirst))) Then sSuffix = gcsWAY sLast = Right(sWord, 1) If (sLast = UCase(sLast) And Len(sWord) > 1) Then sSuffix = UCase(gcsWAY) Else If sWord <> UCase(sWord) Then sFirst = LCase(sFirst) ichars = Len(sWord) - 1 Do While (ichars) ichars = ichars - 1 sSuffix = sSuffix & sFirst sLast = sFirst bCapsFlag = (sFirst = UCase(sFirst)) sWord = Mid(sWord, 2) sFirst = Left(sWord, 1) If (InStr(gcsVOWELSY, sFirst)) Then If (Not ((sLast = "q" Or sLast = "Q") And (sFirst = "u" Or sFirst = "U"))) Then Exit Do End If End If Loop If (bCapsFlag) Then sSuffix = sSuffix & UCase(gcsAY) Else sSuffix = sSuffix & gcsAY End If End If sWord = sWord & "-" & sSuffix If (bCapitalize) Then sFirst = Left(sWord, 1) sWord = UCase(sFirst) & Mid(sWord, 2) End If fPigLatin = sWord End Function