:: MVP ::
|
|
:: RSS ::
|
|
|
Для начала определимся с тем, что мы будем понимать под языками, а что под раскладками. С языками все
просто – русский, английский и т.п.
Один язык может быть представлен в системе несколькими диалектами, каждому из которых соответствует своя
раскладка – США, США по Двораку и т.п.
В простейшем случае язык может быть представлен одним диалектом, тогда для этого языка в системе будет одна
раскладка, иначе раскладок будет несколько. Отличие языка от раскладки весьма условно, и порой об этом
напоминают лишь горячие клавиши, которыми осуществляется переключение между ними.
В системе одновременно может быть установлено несколько языков с различными диалектами.
Далее в этой статье будет фигурировать термин «раскладка». Ну а начнём мы, пожалуй, с того, что получим из
реестра список всех раскладок, имеющихся в системе, который хранится в разделе:
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts
|
Рассмотрим этот список. Все раскладки имеют ряд идентичных параметров, за исключением одного –
Layout Id (он имеется не у всех раскладок). В дальнейшем этот парамерт нам пригодится, и для
раскладок, у которых он отсутствует, мы будем полагать его значение равным 0.
Так же нам нужно разобраться с форматом имени раскладок, описание которого можно найти в
MSDN.
+-------------+---------+-------------------------+
| Reserved | Sort ID | Language ID |
+-------------+---------+-------------------------+
31 20 19 16 15 0 bit
|
Имя является строковым представлением двойного слова в шестнадцатеричном формате. Младшее слово –
идентификатор языка, 4 младших бита старшего слова – Sort ID.
Некоторые раскладки загружаются вместе с системой, их список также можно найти в реестре в разделе
HKEY_USERS\.DEFAULT\Keyboard Layout\Preload
или
HKEY_CURRENT_USER\Keyboard Layout\Preload
|
В интерфейсе тестового приложения к данной статье я решил отображать все это следующим образом. Раскладки,
которые загружаются вместе с системой, отмечаются значком , а раскладки, которые реально загружены,
выделяются в списке жирным шрифтом. Вот как это выглядит.
Из скриншота видно, что у меня при старте системы загружаются 2 раскладки – «США» и «Русская». Вот как строится этот список:
procedure TSystemKeyboardLayouts.Load;
var
LibInstance: NativeUInt;
function GetResString(Val: string): string;
const
BUFFER_SIZE = 255;
var
Buffer: PChar;
uID: Cardinal;
begin
GetMem(Buffer, BUFFER_SIZE);
uID := TRegEx.Match(Val, '\d+$').Value.ToInteger;
if LoadString(LibInstance, uID, @Buffer[0], BUFFER_SIZE) > 0 then
Result := Buffer;
FreeMem(Buffer);
end;
procedure GetKeyboardPreloadLayouts(var PreloadLayouts: TStrings);
var
i: Integer;
Reg: TRegistry;
Names: TStrings;
const
Key =
{$IFDEF HKEY_USERS}
'.DEFAULT\Keyboard Layout\Preload'
{$ELSE}
'Keyboard Layout\Preload'
{$ENDIF};
begin
Reg := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
Reg.RootKey :=
{$IFDEF HKEY_USERS}
HKEY_USERS
{$ELSE}
HKEY_CURRENT_USER
{$ENDIF};
if Reg.OpenKeyReadOnly(Key) then
begin
Names := TStringList.Create;
Reg.GetValueNames(Names);
for i := 0 to Names.Count-1 do
PreloadLayouts.Add(Reg.ReadString(Names.Strings[i]));
Reg.CloseKey;
Names.Free;
end;
Reg.Free;
end;
procedure GetKeyboardLayouts(const PreloadLayouts: TStrings);
var
i: Integer;
Reg: TRegistry;
SubKeys, Names: TStrings;
ErrorCode: Integer;
const
Key = 'SYSTEM\CurrentControlSet\Control\Keyboard Layouts';
begin
Reg := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKeyReadOnly(Key) then
begin
if Reg.HasSubKeys then
begin
SubKeys := TStringList.Create;
Reg.GetKeyNames(SubKeys);
Reg.CloseKey;
SetLength(FLayoutsData, SubKeys.Count);
for i := 0 to SubKeys.Count-1 do
begin
Reg.OpenKeyReadOnly(Key + '\' + SubKeys[i]);
FLayoutsData[i].DisplayName := GetResString(Reg.ReadString('Layout Display Name'));
if Reg.ValueExists('Layout Id') then
Val('$' + Reg.ReadString('Layout Id'), FLayoutsData[i].Id, ErrorCode)
else
FLayoutsData[i].Id := 0;
FLayoutsData[i].Code := SubKeys[i];
FLayoutsData[i].Preload := PreloadLayouts.IndexOf(SubKeys[i]) >= 0;
Reg.CloseKey;
end;
SubKeys.Free;
end
else
Reg.CloseKey;
end;
Reg.Free;
end;
var
PreloadLayouts: TStrings;
begin
LibInstance := LoadLibrary(PChar('input.dll'));
if LibInstance > 0 then
begin
PreloadLayouts := TStringList.Create;
GetKeyboardPreloadLayouts(PreloadLayouts);
GetKeyboardLayouts(PreloadLayouts);
PreloadLayouts.Free;
FreeLibrary(LibInstance);
end;
end;
|
Здесь хотелось бы акцентировать внимание на функции GetResString. Дело в том, что локализованное название раскладки
хранится в библиотеке input.dll в виде строкового ресурса. Данная функция загружает этот ресурс по ссылке, хранящейся
в параметре "Layout Display Name".
Теперь определим, какие раскладки загружены. Это делается при помощи функции GetKeyboardLayoutList, которая копирует
идентификаторы, соответствующие текущему набору языков ввода в системе, в заданный буфер.
procedure TLoadedKeyboardLayouts.Load;
var
Null: Pointer;
Count: Cardinal;
AklName: array[0..255] of Char;
i: Integer;
begin
GetMem(Null, 0);
FLayoutsCount := GetKeyboardLayoutList(0, Null^);
FreeMem(Null);
GetMem(FLayouts, SizeOf(HKL) * FLayoutsCount);
try
Count := GetKeyboardLayoutList(SizeOf(FLayouts) * FLayoutsCount, FLayouts^);
if Count <> FLayoutsCount then
raise Exception.Create('Error loading keyboard layout list');
except
FreeMem(FLayouts);
end;
end;
|
После этого в буфере, на который указывает переменная FLayouts, будут храниться дескрипторы клавиатурных раскладок
в виде последовательности DWORD’ов. Работать с этим буфером можно при помощи простой арифметики указателей.
function TLoadedKeyboardLayouts.Exist(Layout, Id: Word): Boolean;
var
i: Integer;
_Lo, _Hi, _Id: Word;
begin
for i := 0 to Pred(FLayoutsCount) do
begin
Result := Word(Pointer(HKL(FLayouts) + i * SizeOf(HKL))^) = LoWord(Layout);
if Result then
if Id = 0 then
begin
_Lo := Word(Pointer(HKL(FLayouts) + i * SizeOf(HKL))^);
_Hi := HiWord(Integer(Pointer(HKL(FLayouts) + i * SizeOf(HKL))^));
Result := _Lo = _Hi;
end
else
begin
_Id := (Integer(Pointer(HKL(FLayouts) + i * SizeOf(HKL))^) shr 16) and $FF;
Result := _Id = Id;
end;
if Result then
Break;
end;
end;
|
В частности, в демонстрационном примере, в процессе построения списка раскладок нужно инициализировать строки,
соответствующие загруженным раскладкам, идентификаторами этих самых раскладок.
procedure TMainForm.FormCreate(Sender: TObject);
var
i: Integer;
li: TListItem;
Data: ^HKL;
Layout, ErrorCode: Integer;
begin
KeyboardLayout := Keyboard.Layouts.TKeyboardLayouts.Create;
{...}
for i := 0 to Pred(KeyboardLayout.System.Count) do
begin
li := lvKeyboardLayouts.Items.Add;
with KeyboardLayout.System.Layouts[i] do
begin
li.ImageIndex := Abs(Integer(Preload));
li.SubItems.Add(DisplayName);
li.SubItems.Add(Code);
Val('$' + Code, Layout, ErrorCode);
if Preload or KeyboardLayout.Loaded.Exist(LoWord(Layout), Id) then
begin
New(Data);
Data^ := KeyboardLayout.Loaded.GetHKL(Code);
if Data^ > 0 then
li.Data := Data
else
Dispose(Data);
end;
end;
end;
end;
|
Здесь пришлось решить одну проблему. В момент построения списка у нас есть только имена раскладок, вроде “00000409”
или “00000419”. Я не нашел стандартной API функции, которая по имени раскладки сможет “сказать”, загружена эта
раскладка или нет, так что пришлось изобретать свой велосипед.
Для этого внимательно посмотрим на то, как идентификаторы раскладок хранятся в памяти, и попробуем сопоставить их
со строковыми идентификаторами. На скриншоте показаны 3 идентификатора для раскладок “00000409” (США), “00000419”
(Русская) и “00060408” (Греческая политоническая).
Для начала рассмотрим 2 первых идентификатора (соответствующие им имена имеют нули в старшем слове). Как видим
младшее и старшее слова идентификатора содержат идентичное значение, равное младшему слову имени раскладки. Теперь
посмотрим на 3-й идентификатор, его младшее слово равно младшему слову имени раскладки, а младший байт старшего слова
равен значению параметра “Layout Id”, о котором я упоминал немного выше.
Кстати, если кто забыл (или не знал), байты в памяти хранятся в порядке от младшего к старшему (little-endian), он
принят в персональных компьютерах с x86-процессорами, в связи с чем иногда его называют интеловский порядок байт
(по названию фирмы-создателя архитектуры x86). Для справки: есть еще порядок от старшего к младшему (big-endian),
который является стандартным для протоколов TCP/IP (он используется в заголовках пакетов данных и во многих протоколах
более высокого уровня). Поэтому, порядок байтов от старшего к младшему часто называют сетевым порядком байтов.
Теперь, понимая, каким образом формируется идентификатор раскладки, вы легко поймете принцип работы приведенной выше
функции Exist.
Еще хотелось бы обратить внимание на нюанс вызова функции GetHKL при построении списка. Сама процедура выглядит
следующим образом:
function TLoadedKeyboardLayouts.GetHKL(LayoutId: string): HKL;
begin
Result := LoadKeyboardLayout(LayoutId, 0);
end;
|
Функция LoadKeyboardLayout загружает раскладку и возвращает ее идентификатор, но так как второй параметр равен 0,
не делает загруженную раскладку активной. Именно по этой причине вызывать функции GetHKL нужно только в том
случае, если функция Exist отработала успешно (то есть раскладка загружена).
Двигаемся дальше и смотрим, как загружаются и выгружаются раскладки:
function TLoadedKeyboardLayouts.Install(LayoutId: string): HKL;
begin
Result := LoadKeyboardLayout(LayoutId, KLF_ACTIVATE);
end;
function TLoadedKeyboardLayouts.Uninstall(LayoutId: HKL): Boolean;
begin
Result := UnloadKeyboardLayout(LayoutId);
end;
|
Думаю, лингвистам придется по душе такая картинка! Тут невольно пожалеешь о том, что под рукой нет клавиатуры с
мониторчиками на клавишах, чтобы они отображали символы, соответствующие загруженной раскладке.
Ну ладно, помечтали и хватит, двигаемся дальше. Не менее важно научиться переключаться между раскладками:
const
INPUTLANGCHANGE_SYSCHARSET = $0001;
INPUTLANGCHANGE_FORWARD = $0002;
INPUTLANGCHANGE_BACKWARD = $0004;
{...}
procedure TLoadedKeyboardLayouts.Next;
begin
PostMessage(Application.Handle, WM_INPUTLANGCHANGEREQUEST,
INPUTLANGCHANGE_BACKWARD, 1);
end;
procedure TLoadedKeyboardLayouts.Prev;
begin
PostMessage(Application.Handle, WM_INPUTLANGCHANGEREQUEST,
INPUTLANGCHANGE_FORWARD, 0);
end;
function TLoadedKeyboardLayouts.Activate(Lang: HKL): Boolean;
var
Buf: array[0..255] of Char;
begin
Result := ActivateKeyboardLayout(Lang, 0) <> 0;
if Result then
begin
GetLocaleInfo(LoWord(Lang), LOCALE_ILANGUAGE, Buf, SizeOf(Buf));
PostMessage(Application.Handle, WM_INPUTLANGCHANGEREQUEST, 0, LParam(@Buf));
end;
end;
|
С переходом к следующей/предыдущей раскладке нет никаких проблем, а вот с переключением на произвольно выбранную
раскладку пришлось немного повозиться. По моим наблюдениям функция ActivateKeyboardLayout не всегда отрабатывает
корректно. Опишу ситуацию немного поподробнее. У меня не машине установлена русскоязычная Windows, но раскладка
по умолчанию английская. Так вот, при переключении на любую раскладку, отличную от английской, ActivateKeyboardLayout
отрабатывает нормально, но вот переключать на английскую раскладку функция упорно отказывается. Вызов PostMessage
помогает справиться с этой проблемой.
Еще один момент, который не стоит обходить стороной, реакция на изменение раскладки. Если нужно просто определить
факт изменения раскладки, достаточно перехватить сообщение WM_INPUTLANGCHANGE (или CM_INPUTLANGCHANGE).
type
TForm1 = class(TForm)
private
procedure WMInputLangchange(var Msg: TMessage); message WM_INPUTLANGCHANGE;
end;
|
А вот если нужно предотвратить изменение раскладки, предусмотрено сообщение WM_INPUTLANGCHANGEREQUEST. Проблема в том,
что начиная с Windows XP приложения больше не получают это сообщение (подробнее можно почитать в статье
"Что сломало
сообщения о языке ввода?"). Теперь, чтобы предотвратить переключение раскладки, нужно подключиться к Text Services.
Вот как это делается:
procedure TKeyboardLayouts.ConnectToLanguageProfileNotifications;
begin
FInputProcessorProfiles := CreateComObject(IID_ITfInputProcessorProfiles);
try
FInputProcessorProfiles.QueryInterface(IID_ITfSource, FSource);
try
(FSource as ITfSource).AdviseSink(
TGUID(IID_ITfLanguageProfileNotifySink),
ITfLanguageProfileNotifySink(Self),
FpdwCookie);
except
FSource := nil;
end;
except
FInputProcessorProfiles := nil;
end;
end;
function TKeyboardLayouts.OnLanguageChange(langid: Word;
out pfAccept: Integer): HResult;
begin
if Assigned(FLanguageChanged) then
Result := FLanguageChange(langid, pfAccept);
end;
function TKeyboardLayouts.OnLanguageChanged: HResult;
begin
if Assigned(FLanguageChange) then
Result := FLanguageChanged;
end;
|
А как вам такая ситуация? Вы установили Windows и языком системы указали русский (и русскую раскладку при загрузке системы),
а пароль на вход установил на английском. Теперь, чтобы войти в систему, надо для начала переключить раскладку, а затем уже
вводить пароль. Конечно, не велика беда — переключился и вводи пароль, но если переключаться постоянно, это может очень сильно
надоесть. Чтобы исправить ситуацию, достаточно в разделе реестра
HKEY_USERS\.DEFAULT\Keyboard Layout\Preload
или
HKEY_CURRENT_USER\Keyboard Layout\Preload
|
поставить на первое место нужную раскладку.
function TSystemKeyboardLayouts.Reorder(Layouts: TStrings): Boolean;
var
i: Integer;
Reg: TRegistry;
Names: TStrings;
Value: string;
const
Key =
{$IFDEF HKEY_USERS}
'.DEFAULT\Keyboard Layout\Preload'
{$ELSE}
'Keyboard Layout\Preload'
{$ENDIF};
begin
Result := False;
Reg := TRegistry.Create(KEY_READ or KEY_WRITE or KEY_WOW64_64KEY);
Reg.RootKey :=
{$IFDEF HKEY_USERS}
HKEY_USERS
{$ELSE}
HKEY_CURRENT_USER
{$ENDIF};
if Reg.OpenKey(Key, False) then
begin
Names := TStringList.Create;
Reg.GetValueNames(Names);
for i := 0 to Names.Count-1 do
Reg.DeleteValue(Names[i]);
for i := 0 to Names.Count-1 do
begin
Value := Copy(TRegEx.Match(Layouts[i], '\[\d+\]$').Value, 2, 8);
Reg.WriteString(IntToStr(i+1), Value);
end;
Result := True;
Reg.CloseKey;
end;
Reg.Free;
end;
|
Если в этот раздел добавить другие раскладки, они тоже будут загружаться при старте Windows (а можно и удалить что-нибудь “лишнее”).
А для того, чтобы изменить горячие клавиши, отвечающие за переключение раскладок, достаточно подправить раздел реестра
HKEY_USERS\.DEFAULT\Keyboard Layout\Toggle
или
HKEY_CURRENT_USER\Keyboard Layout\Toggle
|
TLayoutHotkey = (lhAltShift = 1, lhCtrlShift = 2, lhNone = 3, lhAccentMark = 4);
{...}
function TKeyboardLayouts.GetLanguageHotkey: TLayoutHotkey;
var
Reg: TRegistry;
s: string;
const
Key = 'Keyboard Layout\Toggle';
begin
Reg := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKeyReadOnly(Key) then
begin
s := Reg.ReadString('Language Hotkey');
Result := TLayoutHotkey(StrToInt(Reg.ReadString('Language Hotkey')));
Reg.CloseKey;
end;
Reg.Free;
end;
procedure TKeyboardLayouts.SetLanguageHotkey(const Value: TLayoutHotkey);
var
Reg: TRegistry;
const
Key = 'Keyboard Layout\Toggle';
begin
Reg := TRegistry.Create(KEY_WRITE or KEY_WOW64_64KEY);
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey(Key, False) then
begin
Reg.WriteString('Hotkey', IntToStr(Integer(Value)));
Reg.WriteString('Language Hotkey', IntToStr(Integer(Value)));
Reg.CloseKey;
end;
Reg.Free;
end;
function TKeyboardLayouts.GetLayoutHotkey: TLayoutHotkey;
var
Reg: TRegistry;
const
Key = 'Keyboard Layout\Toggle';
begin
Reg := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKeyReadOnly(Key) then
begin
Result := TLayoutHotkey(StrToInt(Reg.ReadString('Layout Hotkey')));
Reg.CloseKey;
end;
Reg.Free;
end;
procedure TKeyboardLayouts.SetLayoutHotkey(const Value: TLayoutHotkey);
var
Reg: TRegistry;
const
Key = 'Keyboard Layout\Toggle';
begin
Reg := TRegistry.Create(KEY_WRITE or KEY_WOW64_64KEY);
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey(Key, False) then
begin
Reg.WriteString('Layout Hotkey', IntToStr(Integer(Value)));
Reg.CloseKey;
end;
Reg.Free;
end;
|
Напоследок хочу предостеречь – не давайте проекту, в котором используется компонент TTouchKeyboard, имя “KeyboardLayouts”.
Именно такое имя я сначала дал демонстрационному проекту, и получил неожиданный сюрприз в виде вот такого сообщения, которое
появляется после переключения раскладки в приложении.
Виной тому является файл KeyboardLayouts.res (имя файла совпадает с именем проекта), создаваемый средой разработки при компиляции
проекта. Он подменяет собой одноименный ресурс из
$(BDS)\lib\win32\release
или
$(BDS)\lib\win64\release
|
который подключается в модуле Vcl.Touch.Keyboard.
{...}
{$R KeyboardLayouts.res}
{...}
|
Странно, что такое поведение наблюдается только в отладочном (DEBUG) режиме, а при сборке релиза (RELEASE) все отлично работает (в
отладочное приложение не попадают ресурсы, требующиеся виртуальной клавиатуре). Но разбираться с этим я уже не стал, если хотите,
попробуйте сами. А у меня на этом все, будьте внимательны и удачи в программировании!
.: Пример к данной статье :.
|
При использовании материала - ссылка на сайт обязательна
|
|