транслит

[i'm pissed]

как сделать транслит для combobox

[alibek]

А?

[i'm pissed]

ага
че не знаешь че такое транслит

[Yojik21]

Поконкретнее бы

[i'm pissed]

показываю для некоторых
на пример ты пишиш йцукен
у это у тебя переконвектируется в qwerty

[Prickly]

йцукен в транслите будет iycuken, или что-то на подобе. Ты людей не путай.

[Amed]

Ручками надо сделать...

[_Мика_]

Translit eto ne mnogo ne to chto ti podumal транслит это eto. А то что ты хочиш сделать то я думаю только Select Case

Код: Выделить всё

Select case <<буква>>
Сase <<и вот так весь алфавит>>
sText=<<другой алфавит>>
End Select


[SSecurity]

вообщем-то всё просто:)

Собираем функцию
Берем один алфавит записываем его строкой ...
Потом второй алфавит, тоже строкой пишем...
Ориентируешься на раскладку, т.е. Q(LAT) = Й(РУС)


Function Translit(TEXT as string, ToRus as Boolean) as String
RUS = "абвгд...я"
LAT = "f,dul...z"

Translit = ""
For I = 1 to LEn(TEXT)
Simb = Mid(TEXT,I,1)
If ToRus = True then
If instr(1,LAT,lcase(Simb))<>0 then
PP = instr(1,LAT, lcase(Simb))
Translit = Translit + mid(RUS,PP,1)
Else
Translit = Translit + Simb
End if
Else
If instr(1,RUS,lcase(Simb))<>0 then
PP = instr(1,RUS, lcase(Simb))
Translit = Translit + mid(LAT,PP,1)
Else
Translit = Translit + Simb
End if


End if
Next I
End Function

[Eduard]

Не очень оригенальна эта функция, потому что при транслите (с русского) могут быть одна русская буква двумя латинскими, например ш > sh, я > ja, ну и т.п. Легче создать действительно один здоровенький модулек с Select Case'ами, и потом спокойно его добавлять в проект, и юзаться!

[SSecurity]

Это работает по принципу

Привет = ghbdtn

Если нужно произвести транслит в системе
Привет => Privet => Привет ...

То функция требует маленькой модернизации ...
(добавление ещё одноё строки перевода)
плюс функции перевод ... намного легче

[SSecurity]

Теперь что касается перевода "Ш" в "SH"
и "SH" в "Ш" операция выполняется достаточно просто при соответсвующем алгоритме, могу Предложить сравнить варианты работы ч/з функцию и Ваш вариант громадный SELECT CASE ... вообщем если согласны - давайте сравним.


Проосто я представил себе транслит слова "шишка"
шишка => shishka
а теперь переведем "shishka" в шишку (посимвольно:))
shishka => схисхка ....
Странно, "схисхка" <> "шишка" ...

Наверно поетому ... все стихи в переводе по цепочке РУС -> НЕРУС -> РУС .. меняется смысл:)

[SSecurity]

На ворме тока 1 кнопка ... Command1 для примера

Код: Выделить всё

'### Правила транслита задайте под себя!!
'### тут они под меня!!!
'### Пакость есть - сочетания букв не должны повторяться
Const RUS = "абвгдеёжзийклмнопрстуфхцчшщьыъэюя"
Const ENG = "abvgdejozhzijklmnoprstufxcchshsch'yi`jejuja"
Const DIG = "111111221111111111111111223121222"

Dim MaxSimbLen As Byte
Dim RusCol As Collection
Dim LatCol As Collection
Dim CSUM As Integer

'### Инициализируем коллекции
Sub InitCollection()
Set RusCol = New Collection
Set LatCol = New Collection
CSUM = 0
MaxSimbLen = 0
For I = 1 To Len(RUS)
  If I > 1 Then CSUM = CSUM + Val(Mid(DIG, I - 1, 1))
  DLEN = Val(Mid(DIG, I, 1))
  If DLEN > MaxSimbLen Then MaxSimbLen = DLEN
  RusCol.Add Mid(RUS, I, 1), Mid(ENG, CSUM + 1, DLEN)
  LatCol.Add Mid(ENG, CSUM + 1, DLEN), Mid(RUS, I, 1)
Next I
End Sub

Function Translit(TEXT As String, ToRus As Boolean) As String
Dim Simb As String, Tmp As String
Translit = ""
For I = 1 To Len(TEXT)
  Simb = LCase(Mid(TEXT, I, 1))
  Select Case ToRus
   Case False  '### В латиницу кодим
    Ind = GetRusSimb(Simb)
    If Ind <> "" Then Translit = Translit + Ind Else Translit = Translit + Simb
   
   Case True   '### В русский кодим
    For C = MaxSimbLen To 1 Step -1
     Tmp = LCase(Mid(TEXT, I, C))
     Ind = GetLatSimb(Tmp)
     If Ind <> "" Then
      Translit = Translit + Ind
      I = I + C - 1
      Exit For
     End If
    Next C
    If Ind = "" Then Translit = Translit + Simb
  End Select
Next I
End Function

Function GetLatSimb(TXT As String) As String
On Error Resume Next
GetLatSimb = ""
GetLatSimb = RusCol(TXT)
End Function

Function GetRusSimb(TXT As String) As String
On Error Resume Next
GetRusSimb = ""
GetRusSimb = LatCol(TXT)
End Function

Private Sub Command1_Click()
Dim A As String, B As String, C As String
A = "На него упала шишка с ёлки."
B = Translit(A, False)
C = Translit(B, True)
MsgBox A & vbCrLf & B & vbCrLf & C
End Sub

Private Sub Form_Load()
InitCollection
End Sub


Результат:
На него упала шишка с ёлки.
na nego upala shishka s jolki.
на него упала шишка с ёлки.

[_Мика_]

Блин почему файлы не прекрепляются
Хотел свой пример выложить а не получается

[SSecurity]

Ручками тогда%)

[_Мика_]

Щасссс!!!!