diff --git a/windows/src/engine/kmcomapi/com/options/keymanoptions.pas b/windows/src/engine/kmcomapi/com/options/keymanoptions.pas
index 66244419c0..f3bb696802 100644
--- a/windows/src/engine/kmcomapi/com/options/keymanoptions.pas
+++ b/windows/src/engine/kmcomapi/com/options/keymanoptions.pas
@@ -26,10 +26,11 @@ unit keymanoptions;
interface
uses
- ComObj,
- ActiveX,
+ System.Win.ComObj,
+ System.Win.StdVCL,
+ Winapi.ActiveX,
+
keymanapi_TLB,
- StdVcl,
keymanautoobject,
KeymanContext,
keymanoption,
@@ -59,16 +60,16 @@ type
implementation
uses
- Windows,
- ComServ,
+ Winapi.Windows,
+ System.SysUtils,
+ System.Variants,
+
ErrorControlledRegistry,
RegistryKeys,
- SysUtils,
Glossary,
+ Keyman.System.BaseKeyboard,
KeymanOptionNames,
- keymanerrorcodes,
- Variants,
- utilkeyman;
+ keymanerrorcodes;
constructor TKeymanOptions.Create(AContext: TKeymanContext);
begin
@@ -119,10 +120,10 @@ begin
begin
if ValueExists(SRegValue_UnderlyingLayout)
then FOldBaseLayout := StrToIntDef('$'+ReadString(SRegValue_UnderlyingLayout),0) // I3759
- else FOldBaseLayout := GetDefaultKeyboardID;
+ else FOldBaseLayout := TBaseKeyboard.GetDefaultKeyboardID;
end
else
- FOldBaseLayout := GetDefaultKeyboardID;
+ FOldBaseLayout := TBaseKeyboard.GetDefaultKeyboardID;
finally
Free;
end;
@@ -149,7 +150,7 @@ begin
v := Get_Items('koBaseLayout');
if v.Value = v.DefaultValue then
- v.Value := GetDefaultKeyboardID;
+ v.Value := TBaseKeyboard.GetDefaultKeyboardID;
end;
end.
diff --git a/windows/src/engine/kmcomapi/kmcomapi.dpr b/windows/src/engine/kmcomapi/kmcomapi.dpr
index e77f63f1b9..e1832fa93b 100644
--- a/windows/src/engine/kmcomapi/kmcomapi.dpr
+++ b/windows/src/engine/kmcomapi/kmcomapi.dpr
@@ -152,7 +152,8 @@ uses
Keyman.System.Process.KPInstallKeyboardLanguage in 'processes\keyboard\Keyman.System.Process.KPInstallKeyboardLanguage.pas',
Keyman.System.Process.KPUninstallKeyboardLanguage in 'processes\keyboard\Keyman.System.Process.KPUninstallKeyboardLanguage.pas',
Keyman.System.Standards.LangTagsRegistry in '..\..\global\delphi\standards\Keyman.System.Standards.LangTagsRegistry.pas',
- Keyman.System.AndroidStringToKeymanLocaleString in '..\..\global\delphi\general\Keyman.System.AndroidStringToKeymanLocaleString.pas';
+ Keyman.System.AndroidStringToKeymanLocaleString in '..\..\global\delphi\general\Keyman.System.AndroidStringToKeymanLocaleString.pas',
+ Keyman.System.BaseKeyboard in 'util\Keyman.System.BaseKeyboard.pas';
{$R *.TLB}
{$R *.RES}
diff --git a/windows/src/engine/kmcomapi/kmcomapi.dproj b/windows/src/engine/kmcomapi/kmcomapi.dproj
index 1bef9fa48f..b11ff10ddc 100644
--- a/windows/src/engine/kmcomapi/kmcomapi.dproj
+++ b/windows/src/engine/kmcomapi/kmcomapi.dproj
@@ -293,6 +293,7 @@
+
Cfg_2
diff --git a/windows/src/engine/kmcomapi/util/Keyman.System.BaseKeyboard.pas b/windows/src/engine/kmcomapi/util/Keyman.System.BaseKeyboard.pas
new file mode 100644
index 0000000000..21d2ea1e69
--- /dev/null
+++ b/windows/src/engine/kmcomapi/util/Keyman.System.BaseKeyboard.pas
@@ -0,0 +1,183 @@
+unit Keyman.System.BaseKeyboard;
+
+interface
+
+uses
+ Winapi.Windows;
+
+type
+ TBaseKeyboard = class sealed
+ private
+ class function IsLatinScriptLayout(Layout: DWORD): Boolean; static;
+ public
+ class function GetDefaultKeyboardID: DWORD; static;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Win.Registry,
+
+ Glossary,
+ RegistryKeys,
+ utilkeyman;
+
+const
+ BaseKeyboardID_USEnglish: Integer = $00000409;
+
+ // List constructed from Win10 20H2, Mar 2021
+ KnownLatinScriptLayouts: array[0..93] of DWORD = (
+ $00000405, // Czech
+ $00000406, // Danish
+ $00000407, // German
+ $00000409, // US
+ $0000040a, // Spanish
+ $0000040b, // Finnish
+ $0000040c, // French
+ $0000040e, // Hungarian
+ $0000040f, // Icelandic
+ $00000410, // Italian
+ $00000413, // Dutch
+ $00000414, // Norwegian
+ $00000415, // Polish (Programmers)
+ $00000416, // Portuguese (Brazilian ABNT)
+ $00000418, // Romanian (Legacy)
+ $0000041a, // Standard
+ $0000041b, // Slovak
+ $0000041c, // Albanian
+ $0000041d, // Swedish
+ $0000041f, // Turkish Q
+ $00000424, // Slovenian
+ $00000425, // Estonian
+ $00000426, // Latvian
+ $00000427, // Lithuanian IBM
+ $0000042a, // Vietnamese
+ $0000042c, // Azeri Latin
+ $0000042e, // Sorbian Standard (Legacy)
+ $00000432, // Setswana
+ $00000438, // Faeroese
+ $0000043a, // Maltese 47-Key
+ $0000043b, // Norwegian with Sami
+ $00000442, // Turkmen
+ $00000452, // United Kingdom Extended
+ $00000468, // Hausa
+ $0000046a, // Yoruba
+ $0000046c, // Sesotho sa Leboa
+ $0000046e, // Luxembourgish
+ $0000046f, // Greenlandic
+ $00000470, // Igbo
+ $00000474, // Guarani
+ $00000475, // Hawaiian
+ $00000481, // Maori
+ $00000488, // Wolof
+ $00000807, // Swiss German
+ $00000809, // United Kingdom
+ $0000080a, // Latin American
+ $0000080c, // Belgian French
+ $00000813, // Belgian (Period)
+ $00000816, // Portuguese
+ $0000081a, // Serbian (Latin)
+ $0000083b, // Swedish with Sami
+ $0000085d, // Inuktitut - Latin
+ $0000085f, // Central Atlas Tamazight
+ $00000c0c, // Canadian French (Legacy)
+ $00001009, // Canadian French
+ $0000100c, // Swiss French
+ $00001809, // Irish
+ $00004009, // India
+ $00010402, // Bulgarian (Latin)
+ $00010405, // Czech (QWERTY)
+ $00010407, // German (IBM)
+ $00010409, // United States-Dvorak
+ $0001040a, // Spanish Variation
+ $0001040e, // Hungarian 101-key
+ $00010410, // Italian (142)
+ $00010415, // Polish (214)
+ $00010416, // Portuguese (Brazilian ABNT2)
+ $00010418, // Romanian (Standard)
+ $0001041b, // Slovak (QWERTY)
+ $0001041f, // Turkish F
+ $00010426, // Latvian (QWERTY)
+ $00010427, // Lithuanian
+ $0001042c, // Azerbaijani (Standard)
+ $0001042e, // Sorbian Extended
+ $0001043a, // Maltese 48-Key
+ $0001043b, // Sami Extended Norway
+ $0001045d, // Inuktitut - Naqittaut
+ $0001080c, // Belgian (Comma)
+ $0001083b, // Finnish with Sami
+ $00011009, // Canadian Multilingual Standard
+ $00011809, // Gaelic
+ $00020405, // Czech Programmers
+ $00020409, // United States-International
+ $00020418, // Romanian (Programmers)
+ $00020426, // Latvian (Standard)
+ $00020427, // Lithuanian Standard
+ $0002042e, // Sorbian Standard
+ $0002083b, // Sami Extended Finland-Sweden
+ $00030408, // Greek (220) Latin
+ $00030409, // United States-Dvorak for left hand
+ $00040408, // Greek (319) Latin
+ $00040409, // United States-Dvorak for right hand
+ $00050408, // Greek Latin
+ $00050409 // US English Table for IBM Arabic 238_L
+ );
+
+// Tests if the reported base layout is known to be Latin script or not
+//
+// We work off a database of known layouts, then fallback to our cache. If not
+// found in the cache, or the cache has not yet been built, then we'll assume it
+// isn't a Latin script layout.
+//
+// The reason we do this is while we can determine algorithmically that a given
+// layout is Latin-script based, this involves a fairly costly load of the
+// layout DLL and enumeration of every key on the keyboard. We don't want to be
+// loading the layout DLL every time that the COM objects are instantiated; both
+// because of the cost and also to avoid any potential side-effects.
+//
+// If the user has chosen a layout that is not present in our known layouts
+// list, through the Base Keyboard dialog, we can safely assume the cache has
+// been built -- because the cache has to be populated in order to present the
+// list of available layouts in kmshell's BaseKeyboards classes.
+//
+class function TBaseKeyboard.IsLatinScriptLayout(Layout: DWORD): Boolean;
+var
+ i: DWord;
+ r: TRegistry;
+begin
+ // Check our known Latin script layouts first, because we may not yet
+ // have built our local cache
+ for i in KnownLatinScriptLayouts do
+ if i = Layout then
+ Exit(True);
+
+ // Otherwise, our Latin script keyboard cache in the registry tells us
+ // if this is a known Latin-script layout
+ r := TRegistry.Create;
+ try
+ r.RootKey := HKEY_LOCAL_MACHINE;
+ Result :=
+ r.OpenKeyReadOnly(SRegKey_LatinKeyboardCache_LM) and
+ r.ValueExists(IntToHex(Layout, 8)) and
+ (r.ReadString(SRegKey_LatinKeyboardCache_LM) = '1');
+ finally
+ r.Free;
+ end;
+end;
+
+//
+// Return only a valid Latin script base layout keyboard id
+//
+class function TBaseKeyboard.GetDefaultKeyboardID: DWORD; // I4169
+begin
+ Result := GetDefaultHKL;
+
+ if Result <> 0 then
+ Result := HKLToKeyboardID(Result);
+
+ if (Result = 0) or not IsLatinScriptLayout(Result) then
+ Result := BaseKeyboardID_USEnglish;
+end;
+
+end.
diff --git a/windows/src/engine/kmcomapi/util/utilkeyman.pas b/windows/src/engine/kmcomapi/util/utilkeyman.pas
index 7f02ede325..3da7af5b25 100644
--- a/windows/src/engine/kmcomapi/util/utilkeyman.pas
+++ b/windows/src/engine/kmcomapi/util/utilkeyman.pas
@@ -57,7 +57,6 @@ function GetKeyboardIconFileName(const KeyboardFileName: string): string; // I
function GetKeymanInstallPath: string;
function GetDefaultHKL: HKL; // I3581 // I3619 // I3619
-function GetDefaultKeyboardID: HKL; // I4169
var
FInstallingKeyman: Boolean = False;
@@ -306,18 +305,4 @@ begin
Result := 0;
end;
-function GetDefaultKeyboardID: HKL; // I4169
-const
- BaseKeyboardID_USEnglish: Integer = $00000409;
-begin
- if not SystemParametersInfo(SPI_GETDEFAULTINPUTLANG, 0, @Result, 0) then
- Result := 0;
-
- if Result <> 0 then
- Result := HKLToKeyboardID(Result);
-
- if Result = 0 then
- Result := BaseKeyboardID_USEnglish;
-end;
-
end.