[技巧] 解决 Windows 8 / 10 无法通过 Screen 的 Imes 正确获取当前安装的输入法列表的问题

【问题原因】

该问题是由于微软从 Windows 8  开始，GetKeyboadLayouts 函数不再有效，而 VCL 中仍然是通过该方法获取输入法列表造成的。希望下个版本的 Delphi/C++ Builder 能够解决。

【解决办法】

如果是 Win8+，则自己从注册表读，如果是Win 7 等以前的版本，则直接取 Screen.Imes。这个函数做了一个简单的封装。

procedure EnumImeNames(AList: TStrings);
var
  AReg: TRegistry;
  AKeyList: TStringList;
  I: Integer;
  ALayout: Cardinal;
  function NameByLayout: String;
  const
    KbLayoutRegkeyFmt =
      'System\CurrentControlSet\Control\Keyboard Layouts\%.8x';
    KbLayoutRegSubkey = 'layout text';
  var
    AIMEReg: TRegistry;
  begin
    SetLength(Result, 0);
    AIMEReg := TRegistry.Create;
    try
      AIMEReg.RootKey := HKEY_LOCAL_MACHINE;
      if AIMEReg.OpenKeyReadOnly(Format(KbLayoutRegkeyFmt, [ALayout])) then
      begin
        if AIMEReg.ValueExists(KbLayoutRegSubkey) then
          Result := AIMEReg.ReadString(KbLayoutRegSubkey)
      end;
    finally
      FreeAndNil(AIMEReg);
    end;
  end;

  function NameByClsId(AClsId: String): String;
  var
    AIMEReg: TRegistry;
  begin
    SetLength(Result, 0);
    AIMEReg := TRegistry.Create;
    try
      AIMEReg.RootKey := HKEY_CLASSES_ROOT;
      if AIMEReg.OpenKeyReadOnly('CLSID\' + AClsId) then
        Result := AIMEReg.ReadString('');
    finally
      FreeAndNil(AIMEReg);
    end;
  end;

const
  CnImeRoot =
    'Software\Microsoft\CTF\SortOrder\AssemblyItem\0x00000804\{34745C63-B2F0-4784-8B67-5E12C8701A31}';
begin
if CheckWin32Version(6,2) then
  begin
  AKeyList := TStringList.Create;
  AReg := TRegistry.Create;
  AList.BeginUpdate;
  try
    AReg.RootKey := HKEY_CURRENT_USER;
    if AReg.OpenKeyReadOnly(CnImeRoot) then
    begin
      AReg.GetKeyNames(AKeyList);
      AReg.CloseKey;
      for I := 0 to AKeyList.Count - 1 do
      begin
        if AReg.OpenKeyReadOnly(CnImeRoot+'\'+AKeyList[I]) then
        begin
          if AReg.ValueExists('KeyboardLayout') then
            ALayout := AReg.ReadInteger('KeyboardLayout')
          else
            ALayout := 0;
          if ALayout > 0 then
            AList.Add(NameByLayout)
          else if AReg.ValueExists('CLSID') then
            AList.Add(NameByClsId(AReg.ReadString('CLSID')));
          AReg.CloseKey;
        end;
      end;
    end;
  finally
    FreeAndNil(AReg);
    FreeAndNil(AKeyList);
    AList.EndUpdate;
  end;
  end
else
  AList.Assign(Screen.Imes);
end;

【另附】

黑夜杀手提供的一个设置默认输入法的函数，提供给需要的朋友：

procedure SetDefaultCNIME(AForm: TForm; IMEKeyStr: string = '五笔');
var
  I, idx: Integer;
  IMESList: TStringList;
begin
  IMESList := TStringList.Create;
  EnumImeNames(IMESList);
  try
    if IMESList.Count > 0 then
    begin
      { 开始初始化默认中文输入法 }
      idx := -1;
      for I := 0 to IMESList.Count - 1 do
      begin
        if IMESList[I].Contains(IMEKeyStr) then
        begin
          idx := I;
          Break;
        end;
      end;
      if idx = -1 then
      begin
        for I := 0 to IMESList.Count - 1 do
        begin
          if IMESList[I].Contains('拼音') then
          // 如果找不到指定的输入法，则设置为拼音
          begin
            idx := I;
            Break;
          end;
        end;
      end;
      if idx = -1 then
      begin
        if IMESList.Count > 0 then
        begin
          idx := 0;
        end
        else
        begin
          exit;
        end;
      end;
      for I := 0 to AForm.ComponentCount - 1 do
      begin
        if AForm.Components[I] is TMemo then
          TMemo(AForm.Components[I]).ImeName := IMESList[idx];
        if AForm.Components[I] is TEdit then
          TEdit(AForm.Components[I]).ImeName := IMESList[idx];
        if AForm.Components[I] is TLabeledEdit then
          TEdit(AForm.Components[I]).ImeName := IMESList[idx];
      end;
      { 结束初始化默认中文输入法 }
    end; 
  finally
    IMESList.Free;
  end;
end;

【注意】

在执行上述操作之前，请确认已经修改注册表，允许每个应用独立控制输入法，黑夜杀手提供的参考代码如下：

procedure SetDiffInputMethodInSeperateApp;
//http://superuser.com/questions/839993/find-registry-key-for-windows-8-per-application-input-method-setting
var
  AReg: TRegistry;
  MyValue: array [0 .. 7] of Byte;
  // =[$9e,$1e,$07,$80,$92,$00,$00,$00]; on
  // =[$9e,$1e,$07,$80,$12,$00,$00,$00]; off
const
  ImeMethodSetRoot =
    'Control Panel\Desktop';
begin
  if CheckWin32Version(6, 2) then
  begin
    AReg := TRegistry.Create;
    try
      AReg.RootKey := HKEY_CURRENT_USER;
      if AReg.OpenKey(ImeMethodSetRoot, False) then
      begin
        if AReg.ValueExists('UserPreferencesMask') then
        begin
          AReg.ReadBinaryData('UserPreferencesMask', MyValue, 8);
          MyValue[4] := $92;
          AReg.WriteBinaryData('UserPreferencesMask', MyValue, 8);
        end;
        AReg.CloseKey;
      end;
    finally
      FreeAndNil(AReg);
    end;
  end;
end;