Транслитерация для букв греческого алфавита

При распознавании текстов, посвященных античной истории часто возникает проблема: что делать с греческими буквами? Впрочем, проблема не такая уж и большая; среди рядовых любителей истории мало найдется знатоков и ценителей греческого языка. Греческие буквы можно просто выбросить, или оставить абракадабру, получившуюся в результате распознавания, никто по этому поводу огорчаться не будет. Fine Reader, между прочим знает и распознает греческие буквы, вот только результат такого распознавания не всегда удовлетворителен: во-первых Fine Reader не всегда узнает места написанные по-гречески, а во-вторых, вычитывать сколь-либо большие куски греческого текста, без знания языка, попросту невозможно.
Допустим, вы достаточно дотошны и скрупулезны, и всенепременно хотите, чтобы в распознанном вами тексте были греческие слова. Можно, конечно, подключить греческую раскладку. Можно подыскать виртуальную клавиатуру, поддерживающую греческий язык. В конце концов, можно использовать штанное средство Word’а – вставка символов.
Я достаточно ленив, чтобы что-то устанавливать на свой компьютер, нужное лишь эпизодически, но в то же время, достаточно квалифицирован, чтобы решить проблему подручными средствами.
Я написал макрос для Word’а, который вместо меня пишет греческие буквы.
Первым делом я попытался найти готовое решение и подобрать программу транслитерации для греческого алфавита. То, что я нашел, меня не вполне устраивало. И я пошел своим путем.
Сначала я составил свою таблицу перевода латиницы и кириллицы в греческие буквы. В первую очередь я исходил из фонетического звучания, во-вторую из начертания. В-третьях, мне нужна была не полноценная система транслитерации, а простая схема замены латинских и русских символов на греческие. Важно было добиться того, чтобы текст заменялся за один проход программы, без излишнего усложнения алгоритма.

Вот таблица соответствия:

Греческие буквы

  Латиница

  Кириллица

 Α α

 A a

 А а

 Ά ά

 -A -a

 -А -а

 Β β

 B b

 Б б В в

 Γ γ

 G g

 Г г

 Δ δ

 D d

 Д д

 Ε ε

 E e

 Е е

 Έ έ

 -E -e

 -Е -е

 Ζ ζ

 Z z

 З з

 Η η

 H h

 Э э

 Ή ή

 -H -h

 -Э -э

 Θ
θ

 -TH -th

 -Т -т

 Ι
ι

 I i

 И
и

 Ί
ί

 -I -i

 Й
й

 Ϊ ϊ

 :I :i

 :И :и

  ΐ

 -:i

 :й

 Κ κ

 K k

 К к

 Λ λ

  L l

 Л л

 Μ μ

 M m

 М м

 Ν ν

 N n v

 Н н

 Ξ ξ

 X x

 -Х -х

 Ο ο

 O o

 О о

 Ό ό

 -O -o

 -О -о

 Π π

 P p

  П п

 Ρ ρ

 R r

 Р р

 Σ σ

 S s

 С с

 ς

 c

 ц

 Τ τ

 T t

 Т т

 Υ υ

 U u Y y

 У у

 Ύ ύ

-U -u -Y -y

 -У -у

 Ϋ ϋ

 :U :u :Y :y

 :У :у

  ΰ

 -:u -:y

 -:у

 Φ φ

 -PH -ph

  Ф ф 

 Χ χ

 -CH -ch

 Х х

 Ψ ψ

 -PS -ps

 -Ж ж

 Ω ω

 W w

 Ш ш

 Ώ ώ

 -W -w

 -Ш -ш

 

 А вот текст макроса: 

Function Translit(Simv)
Result = ""

Select Case Simv
Case "a", "а"
Result = ChrW(945)
Case "-a", "-а"
Result = ChrW(940)
Case "b", "б", "в"
Result = ChrW(946)
Case "g", "г"
Result = ChrW(947)
Case "d", "д"
Result = ChrW(948)
Case "e", "е"
Result = ChrW(949)
Case "-e", "-е"
Result = ChrW(941)
Case "z", "з"
Result = ChrW(950)
Case "h", "э"
Result = ChrW(951)
Case "-h", "-э"
Result = ChrW(942)
Case "-th", "-т"
Result = ChrW(952)
Case "i", "и"
Result = ChrW(953)
Case "-i", "й"
Result = ChrW(943)
Case ":i", ":и"
Result = ChrW(970)
Case "-:i", ":й"
Result = ChrW(912)
Case "k", "к"
Result = ChrW(954)
Case "l", "л"
Result = ChrW(955)
Case "m", "м"
Result = ChrW(956)
Case "n", "v", "н"
Result = ChrW(957)
Case "x", "-х"
Result = ChrW(958)
Case "o", "о"
Result = ChrW(959)
Case "-o", "-о"
Result = ChrW(972)
Case "p", "п"
Result = ChrW(960)
Case "r", "р"
Result = ChrW(961)
Case "c", "ц"
Result = ChrW(962)
Case "s", "с"
Result = ChrW(963)
Case "t", "т"
Result = ChrW(964)
Case "u", "y", "у"
Result = ChrW(965)
Case "-u", "-y", "-у"
Result = ChrW(973)
Case ":u", ":y", ":у"
Result = ChrW(971)
Case "-:u", "-:y", "-:у"
Result = ChrW(944)
Case "-ph", "ф"
Result = ChrW(966)
Case "-ch", "х"
Result = ChrW(967)
Case "-ps", "ж"
Result = ChrW(968)
Case "w", "ш"
Result = ChrW(969)
Case "-w", "-ш"
Result = ChrW(974)
End Select

Translit = Result

End Function

Sub ГрекоПись()
' транлитерация латиницы и кириллицы в греческие буквы
' используется моя система :)
Neuchet = " .,!?1234567890"

Text = Selection.Text
GreekText = ""

Simv = ""
For i = 1 To Len(Text)
Dob = Mid(Text, i, 1)
If Dob = UCase(Dob) Then
bigLetter = True
Else
bigLetter = False
End If
Simv = LCase(Simv + LCase(Dob))
If InStr(Neuchet, Simv) > 0 Then
GreekText = GreekText + Simv
Simv = ""
Else
If Len(Simv) > 3 Then
MsgBox ("Какая-то фигня! проверьте написание")
Stop
End If
greekSimv = Translit(Simv)
If greekSimv <> "" Then
If bigLetter Then
greekSimv = UCase(greekSimv)
End If
GreekText = GreekText + greekSimv
Simv = ""
End If
End If
Next
Selection.Text = GreekText

End Sub

Скопируйте текст макроса, и вставьте его в свой Normal.dot , в меню «Макросы» у вас появится макрос «ГрекоПись». Наберите текст, пользуясь таблицей соответствия, выделите этот текст, вызовите макрос и вуаля! Ваш текст будет написан по-гречески.

Пример: пишем Але-хандроц Мегац, получаем Αλεξανδρος Μεγας