программирование :: разное

перекодировка клавиатуры

После публикации ряда статей на тему перекодировки клавиатуры, мне пришло несколько писем с просьбой помочь переделать макрос таким образом, чтобы вместо перекодировки символов "по раскладке клавиатуры" перекодировка производилась "по звуку", обозначаемому соответствующими символами. Для чего это нужно? Сейчас объясню, но прежде ответьте на вопрос: Пишете ли Вы письма (е-mail) знакомым, живущим за границей? Если у Вас таких знакомых нет и не предвидится, можете дальше не читать, а те, кому за рубеж писать приходится довольно часто, уже, наверное, поняли, о чем идет речь.

Все дело в том, что при переправке письма из нашей любимой родины в далекие теплые или не очень страны, с ним происходят порой такие превращения, что прочитать его просто невозможно. Причины сего исходят со времен создания компьютеров и различных стандартов кодировки символов. При пересылке письмо проходит через множество серверов и шлюзов, которые конвертируют текст письма в свою кодировку. Некоторым стандартом является кодировка KOI-8, но, к сожалению, не все серверы работают именно с ней. Должен заметить, что большинство кодировок совпадают в части английского алфавита, откуда и вырисовывается как решение, так и очередная проблема, которую я и предлагаю решить.

Конечно, при определенной сноровке можно написать русский текст и английскими буквами, но, скажу вам по своему опыту, не очень уж это приятное занятие, постоянно сбиваешься на кириллицу. В конце концов, мне такое положение дел порядком надоело, и я написал макрос, который преобразует русские буквы в латинские по их звучанию. После этого переписываться стало гораздо проще. А немного погодя, я решил, что читать русские буквы будет гораздо приятнее, чем латинские, и написал макрос обратной конвертации.

Теперь давайте разберемся, каким образом следует производить преобразование. С первого взгляда все кажется довольно просто: ставим в соответствие буквы - и все готово (смотрите таблицу 1).

Таблица 1

Lat

A

B

C

D

E

F

G

H

I

J

K

L

М

N

O

P

R

S

T

U

V

W

Y

Z

Рус

А

Б

Ц

Д

Е

Ф

Г

Х

И

Й

К

Л

М

Н

О

П

Р

С

Т

У

В

В

Ы

З


Как Вы можете заметить, в таблице отсутствуют несколько букв из латинского и русского алфавитов. Латинские буквы Q и X, а также русские Ж, Ш, Щ, Ч и некоторые другие, невозможно поставить в строгое соответствие из-за отсутствия букв, обозначающих эти же звуки в противоположном алфавите. Конечно, можно назначить буквам Q и X какие-либо из букв русского алфавита, а недостающим русским буквам - какие-либо символы типа ^, #, @ и так далее, но ведь нам нужно сохранить читаемость сообщения и без наличия переводящей программы, поэтому так не пойдет.

Отсюда явственно следует, что использовать надо стандартные комбинации символов, применяемые на почте при написании адреса на корреспонденции, идущей к нам из-за границы (смотрите таблицу 2).

Таблица 2

Lat

JO

ZH

SCH

CH

SH

JU

JA

Ь

Рус

Е

Ж

Щ

Ч

Ш

Ю

Я

'


