СообЧа > База Знаний > Программирование > Visual Basic

Вопрос

Версия VB: 6.0

Вопрос больше по АПИ, но все же..
Private Declare Function ActivateKeyboardLayout Lib «user32» (ByVal HKL As Long, ByVal flags As Long) As Long

'Включить английскую раскладку клавы: ActivateKeyboardLayout 67699721, 0
'Включить русскую раскладку клавы: ActivateKeyboardLayout 68748313, 0

А как узнать номерок(HKL), скажем для китайского языка, или того же русского, но так называемой «машинописи"(тоже раскладка клавиатуры)?
Как узнать сколько доступных раскладок имеется в данный момент? Их HKL? Человеческие имена?

Иногда, при загрузке в RichTextBox обычного текстового файла, русский текст там отображается «каракулями». Проблема решается повторной загрузкой текста, но с переключением раскладки клавиатуры на русскую. Шо це таке? :( Причем прога сама эту раскладку не дергает… Как тут быть? Почему оно так? :(

Ответ

Вначале немного теории:

В реестре в разделе
HKEY_LOCAL_MACHINE\ System\ CurrentControlSet\ Control\ keyboard layouts\
находится список доступных раскладок клавиатуры.

Каждый подраздел этого раздела — это «имя» раскладки клавиатуры, с помощью которого раскладку можно загрузить с помощью функции LoadKeyboardLayout. В каждом подразделе есть параметр «layout text» — в котором хранится «человеческое имя» раскладки.

Если система позволяет загрузить данную раскладку, то функция возвращает манипулятор данной раскладки — те самые HKL.
Функция GetKeyboardLayoutList дает список все загруженных в данный момент раскладок.

А теперь небольшая программка.

На форму кладешь ListBox и кнопку (Caption — «Загрузить раскладку»)
Объявляешь функции:

Option Explicit

Private Const KLF_ACTIVATE As Long = 1
Private Const REG_SZ As Long = 1
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const KL_NAMELENGTH As Long = 9

Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" _
(ByVal pwszKLID As String, ByVal flags As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, _
lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Sub Form_Load()
  Dim lNum As Long, lKol As Long
  Dim Ret As Long, Ret1 As Long, lResult As Long
  Dim lBuf As Long, lValueType As Long
  Dim sData As String, sPath As String, sCurLayout As String

  sPath = "System\CurrentControlSet\Control\keyboard layouts\"
  RegOpenKey HKEY_LOCAL_MACHINE, sPath, Ret 'Ret — получает дескриптор ключа реестра
  Do While lNum = 0
    sCurLayout = Space(KL_NAMELENGTH) 'перебираем все подключи нашего раздела
    ' в sCurLayout получаем имя раскладки
    lNum = RegEnumKey(Ret, lKol, sCurLayout, KL_NAMELENGTH)
    sPath = "System\CurrentControlSet\Control\keyboard layouts\" & sCurLayout
    RegOpenKey HKEY_LOCAL_MACHINE, sPath, Ret1
    lResult = RegQueryValueEx(Ret1, "layout text", 0, lValueType, ByVal 0, lBuf)
    If lResult = 0 Then
      If lValueType = REG_SZ Then
        sData = String(lBuf, Chr$(0)) 'получаем "человеческое имя" раскладки
        lResult = RegQueryValueEx(Ret1, "layout text", 0, 0, ByVal sData, lBuf)
        sData = Left(sCurLayout, KL_NAMELENGTH — 1) _
        & " — " & Left(sData, Len(sData) — 1)
        List1.AddItem sData
      End If
    End If
    RegCloseKey Ret1
    lKol = lKol + 1
  Loop
  RegCloseKey Ret
End Sub

Private Sub Command1_Click()
  Dim lResult As Long, sLayout As String
  If List1.ListIndex <> -1 Then
    sLayout = List1.List(List1.ListIndex)
    lResult = LoadKeyboardLayout(Left(sLayout, 8), KLF_ACTIVATE)
    If lResult = 0 Then
      MsgBox "Не удается загрузить раскладку " & Mid(sLayout, 12)
    Else
      MsgBox "HKL раскладки " & Mid(sLayout, 12) & " — " & lResult
    End If
  End If
End Sub


Дмитрий Данелия



Copyright © 2000-2004 Сообщество Чайников
Контактная информация