Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.57/37: Рейтинг темы: голосов - 37, средняя оценка - 4.57
54 / 54 / 43
Регистрация: 11.12.2009
Сообщений: 110
1

Транслитерация Киррилица->Латинница и Латинница->Кириллица

17.02.2010, 08:55. Показов 6937. Ответов 8
Метки нет (Все метки)

Доброго времени суток, уважаемые эксперты. На форуме смотрел. Пишу программу транслитерации для зачета, транслитерация как из латинницы в кириллицу, так и наоборот из кириллицы в латинницу. Функцию написал, транслитерация кир->лат не вызвала затруднения, а вот с лат->кир пришлось повозиться, тем не менее и она поддалась, но хотелось бы узнать существует ли более простая реализация транслитерации лат->кир.
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
//-----------------
function translit(mytxt:string):string;//в функцию ввожу ВЕСЬ текст
var i,//счетчик
     k,//комментарий ниже
     mlen:integer;//количество символов в тексте
begin
k:=0;
result:='';
mlen:=length(mytxt);
for i:=1 to mlen do
begin
if k<>0 then k:=k-1 //комментарий ниже
        else
        begin
case mytxt[i] of
//кир в лат
'а':result:=result+'a';
'б':result:=result+'b';
'в':result:=result+'v';
'г':result:=result+'g';
'д':result:=result+'d';
'е':result:=result+'e';
'ё':result:=result+'jo';
'ж':result:=result+'zh';
'з':result:=result+'z';
'и':result:=result+'i';
'й':result:=result+'jj';
'к':result:=result+'k';
'л':result:=result+'l';
'м':result:=result+'m';
'н':result:=result+'n';
'о':result:=result+'o';
'п':result:=result+'p';
'р':result:=result+'r';
'с':result:=result+'s';
'т':result:=result+'t';
'у':result:=result+'u';
'ф':result:=result+'f';
'х':result:=result+'kh';
'ц':result:=result+'c';
'ч':result:=result+'ch';
'ш':result:=result+'sh';
'щ':result:=result+'shh';
'ь':result:=result+#34;
'ы':result:=result+'y';
'ъ':result:=result+#39;
'э':result:=result+'eh';
'ю':result:=result+'yu';
'я':result:=result+'ya';
//---
//лат в кир
'a':result:=result+'а';
'b':result:=result+'б';
'v':result:=result+'в';
'g':result:=result+'г';
'd':result:=result+'д';
'i':result:=result+'и';
'l':result:=result+'л';
'm':result:=result+'м';
'n':result:=result+'н';
'o':result:=result+'о';
'p':result:=result+'п';
'r':result:=result+'р';
't':result:=result+'т';
'u':result:=result+'у';
'f':result:=result+'ф';
#34:result:=result+'ъ';
#39:result:=result+'ь';
'e':if mytxt[i+1]='h' then
                      begin result:=result+'э';k:=1; end
                      else result:=result+'е';
'j':begin
    if mytxt[i+1]='o' then
                      begin result:=result+'ё'; k:=1; end;
    if mytxt[i+1]='j' then
                      begin result:=result+'й'; k:=1; end;
    end;
'z':if mytxt[i+1]='h' then
                      begin result:=result+'ж'; k:=1; end
                      else result:=result+'з';
'k':if mytxt[i+1]='h' then
                      begin result:=result+'х'; k:=1; end
                      else result:=result+'к';
'c':if mytxt[i+1]='h' then
                      begin result:=result+'ч'; k:=1; end
                      else result:=result+'ц';
'y':begin
    if mytxt[i+1]='a' then
                      begin result:=result+'я'; k:=1; end;
    if mytxt[i+1]='u' then
                      begin result:=result+'ю'; k:=1; end;
    if ((mytxt[i+1]<>'a')and(mytxt[i+1]<>'u')) then
                      result:=result+'ы';
    end;
's':begin
    if ((mytxt[i+1]='h')and(mytxt[i+2]='h')) then
                      begin result:=result+'щ'; k:=2; end;
    if ((mytxt[i+1]='h')and(mytxt[i+2]<>'h')) then
                      begin result:=result+'ш'; k:=1; end;
    if ((mytxt[i+1]<>'h')and(mytxt[i+2]<>'h')) then
                      begin result:=result+'с'; end;
    end;
