View Issue Details

IDProjectCategoryView StatusLast Update
0035692LazarusWidgetsetpublic2019-06-10 14:48
ReporterAlexey Tor.Assigned ToDmitry Boyarintsev 
PrioritynormalSeverityminorReproducibilityN/A
Status resolvedResolutionfixed 
Product Version2.1 (SVN)Product Build 
Target VersionFixed in Version 
Summary0035692: Win32: bug with ExtTextOut with Dx param with Emoji
DescriptionSame as https://bugs.freepascal.org/view.php?id=35675
Win32 is incorrect the same way.

Take demo from that issue (change its target/WS to Win32).
Fix is made by me.
TagsNo tags attached.
Fixed in Revision61351
LazTarget-
Widgetset
Attached Files
  • dx.diff (2,558 bytes)
    Index: lcl/interfaces/win32/win32winapi.inc
    ===================================================================
    --- lcl/interfaces/win32/win32winapi.inc	(revision 61341)
    +++ lcl/interfaces/win32/win32winapi.inc	(working copy)
    @@ -1437,6 +1437,49 @@
         DebugLn('TWin32WidgetSet.ExtCreatePen returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
     end;
     
    +type
    +  _TIntArray = array of LongInt;
    +
    +function IsCharSurrogateHigh(ch: WideChar): Boolean; inline;
    +begin
    +  Result:= (ch>=#$D800) and (ch<=#$DBFF);
    +end;
    +
    +function IsCharSurrogateLow(ch: WideChar): Boolean; inline;
    +begin
    +  Result:= (ch>=#$DC00) and (ch<=#$DFFF);
    +end;
    +
    +procedure ConvertDxArrayFromUTF8ToWide(const S: WideString;
    +  Dx: PInteger; DxCount: integer; var Res: _TIntArray);
    +var
    +  DxIn: _TIntArray;
    +  iSrc, iDest: Integer;
    +begin
    +  SetLength(DxIn, DxCount);
    +  Move(Dx^, DxIn[0], DxCount*SizeOf(LongInt));
    +
    +  SetLength(Res, Length(S));
    +  FillChar(Res[0], Length(Res)*SizeOf(LongInt), 0);
    +
    +  iSrc := 0;
    +  for iDest := 1 to Length(S) do
    +  begin
    +    if iSrc>=DxCount then Break;
    +    if IsCharSurrogateLow(S[iDest]) then
    +    begin
    +      // 2nd char of surrogate pair: skip it, ie set size=0
    +      Res[iDest-1] := 0;
    +    end
    +    else
    +    begin
    +      // normal char or 1st char of surrogate pair: use its size
    +      Res[iDest-1] := DxIn[iSrc];
    +      Inc(iSrc);
    +    end;
    +  end;
    +end;
    +
     {------------------------------------------------------------------------------
       Method:  ExtTextOut
       Params:  DC      - handle to device context
    @@ -1456,6 +1499,7 @@
     var
       s: AnsiString;
       w: WideString;
    +  DxWide: _TIntArray;
     begin
       // use temp buffer, if count is set, there might be no null terminator
       if count = -1 then
    @@ -1465,10 +1509,17 @@
         SetLength(s, count);
         move(str^, PChar(s)^, count);
       end;
    -  // the length of utf8 vs Wide/Ansi the strings differ, so recalc.
    -  // TODO: use the real number of chars (and not the lenght)
    +
       W := UTF8ToUTF16(S);
    -  Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx);
    +
    +  if Dx=nil then
    +    Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx)
    +  else
    +  begin
    +    // must convert Dx: it's for UTF8 string, and WinAPI needs for WideString
    +    ConvertDxArrayFromUTF8ToWide(W, Dx, Count, DxWide);
    +    Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), @DxWide[0]);
    +  end;
     end;
     
     {------------------------------------------------------------------------------
    
    dx.diff (2,558 bytes)
  • dx2.diff (2,783 bytes)
    Index: lcl/interfaces/win32/win32winapi.inc
    ===================================================================
    --- lcl/interfaces/win32/win32winapi.inc	(revision 61341)
    +++ lcl/interfaces/win32/win32winapi.inc	(working copy)
    @@ -1437,6 +1437,58 @@
         DebugLn('TWin32WidgetSet.ExtCreatePen returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
     end;
     
    +function IsCharSurrogateHigh(ch: WideChar): Boolean; inline;
    +begin
    +  Result := (ch>=#$D800) and (ch<=#$DBFF);
    +end;
    +
    +function IsCharSurrogateLow(ch: WideChar): Boolean; inline;
    +begin
    +  Result := (ch>=#$DC00) and (ch<=#$DFFF);
    +end;
    +
    +function IsStringWithSurrogate(const S: WideString): boolean; inline;
    +var
    +  i: Integer;
    +begin
    +  for i := 1 to Length(S) do
    +    if IsCharSurrogateHigh(S[i]) then Exit(True);
    +  Result := False;
    +end;
    +
    +type
    +  _TIntArray = array of LongInt;
    +
    +procedure ConvertDxArrayFromUTF8ToWide(const S: WideString;
    +  Dx: PInteger; DxCount: integer; var Res: _TIntArray);
    +var
    +  DxIn: _TIntArray;
    +  iSrc, iDest: Integer;
    +begin
    +  SetLength(DxIn, DxCount);
    +  Move(Dx^, DxIn[0], DxCount*SizeOf(LongInt));
    +
    +  SetLength(Res, Length(S));
    +  FillChar(Res[0], Length(Res)*SizeOf(LongInt), 0);
    +
    +  iSrc := 0;
    +  for iDest := 1 to Length(S) do
    +  begin
    +    if iSrc>=DxCount then Break;
    +    if IsCharSurrogateLow(S[iDest]) then
    +    begin
    +      // 2nd char of surrogate pair: skip it, ie set size=0
    +      Res[iDest-1] := 0;
    +    end
    +    else
    +    begin
    +      // normal char or 1st char of surrogate pair: use its size
    +      Res[iDest-1] := DxIn[iSrc];
    +      Inc(iSrc);
    +    end;
    +  end;
    +end;
    +
     {------------------------------------------------------------------------------
       Method:  ExtTextOut
       Params:  DC      - handle to device context
    @@ -1456,6 +1508,7 @@
     var
       s: AnsiString;
       w: WideString;
    +  DxWide: _TIntArray;
     begin
       // use temp buffer, if count is set, there might be no null terminator
       if count = -1 then
    @@ -1465,10 +1518,17 @@
         SetLength(s, count);
         move(str^, PChar(s)^, count);
       end;
    -  // the length of utf8 vs Wide/Ansi the strings differ, so recalc.
    -  // TODO: use the real number of chars (and not the lenght)
    +
       W := UTF8ToUTF16(S);
    -  Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx);
    +
    +  if (Dx<>nil) and IsStringWithSurrogate(W) then
    +  begin
    +    // Dx is for UTF8 string, and WinAPI needs for WideString
    +    ConvertDxArrayFromUTF8ToWide(W, Dx, Count, DxWide);
    +    Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), @DxWide[0]);
    +  end
    +  else
    +    Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx);
     end;
     
     {------------------------------------------------------------------------------
    
    dx2.diff (2,783 bytes)
  • dx4.diff (2,797 bytes)
    Index: lcl/interfaces/win32/win32winapi.inc
    ===================================================================
    --- lcl/interfaces/win32/win32winapi.inc	(revision 61341)
    +++ lcl/interfaces/win32/win32winapi.inc	(working copy)
    @@ -1437,6 +1437,62 @@
         DebugLn('TWin32WidgetSet.ExtCreatePen returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
     end;
     
    +function IsCharSurrogateHigh(ch: WideChar): Boolean; inline;
    +begin
    +  Result := (ch>=#$D800) and (ch<=#$DBFF);
    +end;
    +
    +function IsCharSurrogateLow(ch: WideChar): Boolean; inline;
    +begin
    +  Result := (ch>=#$DC00) and (ch<=#$DFFF);
    +end;
    +
    +function SFindFirstCharSurrogate(const S: WideString): Integer; inline;
    +var
    +  i: Integer;
    +begin
    +  for i := 1 to Length(S) do
    +    if IsCharSurrogateHigh(S[i]) then Exit(i);
    +  Result := 0;
    +end;
    +
    +type
    +  _TIntArray = array of LongInt;
    +
    +procedure SConvertDxArrayFromUTF8ToWide(const S: WideString;
    +  Dx: PInteger; DxCount: integer; var Res: _TIntArray; nFirstIndex: Integer);
    +var
    +  iSrc, iDest: Integer;
    +begin
    +  SetLength(Res, Length(S));
    +
    +  if nFirstIndex > DxCount then
    +    nFirstIndex := DxCount;
    +
    +  for iDest := 0 to Length(S)-1 do
    +    if iDest < nFirstIndex-1 then
    +      Res[iDest] := (Dx+iDest)^
    +    else
    +      Res[iDest] := 0;
    +
    +  iSrc := nFirstIndex-1;
    +  for iDest := nFirstIndex-1 to Length(S)-1 do
    +  begin
    +    if iSrc>=DxCount then Break;
    +    if IsCharSurrogateLow(S[iDest+1]) then
    +    begin
    +      // 2nd char of surrogate pair: skip it, ie set size=0
    +      Res[iDest] := 0;
    +    end
    +    else
    +    begin
    +      // normal char or 1st char of surrogate pair: use its size
    +      Res[iDest] := (Dx+iSrc)^;
    +      Inc(iSrc);
    +    end;
    +  end;
    +end;
    +
     {------------------------------------------------------------------------------
       Method:  ExtTextOut
       Params:  DC      - handle to device context
    @@ -1456,18 +1512,32 @@
     var
       s: AnsiString;
       w: WideString;
    +  DxWide: _TIntArray;
    +  nIndex: Integer;
     begin
       // use temp buffer, if count is set, there might be no null terminator
       if count = -1 then
    -   s := str
    +    s := Str
       else
       begin
         SetLength(s, count);
         move(str^, PChar(s)^, count);
       end;
    -  // the length of utf8 vs Wide/Ansi the strings differ, so recalc.
    -  // TODO: use the real number of chars (and not the lenght)
    +
       W := UTF8ToUTF16(S);
    +
    +  // support surrogate chars in WideString
    +  if Dx<>nil then
    +  begin
    +    nIndex := SFindFirstCharSurrogate(W);
    +    if nIndex > 0 then
    +    begin
    +      SConvertDxArrayFromUTF8ToWide(W, Dx, Count, DxWide, nIndex);
    +      Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), @DxWide[0]);
    +      Exit;
    +    end;
    +  end;
    +
       Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx);
     end;
     
    
    dx4.diff (2,797 bytes)

Activities

Alexey Tor.

2019-06-08 15:57

reporter  

dx.diff (2,558 bytes)
Index: lcl/interfaces/win32/win32winapi.inc
===================================================================
--- lcl/interfaces/win32/win32winapi.inc	(revision 61341)
+++ lcl/interfaces/win32/win32winapi.inc	(working copy)
@@ -1437,6 +1437,49 @@
     DebugLn('TWin32WidgetSet.ExtCreatePen returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
 end;
 
+type
+  _TIntArray = array of LongInt;
+
+function IsCharSurrogateHigh(ch: WideChar): Boolean; inline;
+begin
+  Result:= (ch>=#$D800) and (ch<=#$DBFF);
+end;
+
+function IsCharSurrogateLow(ch: WideChar): Boolean; inline;
+begin
+  Result:= (ch>=#$DC00) and (ch<=#$DFFF);
+end;
+
+procedure ConvertDxArrayFromUTF8ToWide(const S: WideString;
+  Dx: PInteger; DxCount: integer; var Res: _TIntArray);
+var
+  DxIn: _TIntArray;
+  iSrc, iDest: Integer;
+begin
+  SetLength(DxIn, DxCount);
+  Move(Dx^, DxIn[0], DxCount*SizeOf(LongInt));
+
+  SetLength(Res, Length(S));
+  FillChar(Res[0], Length(Res)*SizeOf(LongInt), 0);
+
+  iSrc := 0;
+  for iDest := 1 to Length(S) do
+  begin
+    if iSrc>=DxCount then Break;
+    if IsCharSurrogateLow(S[iDest]) then
+    begin
+      // 2nd char of surrogate pair: skip it, ie set size=0
+      Res[iDest-1] := 0;
+    end
+    else
+    begin
+      // normal char or 1st char of surrogate pair: use its size
+      Res[iDest-1] := DxIn[iSrc];
+      Inc(iSrc);
+    end;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  ExtTextOut
   Params:  DC      - handle to device context
@@ -1456,6 +1499,7 @@
 var
   s: AnsiString;
   w: WideString;
+  DxWide: _TIntArray;
 begin
   // use temp buffer, if count is set, there might be no null terminator
   if count = -1 then
@@ -1465,10 +1509,17 @@
     SetLength(s, count);
     move(str^, PChar(s)^, count);
   end;
-  // the length of utf8 vs Wide/Ansi the strings differ, so recalc.
-  // TODO: use the real number of chars (and not the lenght)
+
   W := UTF8ToUTF16(S);
-  Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx);
+
+  if Dx=nil then
+    Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx)
+  else
+  begin
+    // must convert Dx: it's for UTF8 string, and WinAPI needs for WideString
+    ConvertDxArrayFromUTF8ToWide(W, Dx, Count, DxWide);
+    Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), @DxWide[0]);
+  end;
 end;
 
 {------------------------------------------------------------------------------
dx.diff (2,558 bytes)

Alexey Tor.

2019-06-09 18:28

reporter   ~0116646

Optimized.

dx2.diff (2,783 bytes)
Index: lcl/interfaces/win32/win32winapi.inc
===================================================================
--- lcl/interfaces/win32/win32winapi.inc	(revision 61341)
+++ lcl/interfaces/win32/win32winapi.inc	(working copy)
@@ -1437,6 +1437,58 @@
     DebugLn('TWin32WidgetSet.ExtCreatePen returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
 end;
 
+function IsCharSurrogateHigh(ch: WideChar): Boolean; inline;
+begin
+  Result := (ch>=#$D800) and (ch<=#$DBFF);
+end;
+
+function IsCharSurrogateLow(ch: WideChar): Boolean; inline;
+begin
+  Result := (ch>=#$DC00) and (ch<=#$DFFF);
+end;
+
+function IsStringWithSurrogate(const S: WideString): boolean; inline;
+var
+  i: Integer;
+begin
+  for i := 1 to Length(S) do
+    if IsCharSurrogateHigh(S[i]) then Exit(True);
+  Result := False;
+end;
+
+type
+  _TIntArray = array of LongInt;
+
+procedure ConvertDxArrayFromUTF8ToWide(const S: WideString;
+  Dx: PInteger; DxCount: integer; var Res: _TIntArray);
+var
+  DxIn: _TIntArray;
+  iSrc, iDest: Integer;
+begin
+  SetLength(DxIn, DxCount);
+  Move(Dx^, DxIn[0], DxCount*SizeOf(LongInt));
+
+  SetLength(Res, Length(S));
+  FillChar(Res[0], Length(Res)*SizeOf(LongInt), 0);
+
+  iSrc := 0;
+  for iDest := 1 to Length(S) do
+  begin
+    if iSrc>=DxCount then Break;
+    if IsCharSurrogateLow(S[iDest]) then
+    begin
+      // 2nd char of surrogate pair: skip it, ie set size=0
+      Res[iDest-1] := 0;
+    end
+    else
+    begin
+      // normal char or 1st char of surrogate pair: use its size
+      Res[iDest-1] := DxIn[iSrc];
+      Inc(iSrc);
+    end;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  ExtTextOut
   Params:  DC      - handle to device context
@@ -1456,6 +1508,7 @@
 var
   s: AnsiString;
   w: WideString;
+  DxWide: _TIntArray;
 begin
   // use temp buffer, if count is set, there might be no null terminator
   if count = -1 then
@@ -1465,10 +1518,17 @@
     SetLength(s, count);
     move(str^, PChar(s)^, count);
   end;
-  // the length of utf8 vs Wide/Ansi the strings differ, so recalc.
-  // TODO: use the real number of chars (and not the lenght)
+
   W := UTF8ToUTF16(S);
-  Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx);
+
+  if (Dx<>nil) and IsStringWithSurrogate(W) then
+  begin
+    // Dx is for UTF8 string, and WinAPI needs for WideString
+    ConvertDxArrayFromUTF8ToWide(W, Dx, Count, DxWide);
+    Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), @DxWide[0]);
+  end
+  else
+    Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx);
 end;
 
 {------------------------------------------------------------------------------
dx2.diff (2,783 bytes)

Alexey Tor.

2019-06-10 12:08

reporter   ~0116657

optimized.

dx4.diff (2,797 bytes)
Index: lcl/interfaces/win32/win32winapi.inc
===================================================================
--- lcl/interfaces/win32/win32winapi.inc	(revision 61341)
+++ lcl/interfaces/win32/win32winapi.inc	(working copy)
@@ -1437,6 +1437,62 @@
     DebugLn('TWin32WidgetSet.ExtCreatePen returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
 end;
 
+function IsCharSurrogateHigh(ch: WideChar): Boolean; inline;
+begin
+  Result := (ch>=#$D800) and (ch<=#$DBFF);
+end;
+
+function IsCharSurrogateLow(ch: WideChar): Boolean; inline;
+begin
+  Result := (ch>=#$DC00) and (ch<=#$DFFF);
+end;
+
+function SFindFirstCharSurrogate(const S: WideString): Integer; inline;
+var
+  i: Integer;
+begin
+  for i := 1 to Length(S) do
+    if IsCharSurrogateHigh(S[i]) then Exit(i);
+  Result := 0;
+end;
+
+type
+  _TIntArray = array of LongInt;
+
+procedure SConvertDxArrayFromUTF8ToWide(const S: WideString;
+  Dx: PInteger; DxCount: integer; var Res: _TIntArray; nFirstIndex: Integer);
+var
+  iSrc, iDest: Integer;
+begin
+  SetLength(Res, Length(S));
+
+  if nFirstIndex > DxCount then
+    nFirstIndex := DxCount;
+
+  for iDest := 0 to Length(S)-1 do
+    if iDest < nFirstIndex-1 then
+      Res[iDest] := (Dx+iDest)^
+    else
+      Res[iDest] := 0;
+
+  iSrc := nFirstIndex-1;
+  for iDest := nFirstIndex-1 to Length(S)-1 do
+  begin
+    if iSrc>=DxCount then Break;
+    if IsCharSurrogateLow(S[iDest+1]) then
+    begin
+      // 2nd char of surrogate pair: skip it, ie set size=0
+      Res[iDest] := 0;
+    end
+    else
+    begin
+      // normal char or 1st char of surrogate pair: use its size
+      Res[iDest] := (Dx+iSrc)^;
+      Inc(iSrc);
+    end;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  ExtTextOut
   Params:  DC      - handle to device context
@@ -1456,18 +1512,32 @@
 var
   s: AnsiString;
   w: WideString;
+  DxWide: _TIntArray;
+  nIndex: Integer;
 begin
   // use temp buffer, if count is set, there might be no null terminator
   if count = -1 then
-   s := str
+    s := Str
   else
   begin
     SetLength(s, count);
     move(str^, PChar(s)^, count);
   end;
-  // the length of utf8 vs Wide/Ansi the strings differ, so recalc.
-  // TODO: use the real number of chars (and not the lenght)
+
   W := UTF8ToUTF16(S);
+
+  // support surrogate chars in WideString
+  if Dx<>nil then
+  begin
+    nIndex := SFindFirstCharSurrogate(W);
+    if nIndex > 0 then
+    begin
+      SConvertDxArrayFromUTF8ToWide(W, Dx, Count, DxWide, nIndex);
+      Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), @DxWide[0]);
+      Exit;
+    end;
+  end;
+
   Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx);
 end;
 
dx4.diff (2,797 bytes)

Dmitry Boyarintsev

2019-06-10 14:48

developer   ~0116658

thanks for the patch. applied.
please test and close if ok

Issue History

Date Modified Username Field Change
2019-06-08 15:57 Alexey Tor. New Issue
2019-06-08 15:57 Alexey Tor. File Added: dx.diff
2019-06-09 18:28 Alexey Tor. File Added: dx2.diff
2019-06-09 18:28 Alexey Tor. Note Added: 0116646
2019-06-10 12:08 Alexey Tor. File Added: dx4.diff
2019-06-10 12:08 Alexey Tor. Note Added: 0116657
2019-06-10 14:48 Dmitry Boyarintsev Assigned To => Dmitry Boyarintsev
2019-06-10 14:48 Dmitry Boyarintsev Status new => resolved
2019-06-10 14:48 Dmitry Boyarintsev Resolution open => fixed
2019-06-10 14:48 Dmitry Boyarintsev Fixed in Revision => 61351
2019-06-10 14:48 Dmitry Boyarintsev LazTarget => -
2019-06-10 14:48 Dmitry Boyarintsev Note Added: 0116658