Вот такая ситуация: Вы печатаете-печатаете-печатаете доклад, реферат, письмо, да что угодно. вот уже половину напечатали, не смотря в монитор. тут Вы поднимаете свои глаза и понимаете что забыли сменить язык и печатали на другой раскладке клавиатуры.. не стоит психовать и все стирать, заново писать или компьютер из окна от злости выбрасывать! Это абракадабру может протранслировать программа, исходник который мы рассмотрим сегодня
Данный код реализует транслирование текста:
Private Function Replace_letters(InputStr As String) As String enStr = "@#$^&QWERTYUIOP{}ASDFGHJKL:" & Chr(34) & "ZXCVBNM<>?qwertyuiop[]asdfghjkl;'zxcvbnm,./" & Chr(34) & "¹;:?ÉÖÓÊÅÍÃØÙÇÕÚÔÛÂÀÏÐÎËÄÆÝß×ÑÌÈÒÜÁÞ,éöóêåíãøùçõúôûâàïðîëäýæÿ÷ñìèòüáþ." rusStr = Chr(34) & "¹;:?ÉÖÓÊÅÍÃØÙÇÕÚÔÛÂÀÏÐÎËÄÆÝß×ÑÌÈÒÜÁÞ,éöóêåíãøùçõúôûâàïðîëäæýÿ÷ñìèòüáþ." & "@#$^&QWERTYUIOP{}ASDFGHJKL:" & Chr(34) & "ZXCVBNM<>?qwertyuiop[]asdfghjkl;'zxcvbnm,./" Dim i As Integer, pos As Integer, temp As String For i = 1 To Len(InputStr) temp = Mid$(InputStr, i, 1) pos = InStr(1, enStr, temp, vbBinaryCompare) If pos <> 0 Then Replace_letters = Replace_letters & Mid$(rusStr, pos, 1) Else Replace_letters = Replace_letters & temp End If Next i
Тепер функцию Replace_letters() можно использовать в любом месте, где надо протранслировать текст. пример кода:
Private Function Replace_letters(InputStr As String) As String enStr = "@#$^&QWERTYUIOP{}ASDFGHJKL:" & Chr(34) & "ZXCVBNM<>?qwertyuiop[]asdfghjkl;'zxcvbnm,./" & Chr(34) & "¹;:?ÉÖÓÊÅÍÃØÙÇÕÚÔÛÂÀÏÐÎËÄÆÝß×ÑÌÈÒÜÁÞ,éöóêåíãøùçõúôûâàïðîëäýæÿ÷ñìèòüáþ." rusStr = Chr(34) & "¹;:?ÉÖÓÊÅÍÃØÙÇÕÚÔÛÂÀÏÐÎËÄÆÝß×ÑÌÈÒÜÁÞ,éöóêåíãøùçõúôûâàïðîëäæýÿ÷ñìèòüáþ." & "@#$^&QWERTYUIOP{}ASDFGHJKL:" & Chr(34) & "ZXCVBNM<>?qwertyuiop[]asdfghjkl;'zxcvbnm,./" Dim i As Integer, pos As Integer, temp As String For i = 1 To Len(InputStr) temp = Mid$(InputStr, i, 1) pos = InStr(1, enStr, temp, vbBinaryCompare) If pos <> 0 Then Replace_letters = Replace_letters & Mid$(rusStr, pos, 1) Else Replace_letters = Replace_letters & temp End If Next i End Function Private Sub Command1_Click() Text2.Text = Replace_letters(Text1.Text) Text2.Visible = True End Sub
Что-то не получается? Не понятна какая-то часть кода? Напишите комментарий об этом и мы обязательно Вам все объясним! Обязательно напишите отзыв о программе / учебнике. Для выражения благодарностей есть кнопка:
Уважаемый посетитель, Вы зашли на сайт как незарегистрированный пользователь. Мы рекомендуем Вам зарегистрироваться либо войти на сайт под своим именем.