//---
//все тоже, символы верхнего регистра
'А':result:=result+'A';
'Б':result:=result+'B';
'В':result:=result+'V';
'Г':result:=result+'G';
'Д':result:=result+'D';
'Е':result:=result+'E';
'Ё':result:=result+'JO';
'Ж':result:=result+'ZH';
'З':result:=result+'Z';
'И':result:=result+'I';
'Й':result:=result+'JJ';
'К':result:=result+'K';
'Л':result:=result+'L';
'М':result:=result+'M';
'Н':result:=result+'N';
'О':result:=result+'O';
'П':result:=result+'P';
'Р':result:=result+'R';
'С':result:=result+'S';
'Т':result:=result+'T';
'У':result:=result+'U';
'Ф':result:=result+'F';
'Х':result:=result+'KH';
'Ц':result:=result+'C';
'Ч':result:=result+'CH';
'Ш':result:=result+'SH';
'Щ':result:=result+'SHH';
'Ь':result:=result+#34;
'Ы':result:=result+'Y';
'Ъ':result:=result+#39;
'Э':result:=result+'EH';
'Ю':result:=result+'YU';
'Я':result:=result+'YA';
//---
'A':result:=result+'А';
'B':result:=result+'Б';
'V':result:=result+'В';
'G':result:=result+'Г';
'D':result:=result+'Д';
'I':result:=result+'И';
'L':result:=result+'Л';
'M':result:=result+'М';
'N':result:=result+'Н';
'O':result:=result+'О';
'P':result:=result+'П';
'R':result:=result+'Р';
'T':result:=result+'Т';
'U':result:=result+'У';
'F':result:=result+'Ф';
//#39:result:=result+'Ъ';
//#34:result:=result+'Ь';
'E':if mytxt[i+1]='H' then
                      begin result:=result+'Э';k:=1; end
                      else result:=result+'Е';
'J':begin
    if mytxt[i+1]='O' then
                      begin result:=result+'Ё'; k:=1; end;
    if mytxt[i+1]='J' then
                      begin result:=result+'Й'; k:=1; end;
    end;
'Z':if mytxt[i+1]='H' then
                      begin result:=result+'Ж'; k:=1; end
                      else result:=result+'З';
'K':if mytxt[i+1]='H' then
                      begin result:=result+'Х'; k:=1; end
                      else result:=result+'К';
'C':if mytxt[i+1]='H' then
                      begin result:=result+'Ч'; k:=1; end
                      else result:=result+'Ц';
'Y':begin
    if mytxt[i+1]='A' then
                      begin result:=result+'Я'; k:=1; end;
    if mytxt[i+1]='U' then
                      begin result:=result+'Ю'; k:=1; end;
    if ((mytxt[i+1]<>'A')and(mytxt[i+1]<>'U')) then
                      result:=result+'Ы';
    end;
'S':begin
    if ((mytxt[i+1]='H')and(mytxt[i+2]='H')) then
                      begin result:=result+'Щ'; k:=2; end;
    if ((mytxt[i+1]='H')and(mytxt[i+2]<>'H')) then
                      begin result:=result+'Ш'; k:=1; end;
    if ((mytxt[i+1]<>'H')and(mytxt[i+2]<>'H')) then
                      begin result:=result+'С'; end;
    end
//---
else result:=result+mytxt[i];//для прочих символов не требующих траслитерации
end;//end of 'CASE'
end;//end of 'IF THEN ELSE'
end;//end of 'FOR'
end;//end of 'FUNCTION'
//-----------------
k использовал в качестве своеобразного "тормоза", чтобы цикл не переходил к следующему символу текста, а проверял следущий символ, например "ш" - "sh", "щ" - "shh".
Жду решений оптимизации.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
17.02.2010, 08:55
Ответы с готовыми решениями:

Транслитерация текста в обе стороны (кириллица <-> латиница)
Здравствуйте господа! Нужна помощь. За плечами только написание программы «Hello world» Задача:...

киррилица
есть текст-бокс, в кот. вводится тескт на русском. при манипуляции с этим текстом все теряется и...

