paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-21 23:19:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@55461 -
This commit is contained in:
ondrej 2017-07-08 05:13:03 +00:00
parent 39b48d2cf9
commit 30af49386d
2 changed files with 47 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
lcl/interfaces/win32/win32callback.inc
View File

@ -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;
WS: WideString;
OldUTF8Char: TUTF8Char;
CharLen: integer;
begin
Result := False;
UTF8Char := UTF16ToUTF8(WideString(AChar));
OldUTF8Char := UTF8Char;
OldUTF8Char := AChar;
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);
if Result then
begin
WS := UTF8ToUTF16(UTF8Char);
if Length(WS) > 0 then
AChar := WS[1]
else
AChar := #0;
end;
Result := not WinProcess or (AChar <> OldUTF8Char);
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;

2
lcl/interfaces/win32/win32int.pp
View File

@ -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,