Смена языка клавиатуры

Программирование на Visual Basic for Applications
vf
Начинающий
Начинающий
 
Сообщения: 15
Зарегистрирован: 19.01.2003 (Вс) 16:19
Откуда: Russia

Смена языка клавиатуры

Сообщение vf » 23.03.2003 (Вс) 18:50

Подскажите как на VBA написать процедуру по замене языка клавиатуры.

RayShade
Scarmarked
Scarmarked
Аватара пользователя
 
Сообщения: 5511
Зарегистрирован: 02.12.2002 (Пн) 17:11
Откуда: Russia, Saint-Petersburg

Сообщение RayShade » 23.03.2003 (Вс) 21:09

А точнее? Что тебе именно надо? Установить свой язык или просто переключить раскладку?

vf
Начинающий
Начинающий
 
Сообщения: 15
Зарегистрирован: 19.01.2003 (Вс) 16:19
Откуда: Russia

Сообщение vf » 23.03.2003 (Вс) 22:28

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

Vitaly1
Брехман
Брехман
 
Сообщения: 1578
Зарегистрирован: 30.12.2002 (Пн) 16:35
Откуда: Russia, Mosсow

Сообщение Vitaly1 » 24.03.2003 (Пн) 9:12

Как то еще по DOS писал программу эмулирующую нажатие на управляющие клавиши, VBA к ассемблеру насколько мне известно доступа нет, но наверняка есть вышеуказанная возможность.
Мое предложение перекодировать в текстбоксе русcкие буквы на английские по KeyDown:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case "Й"
KeyCode = Asc("Q")
Case "й"
KeyCode = Asc("q")
Case "Ц"
KeyCode = Asc("W")
Case "ц"
KeyCode = Asc("w")
.
.
.
End Select
End Sub

Что бы опредилить перекодировку в нужную сторону задайте глобальную переменную и поставьте каждый select case в плечах оператора If

GSerg
Шаман
Шаман
 
Сообщения: 14286
Зарегистрирован: 14.12.2002 (Сб) 5:25
Откуда: Магадан

Сообщение GSerg » 24.03.2003 (Пн) 11:08

:shock:
Это ж сколько селект кейсов получится :?: :wink:

Лучше так:
Код: Выделить всё
Const RusChars As String = "йцукенгшщзхъфывапролджэячсмитьбю"
Const EngChars As String = "qwertyuiop[]asdfghjkl;'zxcvbnm,."

Function TranslateLetter (L As String, Optional ToEnglish As Boolean = True) As String
  TranslateLetter = Mid$(IIF(ToEnglish, EngChars, RusChars), InStr(IIF(ToEnglish, RusChars, EngChars), L))
End Function


Ну а в событии KeyDown понятно как эту функцию юзать, я думаю :)
Как только вы переберёте все варианты решения и не найдёте нужного, тут же обнаружится решение, простое и очевидное для всех, кроме вас

vf
Начинающий
Начинающий
 
Сообщения: 15
Зарегистрирован: 19.01.2003 (Вс) 16:19
Откуда: Russia

Сообщение vf » 24.03.2003 (Пн) 14:58

В моем случае этот вариант работает не корректно, подскажите как просто поменять раскладку клавиатуры.

GSerg
Шаман
Шаман
 
Сообщения: 14286
Зарегистрирован: 14.12.2002 (Сб) 5:25
Откуда: Магадан

Сообщение GSerg » 26.03.2003 (Ср) 9:44

Хозяин-барин :wink:
Добавь это в форму. А чтобы изменять раскладку, вызывай функцию:

SetKbLayout LANG_EN_US или SetKbLayout LANG_RUS

Код: Выделить всё
'This example was created by A.E.Veltstra

'This fucntion changes the locale and as a result, the keyboardlayout gets adjusted

'parameters for api's
Const KL_NAMELENGTH As Long = 9                      'length of the keyboardbuffer
Const KLF_ACTIVATE  As Long = &H1                     'activate the layout

'the language constants
Const LANG_EN_US As String = "00000409"
Const LANG_RUS As String = "00000419"

'api's to adjust the keyboardlayout
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long

Public Function SetKbLayout(strLocaleId As String) As Boolean
    'Changes the KeyboardLayout
    'Returns TRUE when the KeyboardLayout was adjusted properly, FALSE otherwise
    'If the KeyboardLayout isn't installed, this function will install it for you
    On Error Resume Next
    Dim strLocId As String 'used to retrieve current KeyboardLayout
    Dim strMsg As String   'used as buffer
    Dim lngErrNr As Long   'receives the API-error number

  'create a buffer
  strLocId = String(KL_NAMELENGTH, 0)
  'retrieve the current KeyboardLayout
  GetKeyboardLayoutName strLocId
  MsgBox strLocId
  'Check whether the current KeyboardLayout and the
  'new one are the same
  If strLocId = (strLocaleId & Chr(0)) Then
    'If they're the same, we return immediately
    SetKbLayout = True
  Else
    'create buffer
    strLocId = String(KL_NAMELENGTH, 0)
    'load and activate the layout for the current thread
    strLocId = LoadKeyboardLayout((strLocaleId & Chr(0)), KLF_ACTIVATE)
    If IsNull(strLocId) Then  'returns NULL when it fails
      SetKbLayout = False
    Else 'check again
      'create buffer
      strLocId = String(KL_NAMELENGTH, 0)
      'retrieve the current layout
      GetKeyboardLayoutName strLocId
      If strLocId = (strLocaleId & Chr(0)) Then
        SetKbLayout = True
      Else
        SetKbLayout = False
      End If
    End If
  End If
End Function
Как только вы переберёте все варианты решения и не найдёте нужного, тут же обнаружится решение, простое и очевидное для всех, кроме вас

vf
Начинающий
Начинающий
 
Сообщения: 15
Зарегистрирован: 19.01.2003 (Вс) 16:19
Откуда: Russia

Сообщение vf » 26.03.2003 (Ср) 19:32

Спасибо! Работает отлично.

SAS
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 101
Зарегистрирован: 21.06.2005 (Вт) 0:30
Откуда: Петропавловск-Камчатский

Сообщение SAS » 11.08.2005 (Чт) 0:30

GSerg писал(а):Хозяин-барин :wink:
Добавь это в форму. А чтобы изменять раскладку, вызывай функцию:

SetKbLayout LANG_EN_US или SetKbLayout LANG_RUS

Возможно ли как нибудь изменить язык для любого процесса, зная его ID или hwnd окна?


Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: SemrushBot и гости: 45

    TopList