Вот такая ситуация: Вы печатаете-печатаете-печатаете доклад, реферат, письмо, да что угодно. вот уже половину напечатали, не смотря в монитор. тут Вы поднимаете свои глаза и понимаете что забыли сменить язык и печатали на другой раскладке клавиатуры.. не стоит психовать и все стирать, заново писать или компьютер из окна от злости выбрасывать! Это абракадабру может протранслировать программа, исходник который мы рассмотрим сегодня
Данный код реализует транслирование текста:
Private Function Replace_letters(InputStr As String) As String enStr = "@#$^&QWERTYUIOP{}ASDFGHJKL:" & Chr(34) & "ZXCVBNM<>?qwertyuiop[]asdfghjkl;'zxcvbnm,./" & Chr(34) & "&;:?йцукенгшщзхъфывапролджэячсмитьбю.;." rusStr = Chr(34) & "&#185;;:?йцукенгшщзхъфывапролджэячсмитьбю.;." & "@#$^&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 Тепер функцию 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) & "&#185;;:?йцукенгшщзхъфывапролджэячсмитьбю.;." & "@#$^&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
Comments ( 0 )