英文姓名转换案例

时　间:2005-01-06 00:00:00
作　者:竹笛   ID：8  城市：上海  QQ：2851379730
摘　要:英文姓名转换案例 
正　文:

原 作 者：Jay Holovacs

译    者：竹笛

正    文：

下面的函数集可以让开发人员按规则对英文的姓名进行转换

在窗体中创建按钮Command4，在单击事件中复制下面的代码：

Private Sub Command4_Click()
Dim retval As String
retval = mixed_case("zhi qiang zhang")

Debug.Print retval
End Sub

运行后的结果为：Zhi Qiang Zhang

将下面的函数代码复制到窗体模块中：

'************** Code Start *************
'This code was originally written by Jay Holovacs.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Jay Holovacs
'
Public Function mixed_case(str As Variant) As String
'returns modified string, first character of each word us uppercase
'all others lower case
Dim ts As String, ps As Integer, char2 As String
    If IsNull(str) Then
        mixed_case = ""
        Exit Function
    End If
    str = Trim(str) 'added 11/22/98
    If Len(str) = 0 Then
        mixed_case = ""
        Exit Function
    End If
    ts = LCase$(str)
    ps = 1
    ps = first_letter(ts, ps)
    special_name ts, 1 'try to fix the beginning
    Mid$(ts, 1) = UCase$(Left$(ts, 1))
    If ps = 0 Then
        mixed_case = ts
        Exit Function
    End If
    While ps <> 0
        If is_roman(ts, ps) = 0 Then 'not roman, apply the other rules
            special_name ts, ps
            Mid$(ts, ps) = UCase$(Mid$(ts, ps, 1)) 'capitalize the first letter
        End If
        ps = first_letter(ts, ps)
    Wend
    mixed_case = ts
End Function
Private Sub special_name(str As String, ps As Integer)
'expects str to be a lower case string, ps to be the
'start of name to check, returns str modified in place
'modifies the internal character (not the initial)

Dim char2 As String
char2 = Mid$(str, ps, 2) 'check for Scots Mc
If (char2 = "mc") And Len(str) > ps + 1 Then '3rd char is CAP
    Mid$(str, ps + 2) = UCase$(Mid$(str, ps + 2, 1))
End If

char2 = Mid$(str, ps, 2) 'check for ff
If (char2 = "ff") And Len(str) > ps + 1 Then 'ff form
    Mid$(str, ps, 2) = LCase$(Mid$(str, ps, 2))
End If

char2 = Mid$(str, ps + 1, 1) 'check for apostrophe as 2nd char
If (char2 = "'") Then '3rd char is CAP
    Mid$(str, ps + 2) = UCase$(Mid$(str, ps + 2, 1))
End If

Dim char3 As String
char3 = Mid$(str, ps, 3) 'check for scots Mac
If (char3 = "mac") And Len(str) > ps + 1 Then 'Mac form
    Mid$(str, ps + 3) = UCase$(Mid$(str, ps + 3, 1))
End If

Dim char4 As String
char4 = Mid$(str, ps, 4) 'check for Fitz
If (char4 = "fitz") And Len(str) > ps + 1 Then 'Fitz form
    Mid$(str, ps + 4) = UCase$(Mid$(str, ps

Access软件网QQ交流群 (群号:54525238) 　　　　　　Access源码网店