We wrote one and it works well enough... not pretty though. You may also
need some other functions from our library.
function ProperExceptions(const sValue: String): String;
var
lY, iLen, iZ, iY, iX: Integer;
sWork, sCharUp, sWord: String;
sUp, sTest: ShortString;
bNew, bFound, bPropered: Boolean;
lstDel, lstEx: TStringList;
const
WordSepSet: set of Char = [#0..#38, #40..#64, #91..#95, #123..#137, #139,
#145..#153, #155, #171, #187, ' ', '-'];
// These MUST be in alphabetical order by the first character. Subsequent
// characters are irrelevant
ExceptUpperSet: array [1..67] of ShortString = (
'AARP', 'ACCT', 'ADJ', 'AA', 'AE', 'AK', 'AL', 'AP', 'AR', 'AS', 'AZ',
'CA', 'CO', 'CPA', 'CRNA', 'CLM', 'DED', 'DE', 'DOS', 'EOB',
'GA', 'GU', 'HI', 'HMO', 'IA', 'ID', 'IL', 'IN', 'II', 'III',
'IPO', 'IPA', 'IV', 'IX', 'KY', 'LA',
'MA', 'ME', 'MI', 'MCD', 'MCR', 'MCDMO', 'MO',
'NE', 'NY', 'NIP', 'OH', 'OK', 'OR', 'PA', 'PO', 'PPO', 'REF',
'RI', 'US', 'USA', 'UT', 'VI', 'VII', 'VIII', 'VA',
'WA', 'WI', 'WY', 'XI', 'XII', 'XIII');
ExceptStartSet: array [1..2] of ShortString = (
'Mc', 'Mac');
ExceptMixedSet: array [1..8] of ShortString = (
'Blvd', 'Dr', 'Ft', 'Ln', 'PhD', 'Pl', 'Rd', 'St');
ExceptLowerSet: array [1..24] of ShortString = (
'a', 'am', 'a.m.', 'an', 'as', 'and', 'at', 'by', 'cm', 'for',
'if', 'in', 'into', 'is', 'it', 'mm', 'mph', 'on', 'of',
'pm', 'p.m.', 'to', 'the', 'with');
begin
Result := '';
lstEx := TStringList.Create;
lstDel := TStringList.Create;
try
lstEx.Clear;
bNew := False;
sWork := '';
for lY := 1 to Length(sValue) do
begin
if (sValue[lY] in WordSepSet) then
begin
bNew := False;
lstEx.Add(sWork);
lstDel.Add(sValue[lY]);
sWork := '';
end
else
begin
bNew := True;
sWork := sWork + Copy(sValue,lY,1);
end;
end;
if bNew then
begin
lstDel.Add('');
lstEx.Add(sWork);
end;
for iX := 0 to lstEx.Count - 1 do
begin
if lstEx[iX] = '' then
Continue;
bFound := False;
bPropered := False;
try
if Length(lstEx[iX]) > 3 then
begin
for iY := Low(ExceptStartSet) to High(ExceptStartSet) do
begin
sTest := Copy(UpperCase(lstEx[iX]), 1,
Length(ExceptStartSet[iY]));
if sTest = UpperCase(ExceptStartSet[iY]) then
begin
// if it's Mc or Mac and uppercase leave it alone
if lstEx[iX] = UpperCase(lstEx[iX]) then
begin
bPropered := True;
Break;
end
else
// if it's Mc or Mac propercase it
begin
// It will generally be longer names so dont do this on
short words
if Length(lstEx[iX]) <= 6 then
Break;
iLen := Length(ExceptStartSet[iY]);
sWord := Copy(lstEx[iX], iLen + 2, 99999999);
sCharUp := UpperCase(Copy(lstEx[iX], iLen + 1, 1));
lstEx[iX] := ExceptStartSet[iY] + sCharUp + sWord;
bPropered := True;
Break;
end;
end;
end;
if bPropered then
Continue;
end;
sTest := Trim(LowerCase(lstEx[iX]));
// Check to see if the first word is Saint or Doctor
if ((Length(sTest) = 2) or ((Length(sTest) = 3) and (sTest[3] =
'.')))
and (iX = 0) then
begin
if StrEqual(sTest, 'st')
or StrEqual(sTest, 'dr') then
begin
lstEx[iX] := Uppercase(sTest[1]) + Copy(sTest, 2, 9999);
Continue;
end;
end;
// Quickly check for mixed case words
if (Length(lstEx[iX]) < 5) then
begin
for iY := Low(ExceptMixedSet) to High(ExceptMixedSet) do
begin
if (Ord(sTest[1]) < Ord(LowerCase(ExceptMixedSet[iY])[1])) then
Break;
if (sTest[0] <> ExceptMixedSet[iY][0]) then
Continue;
if sTest = LowerCase(ExceptMixedSet[iY]) then
begin
lstEx[iX] := ExceptMixedSet[iY];
bFound := True;
Break;
end;
end;
if bFound then
Continue;
end;
// Quickly check for lower case words
if (Length(lstEx[iX]) < 5)
and (iX > 0) then
begin
for iY := Low(ExceptLowerSet) to High(ExceptLowerSet) do
begin
if Ord(sTest[1]) < Ord(ExceptLowerSet[iY][1]) then
Break;
if (sTest[0] <> ExceptLowerSet[iY][0]) then
Continue;
if sTest = ExceptLowerSet[iY] then
begin
lstEx[iX] := ExceptLowerSet[iY];
bFound := True;
Break;
end;
end;
if bFound then
Continue;
end;
// Check for words that should be uppercased
if Length(lstEx[iX]) < 5 then
begin
sUp := Trim(UpperCase(lstEx[iX]));
for iY := Low(ExceptUpperSet) to High(ExceptUpperSet) do
begin
if Ord(sUp[1]) < Ord(ExceptUpperSet[iY][1]) then
Break;
if (sUp[0] <> ExceptUpperSet[iY][0]) then
Continue;
if sUp = ExceptUpperSet[iY] then
begin
lstEx[iX] := ExceptUpperSet[iY];
bFound := True;
Break;
end;
end;
if bFound then
Continue;
end;
if ((Length(sTest) = 2) and (sTest[2] = 'r'))
or ((Length(sTest) = 3) and (sTest[3] = '.')) then
begin
Continue;
end;
if Length(Trim(lstEx[iX])) < 2 then
begin
lstEx[iX] := UpperCase(lstEx[iX]);
bFound := True;
Continue;
end;
// Check for words with numbers and no vowels. Uppercase if found.
// CSC - 03/03/03 - There are all sorts of reasons why it should
propercase
// and some where it should uppercase such as a users initials.
Rather
// than trying to figure it out, we just ignore them and use
what the
// user sent us. Keep that in mind on any changes.
bFound := True;
for iZ := 1 to Length(sTest) do
begin
if sTest[iZ] in ['1', '2', '3', '4', '5', '6', '7', '8', '9', '0']
then
Break;
if sTest[iZ] in ['.'] then
begin
lstEx[iX] := UpperCase(lstEx[iX]);
Break;
end;
if sTest[iZ] in ['a', 'e', 'i', 'o', 'u', 'y'] then
begin
bFound := False;
Break;
end;
end;
if bFound then
begin
if Length(Trim(sValue)) < 3 then
lstEx[iX] := UpperCase(lstEx[iX])
else
begin
if StrEqual(lstEx[iX], 'CT')
and (lstEx.Count > 2)
and (iX > 1) then
lstEx[iX] := 'Ct';
end;
Continue;
end;
// Check for email/web/ftp addresses and paths. Lowercase if found.
bFound := False;
if Length(sTest) > 4 then
begin
if (RightStr(sTest, 5) = '.info') then
bFound := True;
end
else
if Length(sTest) > 3 then
begin
if (RightStr(sTest, 4) = '.com')
or (RightStr(sTest, 4) = '.net')
or (RightStr(sTest, 4) = '.org') then
begin
bFound := True;
end
end
else
if Length(sTest) > 2 then
begin
if (RightStr(sTest, 3) = '.ws') //website
or (RightStr(sTest, 3) = '.ph') //phone
or (RightStr(sTest, 3) = '.co') //commercial
or (RightStr(sTest, 3) = '.ac') //other countries
or (RightStr(sTest, 3) = '.as')
or (RightStr(sTest, 3) = '.be')
or (RightStr(sTest, 3) = '.ca')
or (RightStr(sTest, 3) = '.cc')
or (RightStr(sTest, 3) = '.de')
or (RightStr(sTest, 3) = '.dk')
or (RightStr(sTest, 3) = '.dr')
or (RightStr(sTest, 3) = '.fm')
or (RightStr(sTest, 3) = '.gs')
or (RightStr(sTest, 3) = '.jp')
or (RightStr(sTest, 3) = '.kz')
or (RightStr(sTest, 3) = '.lt')
or (RightStr(sTest, 3) = '.ms')
or (RightStr(sTest, 3) = '.ro')
or (RightStr(sTest, 3) = '.to')
or (RightStr(sTest, 3) = '.st')
or (RightStr(sTest, 3) = '.sh')
or (RightStr(sTest, 3) = '.tc')
or (RightStr(sTest, 3) = '.tv')
or (RightStr(sTest, 3) = '.vg')
or (RightStr(sTest, 3) = '.vu') then
begin
bFound := True;
end;
end;
if bFound then
begin
lstEx[iX] := LowerCase(lstEx[iX]);
Continue;
end;
finally
if (not bFound)
and(not bPropered) then
begin
lstEx[iX] := UpCase(lstEx[iX][1])
+ LowerCase(Copy(lstEx[iX], 2, 9999999));
end;
end;
end;
finally
for lY := 0 to lstEx.Count - 1 do
Result := Result + lstEx[lY] + lstDel[lY];
lstEx.Free;
lstDel.Free;
end;
end;
----- Original Message -----
From: "M Tuttle" <[EMAIL PROTECTED]>
To: "Delphi - Talk" <delphi-talk@elists.org>
Sent: Monday, June 19, 2006 2:12 PM
Subject: Anyone know a name formatings function that will change mcdonald
toMcDonald?
> Greetings All,
>
> Without reinventing the wheel, does anyone know of an existing function
> where I can pass a persons last name of mcdonald and return McDonald, or
> pass it leforte and return LeForte and if passed smith it returns Smith
>
> Thanks,
>
> Michael Tuttle
> Software Technologies, Inc.
> Topeka, KS
>
>
> __________________________________________________
> Delphi-Talk mailing list -> Delphi-Talk@elists.org
> http://www.elists.org/mailman/listinfo/delphi-talk
>
>
__________________________________________________
Delphi-Talk mailing list -> Delphi-Talk@elists.org
http://www.elists.org/mailman/listinfo/delphi-talk