Теперь видно, что все буквы вполне читабельны. Правда, среди русских букв не хватает Ъ, но тут уж ничего не поделаешь, заменить его в латинском алфавите нечем, благо, что Ь заменяется апострофом ('), он ведь тоже смягчение обозначает.

Все вышеописанное было применено для написания макроса преобразования текста, написанного кириллицей, в латиницу.

Однако, когда я начал писать макрос обратной конвертации из латиницы в кириллицу, то столкнулся с некоторыми проблемами. Во-первых, нужно было отслеживать комбинации букв типа SCHаЩ, SHаШ, и т.д. Во-вторых, у некоторых букв есть множественное определение, т.е. когда пишут "оттуда", варианты букв бывают различные, даже в одном письме; например, буква Я может быть написана как JA, так и YA, поэтому пришлось учитывать и эту тонкость.

Привожу тексты макросов, производящих преобразования.

'Определяем константы для подстановки "однозначных" букв на уровне модуля.
'Для доступности к ним из обоих макросов.
Const AlphLat$ = "VERTYUIOPASDFGHJKLZVBNMCvertyuiopasdfghjklzvbnmc'"
Const AlphRus$ = "ВЕРТЫУИОПАСДФГХЙКЛЗВБНМЦвертыуиопасдфгхйклзвбнмць"
'Определяем переменные для массивов с "неоднозначными" буквами.
Dim OtherCharR, OtherCharL
'Определяем константы используемых длин массивов. Это необходимо для того, чтобы при перекодировке Rus->Lat использовался не весь массив, а только его часть.
Const CountOtherCharRL = 40
Const CountOtherCharLR = 18
'Определяем функцию назначения переменным OtherCharR и OtherCharL значений "неоднозначных" символов. Используется отдельная функция, т.к. функция "Array()" не работает на уровне модуля, а присваивать значение каждому элементу массива — это лишние 80 строчек кода.
Function SetArr(ByRef ArrLat As Variant, ByRef ArrRus As Variant)
ArrLat = Array("Jo", "Zh", "Sch", "Ch", "Sh", "Ju", "Ja", "Je", "W", _
"jo", "zh", "sch", "ch", "sh", "ju", "ja", "je", "w", "`", _
"ZH", "SCH", "CH", "SH", _
"JU", "YU", "Yu", "yu", _
"JE", "Je", "je", "YE", "Ye", "ye", _
"JA", "YA", "Ya", "ya", _
"JO", "YO", "Yo", "yo")
ArrRus = Array("Е", "Ж", "Щ", "Ч", "Ш", "Ю", "Я", "Е", "В", _
"е", "ж", "щ", "ч", "ш", "ю", "я", "е", "в", "ь", _
"Ж", "Щ", "Ч", "Ш", _
"Ю", "Ю", "Ю", "ю", _
"Е", "Е", "е", "Е", "Е", "е", _
"Я", "Я", "Я", "я", _
"Е", "Е", "Е", "е")
End Function

'Определяем функцию ReplaceStr. Она заменяет в строковой переменной strResurs$, начиная с позиции intStart, количество символов определенное в переменной intCount, на строку strSubString$. Функция понадобится в макросе КириллицаЗвук()
Function ReplaceStr(ByVal strResurs$, ByVal intStart, ByVal intCount, ByVal strSubString$) As String
SBeg$ = Left(strResurs$, intStart — 1)
SEnd$ = Right(strResurs$, Len(strResurs$) — intStart — intCount + 1)
ReplaceStr = SBeg$ & strSubString$ & SEnd$
End Function

'Определяем макрос перекодировки Lat->Rus. Почему "Звук"? Да потому, что пишется по-разному, а слышится одинаково.
Public Sub КириллицаЗвук()
'Определяем действия в случае возникновения ошибки.
On Error Resume Next
'Проверяем, если выделение не определено, заканчиваем выполнение функции.
If WordBasic.GetSelStartPos() = WordBasic.GetSelEndPos() Then Exit Sub
'Вызываем функцию определения массивов "неоднозначных" символов.
SetArr OtherCharL, OtherCharR
'Присваиваем переменной StrZam$-выделенный фрагмент текста.
StrZam$ = Selection.Text

' Если последний символ — символ абзаца, отбрасываем его, т.к. при вставке результата Word сам добавляет этот символ
If Asc(Right(StrZam, 1)) = 13 Then StrZam$ = Left(StrZam$, Len(StrZam$) — 1)
'Назначаем пустые переменные StrRez$ — для результата, StrRez3$ — для своеобразного кэша длиной в 3 символа, именно в этой переменной и будут отслеживаться составные "неоднозначные" символы.
StrRez$ = ""
StrRez3$ = ""
'Определяем переменную и присваеваем ей значение длины перекодируемой строки. Используется для ускорения работы макроса, т.к. каждый раз вызывать функцию "Len()" занимает больше времени, чем при использовании готового значения.
LenStrZam = Len(StrZam$)
'Определяем начальное значение параметра цикла "i"
i = 1
' Запускаем цикл по всем символам исходной строки
Do
' Вырезаем по одному символу, и передаем его в наш кэш StrRez3$
TecChar$ = Mid(StrZam$, i, 1)
StrRez3$ = StrRez3$ + TecChar$
'Проверяем, если количество символов в кэше более или равно трем или исходная строка заканчивается, то обрабатываем кэш.
If (Len(StrRez3$) >= 3) Or (i >= LenStrZam — 3) Then
'Проверяем в цикле наличие в кэше "неоднозначных" символов, и если такие находим, то заменяются на соответствующие им русские буквы.
For j = 0 To CountOtherCharRL
NumOC = InStr(1, StrRez3$, OtherCharL(j), 0)
If NumOC <> 0 Then
StrRez3$ = ReplaceStr(StrRez3$, NumOC, Len(OtherCharL(j)), OtherCharR(j))
Exit For
End If
Next j

' Вынимаем из кэша первый символ и присваиваем его переменной S$
S$ = Left(StrRez3$, 1)
StrRez3$ = Mid(StrRez3$, 2)

'Проверяем наличие символа S$ в латинском алфавите однозначных символов, и если находим, заменяем его на соответствующий символ русского алфавита.
NumChar = InStr(AlphLat$, S$)
If NumChar <> 0 Then S$ = Mid(AlphRus$, NumChar, 1)
'Составляем результирующую строку.
StrRez$ = StrRez$ + S$
End If
'Увеличиваем счетчик цикла.
i = i + 1
'Выходим из цикла, если обрабатываемая строка закончилась (i >= LenStrZam) и кэш пуст (StrRez3$="")
Loop Until i >= LenStrZam And StrRez3$ = ""
'Включаем проверку Русской орфографии.
Selection.LanguageID = wdRussian
'Вставляем перекодированную строку
WordBasic.Insert StrRez$
End Sub

'Для перевода Rus->Lat макрос и того проще, т.к. нам не нужно разыскивать "длинные" символы типа SCH, SH и др. Не хочу повторяться в комментариях, одинаковые строки смотрите в макросе КириллицаЗвук()
Public Sub ЛатиницаЗвук()
On Error Resume Next
If WordBasic.GetSelStartPos() = WordBasic.GetSelEndPos() Then Exit Sub

SetArr OtherCharL, OtherCharR

StrZam$ = Selection.Text
If Asc(Right(StrZam, 1)) = 13 Then StrZam$ = Left(StrZam$, Len(StrZam$) — 1)

StrRez$ = ""

For i = 1 To Len(StrZam$)
TecChar$ = Mid(StrZam$, i, 1)

'Находим символ в русском алфавите "однозначных" символов AlphRus$
NumTecChar = InStr(AlphRus$, TecChar$)
'и заменяем его на английский.
If NumTecChar <> 0 Then
TecChar$ = Mid(AlphLat$, NumTecChar, 1)
Else
'Если символ в русском алфавите "однозначных" символов отсутствует, ищем его в " неоднозначных"
For j = 0 To CountOtherCharLR
If TecChar$ = OtherCharR(j) Then
TecChar$ = OtherCharL(j)
Exit For
End If
Next j
End If

StrRez$ = StrRez$ + TecChar$

Next i
'Отключаем проверку орфографии
Selection.LanguageID = wdNoProofing
WordBasic.Insert StrRez$
End Sub

Вот и все. Согласен, что общий объем макрасов не маленький, но зато работает достаточно корректно и быстро. Кстати, если захотите добавить какие-либо свои "неоднозначные" символы, никаких проблем не вижу. Делайте это в процедуре SetArr(). Только не забудьте увеличить значение параметра CountOtherCharRL.

Как обращаться с макрасом, в смысле куда его записывать и как вызывать на исполнение, я думаю, вы знаете. Если нет, возьмите "Компьютерную газету" N№47 за 1999 год. Там, в статье "Раскладка клавиатуры. Даешь сервис" все подробно описано.

Пользуйтесь на удовольствие. Теперь вы можете посылать своим друзьям не только короткие записочки, но и любые тексты, которые вы где-то надыбали, их ведь не нужно будет перенабирать по новой.

Сергей Нематов

© компьютерная газета