Best Fit Algorithm (Minimize Wasted Space)

416-621-9348 cgreaves@chrisgreaves.com
Home Services Products
Proper Case (Home), Camel Case , The Essential Function
The Essential Function
If you would like to inspect the all-purpose function here it is, but without a listing of its slave functions.
Function strProperCase(ByVal strIn As String, strReference As String, Optional strReplace) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Function:   strProperCase
'''
''' Comments:   Set the proper title case of a given string
'''
''' Arguments:  STRING          Source of data
'''             PARAMETER ARRAY of voide words
'''
''' Returns:    STRING
'''
''' Date        Developer       Action
''' --------------------------------------------------------------------------
''' 2009/06/05  Chris Greaves   Created
'''
Dim lngMinimumWord As Long
''' If no reference string is given, assumed camel case
If Len(strReference) = 0 Then
lngMinimumWord = 3
Else
lngMinimumWord = 0
End If
Dim strResult As String
Dim lngStartWord As Long
Dim lngEndWord As Long
lngStartWord = lngLocateNextAvailable(strIn, strAlphabet)
lngEndWord = lngLocateNextNotAvailable(strIn, strAlphabet)
While lngStartWord > 0
''' Append left end of strIn to result
If IsMissing(strReplace) Then
strResult = strResult & Left(strIn, lngStartWord - 1)
Else
If lngStartWord > 1 Then
strResult = strResult & strReplace
Else
End If
End If
strIn = Right(strIn, Len(strIn) - lngStartWord + 1)
Dim strWord As String
lngEndWord = lngLocateNextNotAvailable(strIn, strAlphabet)
If lngEndWord > 0 Then ' not yet at the end of the line
strWord = Left(strIn, lngEndWord - 1)
strIn = Right(strIn, Len(strIn) - lngEndWord + 1)
Else
strWord = strIn
strIn = ""
End If
If Len(strResult) = 0 Then ' First word of a phrase we ALWAYS capitalize
strWord = strForceCase(strWord, lngMinimumWord)
strResult = strResult & strWord
Else
If Len(strWord) = Len(UW.strOnly(strWord, UW.strcUpperAlpha)) Then ' we pass-through fully capitalized words
strResult = strResult & strWord
Else
If InStr(1, UW.strcLowerAlpha, Left(strWord, 1)) > 0 Then ' starts with a lower-case alphabetic
If blnBelongs(strWord, strReference) Then  ' belongs to our reserved set
strResult = strResult & strWord ' we pass-through reserved words
Else
strWord = strForceCase(strWord, lngMinimumWord) ' we proper-case all other candidates
strResult = strResult & strWord
End If
Else
strResult = strResult & strWord
End If
End If
End If
lngStartWord = lngLocateNextAvailable(strIn, strAlphabet)
Wend
If IsMissing(strReplace) Then
strResult = strResult & strIn ' append any trailing non-alphabetics
Else
If Len(strIn) > 0 Then
strResult = strResult & strReplace
Else
End If
End If
strProperCase = strResult
'Sub TESTstrProperCase()
'    Dim strReference As String
'    strReference = UW.strGPA(ThisDocument, UW.strcProperTitleReference, UW.strcProperTitleReferenceDefault)
'    MsgBox strProperCase("you see!", strReference)
'    MsgBox strProperCase("you see!", strReference, "_")
'    MsgBox strProperCase("you see!", strReference, "")
'    MsgBox strProperCase("you see!", "", "")
'    MsgBox strProperCase("exclamation marks used to be frowned upon. now look what's happened! we use them all the time! hurrah!!! but what is it about the age of email that gets people so over-excited?", "")
'    MsgBox strProperCase("exclamation marks used to be frowned upon. now look what's happened! we use them all the time! hurrah!!! but what is it about the age of email that gets people so over-excited?", strReference)
'End Sub
End Function
Toronto and Mississauga, Sunday, December 05, 2010 9:10 PM