C# Киррилица
Поставил себе на виртуальную машину Win 64x XP вроде английския, но заверяли, что русская(где-то...

Подсчитать количество вхождений буквы (кириллица) в строку (кириллица)
Суть такая: по требованию программы ввести строку символов (обыкновенный текст, кириллица(!!!)) и...

8
163 / 140 / 23
Регистрация: 28.12.2009
Сообщений: 365
17.02.2010, 10:38 2
у тебя компилится? мне кажется case можно использовать только с числовыми значениями
0
54 / 54 / 43
Регистрация: 11.12.2009
Сообщений: 110
17.02.2010, 10:46  [ТС] 3
Да, все работает в Delphi 7, а так же в 2008. Просто функция громоздкая, хотелось бы что-нибудь поменьше.
0
163 / 140 / 23
Регистрация: 28.12.2009
Сообщений: 365
17.02.2010, 12:11 4
кир -> лат (с символами верхнего регистра работает)
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
const
  cyr: array [1..33] of Char=('а','б','в','г','д','е','ё','ж','з','и','й','к',
  'л','м','н','о','п','р','с','т','у','ф','х','ц','ч','ш','щ','ь','ы','ъ','э','ю','я');
  lat: array [1..33] of String=('a','b','v','g','d','e','jo','zh','z','i','jj','k',
  'l','m','n','o','p','r','s','t','u','f','kh','c','ch','sh','shh',#34,'y',#39,'eh','yu','ya');
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
  MyTxt: string;
  i,j: Integer;
begin
  MyTxt:=Edit1.Text;
  for i := Length(MyTxt) downto 1 do
    for j := 1 to 33 do begin
      if MyTxt[i]=cyr[j] then
        MyTxt:=copy(MyTxt,1,i-1)+lat[j]+copy(MyTxt,i+1,Length(MyTxt)-i)
      else if MyTxt[i]=AnsiUpperCase(cyr[j]) then
        MyTxt:=copy(MyTxt,1,i-1)+AnsiUpperCase(lat[j])+copy(MyTxt,i+1,Length(MyTxt)-i);
    end;
  Edit1.Text:=MyTxt;
end;
компактненько правда?
1
421 / 130 / 33
Регистрация: 24.02.2009
Сообщений: 1,122
17.02.2010, 15:21 5
например так,
1
Вложения
Тип файла: rar Translite.rar (35.0 Кб, 310 просмотров)
163 / 140 / 23
Регистрация: 28.12.2009
Сообщений: 365
17.02.2010, 15:43 6
kentaw, все конечно красиво, но функции
Delphi
1
2
3
function TranslitRE(s: string): string;
..
function TranslitER(s: string): string;
можно сделать лучше.
если транслитировать рус-енг , например, буквы ё, я, а потом транслитировать обратно енг-рус, то получится уже не то что надо.
кстати, BouH просил оптимизировать, а не наворотов
0
421 / 130 / 33
Регистрация: 24.02.2009
Сообщений: 1,122
17.02.2010, 16:23 7
не знаю, можно обработывать этот код, работая их ANSCII кодами, чтобы получит самую простую....
Delphi
1
2
3
4
5
6
7
8
9
10
procedure TForm1.Button1Click(Sender: TObject);
var s,s1:string;
  i:integer;
begin
  s:=Edit1.Text;
  s1:='';
  for  i:=1 to length(s) do
  if ord(s[i]) in [65..90] then s1:=s1+chr(ord(s[i])+63);
  Edit2.Text:=s1;
end;
0
163 / 140 / 23
Регистрация: 28.12.2009
Сообщений: 365
17.02.2010, 17:23 8
ну во-первых коды не правильные, сам попробуй.
во-вторых что если 1 русский символ надо заменить двумя латинскими?
0
54 / 54 / 43
Регистрация: 11.12.2009
Сообщений: 110
18.02.2010, 09:32  [ТС] 9
Biggemot, спасибо. Правда программу приняли с моей функцией, даже на код не смотрели. Кстати, начав писать прогу, я тоже хотел использовать массивы, но что-то у меня не клеилось.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
18.02.2010, 09:32

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Windows, C++, Киррилица и именованные каналы
Всем привет. Решил портировать кое-какой код под Виндовс. Код делает дочерний процесс и...

Memo1.loadfromfile/loadfromstream ошибка, если имя файла киррилица
В общем ошибка: Хоть loadfromfile, хоть loadfromstream. Переименовываем файл латиницей - все...

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

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


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.