LCL-Win32: Process surrogate pairs correctly when virtual keyboard is used. Attempt #2; Issue #32101.

git-svn-id: trunk@55461 -

lcl/interfaces/win32/win32callback.inc

@@ -384,7 +384,7 @@ type
     function IsComboEditSelection: boolean;
     procedure HandleBitBtnCustomDraw(ABitBtn: TCustomBitBtn);
     procedure HandleDropFiles;
-    function HandleUnicodeChar(var AChar: WideChar): boolean;
+    function HandleUnicodeChar(var AChar: TUTF8Char): boolean;
     procedure UpdateDrawItems;
     procedure UpdateDrawListItem(aMsg: UInt);
     procedure UpdateLMMovePos(X, Y: Smallint);
@@ -1114,28 +1114,19 @@ begin
 end;
 
 // returns false if the UnicodeChar is not handled
-function TWindowProcHelper.HandleUnicodeChar(var AChar: WideChar): boolean;
+function TWindowProcHelper.HandleUnicodeChar(var AChar: TUTF8Char): boolean;
 var
-  OldUTF8Char, UTF8Char: TUTF8Char;
+  OldUTF8Char: TUTF8Char;
-  WS: WideString;
+  CharLen: integer;
 begin
   Result := False;
-  UTF8Char := UTF16ToUTF8(WideString(AChar));
+  OldUTF8Char := AChar;
-  OldUTF8Char := UTF8Char;
   if Assigned(lWinControl) then
   begin
     // if somewhere key is changed to '' then don't process this message
-    WinProcess := not lWinControl.IntfUTF8KeyPress(UTF8Char, 1, False);
+    WinProcess := not lWinControl.IntfUTF8KeyPress(AChar, 1, False);
     // if somewhere key is changed then don't perform a regular keypress
-    Result := not WinProcess or (UTF8Char <> OldUTF8Char);
+    Result := not WinProcess or (AChar <> OldUTF8Char);
-    if Result then
-    begin
-      WS := UTF8ToUTF16(UTF8Char);
-      if Length(WS) > 0 then
-        AChar := WS[1]
-      else
-        AChar := #0;
-    end;
   end;
 end;
 
@@ -1231,14 +1222,43 @@ begin
 end;
 
 procedure TWindowProcHelper.DoMsgChar(var WinResult: LResult);
+var
+  AHIMC: HIMC;
+  NewKeyLen: LONG;
+  NewKey: WideString;
+  NewKeyUTF8: TUTF8Char;
 begin
   OrgCharCode := Word(WParam);
-  // Process surrogate pairs later
+
   if TCharacter.IsSurrogate(WideChar(OrgCharCode)) then
-    WinProcess := True
+  begin
+    WinProcess := True;
+    Exit;
+  end;
+
+  AHIMC := ImmGetContext(Window);
+  if AHIMC<>0 then
+  begin
+    try
+      NewKeyLen := ImmGetCompositionStringW(AHIMC, GCS_RESULTSTR, nil, 0);
+      SetLength(NewKey, NewKeyLen div 2);
+      if Length(NewKey)>0 then
+      begin
+        ImmGetCompositionStringW(AHIMC, GCS_RESULTSTR, PWideChar(NewKey), NewKeyLen);
+        ImmSetCompositionStringW(AHIMC, SCS_SETSTR, nil, 0, nil, 0);
+      end else // no IME
+        NewKey := WideChar(OrgCharCode);
+    finally
+      ImmReleaseContext(Window, AHIMC);
+    end;
+  end else
+    NewKey := WideChar(OrgCharCode);
+
+  NewKeyUTF8 := UTF8Encode(NewKey);
+
   // first send a IntfUTF8KeyPress to the LCL
   // if the key was not handled send a CN_CHAR for AnsiChar<=#127
-  else if not HandleUnicodeChar(WideChar(OrgCharCode)) then
+  if not HandleUnicodeChar(NewKeyUTF8) then
   begin
     PLMsg := @LMChar;
     with LMChar do
@@ -1252,7 +1272,13 @@ begin
     WinProcess := false;
   end
   else
-    WParam := OrgCharCode;
+  begin
+    NewKey := UTF8Decode(NewKeyUTF8);
+    if NewKey<>'' then
+      WParam := Word(NewKey[1]) // if char is changed in UTF8KeyPress, surrogate pairs are not supported
+    else
+      WParam := 0;
+  end;
 end;
 
 procedure TWindowProcHelper.DoCmdCheckBoxParam;

lcl/interfaces/win32/win32int.pp

@@ -28,7 +28,7 @@ interface
   successful compilation.
 }
 uses
-  Windows, // keep as first
+  Windows, imm, // keep as first
   Classes, SysUtils, RtlConsts, ActiveX, MultiMon, CommCtrl, character,
   // LCL
   LCLPlatformDef, InterfaceBase, LCLIntf, LclProc, LCLType, LMessages,