1 Тема от admin

  • admin
  • admin
  • Administrator
  • Неактивен
  • Зарегистрирован: 2010-04-07
  • Сообщений: 1,226
  • Репутация : 0

Тема: Преобразование с строки символов кириллицы в латиницу и наоборот.

Функция, получает строку value  на кириллице и возвращает строку на латинице.

Function TranslitCyr2Lat(value As String) As String
    Const FUNC_NAME = {TranslitCyr2Lat}
    On Error GoTo errh
    
    Dim mas1 As Variant, mas2 As Variant
    Dim str1 As String, str2 As string
    
    str1 = "А;Б;В;Г;Д;Е;Ё;Ж;З;И;Й;К;Л;М;Н;О;П;Р;С;Т;У;Ф;Х;Ц;Ч;Ш;Щ;Ъ;Ы;Ь;Э;Ю;Я"
    str1 = str1 & ";" & LCase(str1)
    
    str2 = "A;B;V;G;D;E;JE;ZH;Z;I;Y;K;L;M;N;O;P;R;S;T;U;F;KH;C;CH;SH;JSH;HH;IH;JH;EH;JU;JA"
    str2 = str2 & ";" & LCase(str2)    
    
    mas1 = Split(str1, ";")
    mas2 = Split(str2, ";")
    
    TranslitCyr2Lat = Replace(FullTrim(value),mas1,mas2)

    Exit Function

errh:    
    Print {Ошибка: } & LIB_NAME & {-->} & FUNC_NAME & {, строка } & Erl & {, } & Error$
    Exit Function
End Function

Поделиться

2 Ответ от admin

  • admin
  • admin
  • Administrator
  • Неактивен
  • Зарегистрирован: 2010-04-07
  • Сообщений: 1,226
  • Репутация : 0

Re: Преобразование с строки символов кириллицы в латиницу и наоборот.

Обратная функция - преобразует строку с латиницы в кириллицу.

Function TranslitLat2Cyr(value As String) As String
    Const FUNC_NAME = {TranslitLat2Cyr}
    On Error GoTo errh
    
    Dim i As Integer
    Dim ch As String
    Dim str0 As String
    
    i = 1
    While(i <= len(value))    
        ch = Mid$(value, i, 1)
        If ch = "J" Or ch = "j" then' Префиксная нотация вначале
            i = i+1 ' // преходим ко второму символу сочетания
            ch = Mid$(value, i, 1)
            Select Case ch            
            case "E": str0 = str0 & "Ё"                
            case "S":
                str0 = str0 & "Щ"
                i = i+1 '// преходим к третьему символу сочетания вариант третьего символа только один                
            case "H": str0 = str0 & "Ь"
            Case "U": str0 = str0 & "Ю"
            Case "A": str0 = str0 & "Я"
                
            Case "e": str0 = str0 & "ё"
            Case "s":
                str0 = str0 & "щ"
                i = i+1 '// преходим к третьему символу сочетания вариант третьего символа только один
            Case "h": str0 = str0 & "ь"
            Case "u": str0 = str0 & "ю"
            Case "a": str0 = str0 & "я"
            End Select
            
        elseIf(i+1 < len(value) And (Mid$(value, i+1, 1) = "H" Or Mid$(value, i+1, 1) = "h")_
            and Not (i+2 < len(value) and (Mid$(value, i+2, 1)="H" Or Mid$(value, i+2, 1)="h"))) then'{// Постфиксная нотация, требует информации о двух следующих символах.
            Select Case ch
            Case "Z": str0 = str0 & "Ж"
            Case "K": str0 = str0 & "Х"
            Case "C": str0 = str0 & "Ч"
            Case "S": str0 = str0 & "Ш"
            Case "E": str0 = str0 & "Э"
            Case "H": str0 = str0 & "Ъ"
            Case "I": str0 = str0 & "Ы"
                    
            Case "z": str0 = str0 & "ж"
            Case "k": str0 = str0 & "х"
            Case "c": str0 = str0 & "ч"
            Case "s": str0 = str0 & "ш"
            Case "e": str0 = str0 & "э"
            Case "h": str0 = str0 & "ъ"
            Case "i": str0 = str0 & "ы"                
                
            End Select
            i = i+1 '// пропускаем постфикс
        Else'// одиночные символы
            Select Case ch
            Case "A": str0 = str0 & "А"
            Case "B": str0 = str0 & "Б"
            Case "V": str0 = str0 & "В"
            Case "G": str0 = str0 & "Г"
            Case "D": str0 = str0 & "Д"
            Case "E": str0 = str0 & "Е"
            Case "Z": str0 = str0 & "З"
            Case "I": str0 = str0 & "И"
            Case "Y": str0 = str0 & "Й"
            Case "K": str0 = str0 & "К"
            Case "L": str0 = str0 & "Л"
            Case "M": str0 = str0 & "М"
            Case "N": str0 = str0 & "Н"
            Case "O": str0 = str0 & "О"
            Case "P": str0 = str0 & "П"
            Case "R": str0 = str0 & "Р"
            Case "S": str0 = str0 & "С"
            Case "T": str0 = str0 & "Т"
            Case "U": str0 = str0 & "У"
            Case "F": str0 = str0 & "Ф"
            Case "C": str0 = str0 & "Ц"
                
            Case "a": str0 = str0 & "а"
            Case "b": str0 = str0 & "б"
            Case "v": str0 = str0 & "в"
            Case "g": str0 = str0 & "г"
            Case "d": str0 = str0 & "д"
            Case "e": str0 = str0 & "е"
            Case "z": str0 = str0 & "з"
            Case "i": str0 = str0 & "и"
            Case "y": str0 = str0 & "й"
            Case "k": str0 = str0 & "к"
            Case "l": str0 = str0 & "л"
            Case "m": str0 = str0 & "м"
            Case "n": str0 = str0 & "н"
            Case "o": str0 = str0 & "о"
            Case "p": str0 = str0 & "п"
            Case "r": str0 = str0 & "р"
            Case "s": str0 = str0 & "с"
            Case "t": str0 = str0 & "т"
            Case "u": str0 = str0 & "у"
            Case "f": str0 = str0 & "ф"
            Case "c": str0 = str0 & "ц"
            Case Else
                str0 = str0 & ch
            End Select
            'i = i+1 '// переходим к следующему символу
        End if            
        i = i+1 '// переходим к следующему символу
    Wend
    
    TranslitLat2Cyr = str0
    
    Exit Function

errh:    
    Print {Ошибка: } & LIB_NAME & {-->} & FUNC_NAME & {, строка } & Erl & {, } & Error$
    Exit Function
End Function

Поделиться