Recent

Author Topic: Problem with polish letter in wrapped text  (Read 8947 times)

paweld

  • Full Member
  • ***
  • Posts: 244
Best regards
paweld

GAN

  • Sr. Member
  • ****
  • Posts: 301
Re: Problem with polish letter in wrapped text
« Reply #16 on: January 14, 2019, 10:53:57 pm »
Lazreport is a total failure, I can not deal with Polish letters.

Is there any alternative for Lazreport where there is no problem with the Polish font?

You can buy Fast Report https://www.fast-report.com/en/product/fast-report-lazarus/
Lazarus 2.0.8 FPC 3.0.4 Linux Mint Mate 19.3
Zeos 7.2.6 - Sqlite 3.32.3

https://gitlab.com/users/GAN__/projects

mrkwlee

  • New Member
  • *
  • Posts: 18
Re: Problem with polish letter in wrapped text
« Reply #17 on: December 07, 2019, 08:42:46 am »
Backup your lr_class.pas and try change lr_Class.pas as following

change "procedure TfrCustomMemoView.WrapMemo;" into:

procedure TfrCustomMemoView.WrapMemo;
var
  size, size1, maxwidth: Integer;
  b: TWordBreaks;
  WCanvas: TCanvas;
  desc, aword: string;

  procedure OutLine(const str: String);
  var
    n, w: Word;
  begin
    n := Length(str);
    if (n > 0) and (str[n] = #1) then
      w := WCanvas.TextWidth(Copy(str, 1, n - 1)) else
      w := WCanvas.TextWidth(str);
    {$IFDEF DebugLR_detail}
    debugLn('Outline: str="%s" w/=%d w%%=%d',[copy(str,1,12),w div 256, w mod 256]);
    {$ENDIF}
    SMemo.Add(str + Chr(w div 256) + Chr(w mod 256));
    Inc(size, size1);
  end;

  procedure WrapLine(const s: String);
  var
    i, cur, beg, last, len: Integer;
    WasBreak, CRLF, IsCR: Boolean;
    ch: TUTF8char;


    function UTF8Desc(S: string; var Desc: string): Integer;
    // create Desc as an array with Desc is the size of the UTF-8 codepoint
    var
      i,b: Integer;
    begin
      i := 1;
      Result := 0;
      SetLength(Desc, Length(S));
      while i<=Length(s) do begin
        b := UTF8CharacterStrictLength(@S);
        inc(i,b);
        inc(Result);
        Desc[Result] := Char(b);
       end;
       Setlength(Desc, Result);
    end;

    function UTF8Char(S: string; index: Integer; Desc: string): TUTF8Char;
    var
      i,j: Integer;
    begin
      Result := '';
      if (index<1) or (index>Length(Desc)) then begin
       //Result := #$EF#$BF#$BD  // replacement character
         exit;
      end;

      i:=0; j:=1;
      while i<Length(Desc) do begin
        inc(i);
        if i=index then begin
          Move(S[j],Result[1],ord(Desc));
          Result[0]:=Desc;
          break;
        end;
        inc(j, ord(Desc));
      end;

    end;

    // this assume index is in valid range
    function UTF8Index(index: integer; desc: string): Integer;
    var
      i,c: integer;
    begin
      result := 0;
      c := 0;
      for i:=1 to Length(Desc) do begin
        inc(c);
        if i=index then begin
          result := c;
          break;
        end;
        c := c + ord(Desc) - 1;
      end;
    end;

    function UTF8Range(S: string; index, count: Integer; Desc: String
      ): string;
    var
      c,i: Integer;
    begin
      result := '';
      c := 0;
      i := index;
      while (Count>0) and (i<=Length(Desc)) do begin
        c := c + ord(Desc);
        inc(i);
        Dec(Count);
      end;
      i := {%H-}UTF8Index(Index, Desc);
      if i>0 then begin
        SetLength(Result, c);
        Move(S,Result[1],c);
      end;
    end;


//**********************************************
  begin

    CRLF := False;
    for i := 1 to Length(s) do
    begin
      if s in [#10, #13] then
      begin
        CRLF := True;
        break;
      end;
    end;

    last := 1; beg := 1;
    if not CRLF and ((Length(s) <= 1) or (WCanvas.TextWidth(s) <= maxwidth)) then
    begin
      OutLine(s + #1)
    end else
    begin

      cur := 1;
      Len := UTF8Desc(S, Desc);

      while cur <= Len do
      begin
        Ch := UTF8Char(s, cur, Desc);

        // check for items with soft-breaks
        IsCR := Ch=#13;
        if IsCR then
        begin
          //handle composite newline
          ch := UTF8Char(s, cur+1, desc);
          //dont increase char index if next char is LF (#10)
          if ch<>#10 then
            Inc(Cur);
        end;
        if Ch=#10 then
        begin
          OutLine(UTF8Range(s, beg, cur - beg, Desc) + #1);
          //increase the char index since it's pointing to CR (#13)
          if IsCR then
            Inc(cur);
          Inc(cur);
          beg := cur;
          last := beg;
          Continue;
        end;

        if ch <> ' ' then
        if WCanvas.TextWidth(UTF8Range(s, beg, cur - beg + 1, Desc)) > maxwidth then
        begin

          WasBreak := False;
          if (Flags and flWordBreak) <> 0 then
          begin

            // in case of breaking in the middle, get the full word
            i := cur;
            while (i <= Len) and not UTF8CharIn(ch, [' ', '.', ',', '-']) do
            begin
              Inc(i);
              if i<=len then
                ch := UTF8Char(s, i, Desc);
            end;

            // find word's break points using some simple hyphenator algorithm
            // TODO: implement interface so users can use their own hyphenator
            //       algorithm
            aWord := UTF8Range(s, last, i - last, Desc);
            if (FHyp<>nil) and (FHyp.Loaded) then
            begin
              try
                b := FHyp.BreakWord(UTF8Lowercase(aWord));
              except
                b := '';
              end;
            end else
              b := BreakWord(aWord);

            // if word can be broken in many segments, find the last segment that
            // fits within maxwidth
            if Length(b) > 0 then
            begin
              i := 1;
              while (i <= Length(b)) and
                (WCanvas.TextWidth(UTF8Range(s, beg, last - beg + Ord(b), Desc) + '-') <= maxwidth) do
              begin
                WasBreak := True;
                cur := last + Ord(b);  // cur now points to next char after breaking word
                Inc(i);
              end;
            end;

            if (not WasBreak) and (FHyp<>nil) and FHyp.Loaded then
              // if hyphenator was specified and is valid don't break
              // words which hyphenator didn't break
            else
              // last now points to nex char to be processed
              last := cur;
          end
          else
          begin
            if last = beg then
              last := cur;
          end;

          if WasBreak then
          begin
            // if word has been broken, output the partial word plus an hyphen
            OutLine(UTF8Range(s, beg, last - beg, Desc) + '-');
          end else
          begin
            // output the portion of word that fits maxwidth
            OutLine(UTF8Range(s, beg, last - beg, Desc));
            // if space was found, advance to next no space char
            while (UTF8Char(s, last, Desc) = ' ') and (last < Length(s)) do
              Inc(last);
          end;

          beg := last;
        end;

        if UTF8CharIn(Ch, [' ', '.', ',', '-']) then
          last := cur;
        Inc(cur);
      end;

      if beg <> cur then
        OutLine(UTF8Range(s, beg, cur - beg + 1, Desc) + #1);
    end;
  end;

//  procedure OutMemo;

wp

  • Hero Member
  • *****
  • Posts: 7620
Re: Problem with polish letter in wrapped text
« Reply #18 on: December 07, 2019, 11:28:56 am »
Quickly flying over this code (it would increase readability if you'd enclose code by [code=Pascal] and [/code] tags (or select Pascal from the code combobox above the forum edit field after selecting the code text) I guess that you duplicate much of the code provided in unit LazUnicode. It defines an enumator whilch allows you to step through a UTF8-encoded string codepoint by codepoint:

Code: Pascal  [Select][+][-]
  1. var
  2.   ch: String;  // yes: String, not char!
  3.   s: String;
  4. begin
  5.   s := 'äöüß';
  6.   for ch in s do
  7.     WriteLn(ch);

The wrapping code should simply extract the UTF8-"characters" this way. After having fixed this, I could try to add this to the LazReport code.
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

wp

  • Hero Member
  • *****
  • Posts: 7620
Re: Problem with polish letter in wrapped text
« Reply #19 on: December 07, 2019, 12:55:58 pm »
Quoting to add code tags and to avoid the italic display issue when "i" is put between square brackets (this is interpreted by the forum as begin of italic text):
Code: Pascal  [Select][+][-]
  1. procedure TfrCustomMemoView.WrapMemo;
  2. var
  3.   size, size1, maxwidth: Integer;
  4.   b: TWordBreaks;
  5.   WCanvas: TCanvas;
  6.   desc, aword: string;
  7.  
  8.   procedure OutLine(const str: String);
  9.   var
  10.     n, w: Word;
  11.   begin
  12.     n := Length(str);
  13.     if (n > 0) and (str[n] = #1) then
  14.       w := WCanvas.TextWidth(Copy(str, 1, n - 1)) else
  15.       w := WCanvas.TextWidth(str);
  16.     {$IFDEF DebugLR_detail}
  17.     debugLn('Outline: str="%s" w/=%d w%%=%d',[copy(str,1,12),w div 256, w mod 256]);
  18.     {$ENDIF}
  19.     SMemo.Add(str + Chr(w div 256) + Chr(w mod 256));
  20.     Inc(size, size1);
  21.   end;
  22.  
  23.   procedure WrapLine(const s: String);
  24.   var
  25.     i, cur, beg, last, len: Integer;
  26.     WasBreak, CRLF, IsCR: Boolean;
  27.     ch: TUTF8char;
  28.  
  29.  
  30.     function UTF8Desc(S: string; var Desc: string): Integer;
  31.     // create Desc as an array with Desc[i] is the size of the UTF-8 codepoint
  32.     var
  33.       i,b: Integer;
  34.     begin
  35.       i := 1;
  36.       Result := 0;
  37.       SetLength(Desc, Length(S));
  38.       while i<=Length(s) do begin
  39.         b := UTF8CharacterStrictLength(@S[i]);
  40.         inc(i,b);
  41.         inc(Result);
  42.         Desc[Result] := Char(b);
  43.        end;
  44.        Setlength(Desc, Result);
  45.     end;
  46.  
  47.     function UTF8Char(S: string; index: Integer; Desc: string): TUTF8Char;
  48.     var
  49.       i,j: Integer;
  50.     begin
  51.       Result := '';
  52.       if (index<1) or (index>Length(Desc)) then begin
  53.         //Result := #$EF#$BF#$BD  // replacement character
  54.         exit;
  55.       end;
  56.  
  57.       i:=0; j:=1;
  58.       while i<Length(Desc) do begin
  59.         inc(i);
  60.         if i=index then begin
  61.           Move(S[j],Result[1],ord(Desc[i]));
  62.           Result[0]:=Desc[i];
  63.           break;
  64.         end;
  65.         inc(j, ord(Desc[i]));
  66.       end;
  67.  
  68.     end;
  69.  
  70.     // this assume index is in valid range
  71.     function UTF8Index(index: integer; desc: string): Integer;
  72.     var
  73.       i,c: integer;
  74.     begin
  75.       result := 0;
  76.       c := 0;
  77.       for i:=1 to Length(Desc) do begin
  78.         inc(c);
  79.         if i=index then begin
  80.           result := c;
  81.           break;
  82.         end;
  83.         c := c + ord(Desc[i]) - 1;
  84.       end;
  85.     end;
  86.  
  87.     function UTF8Range(S: string; index, count: Integer; Desc: String
  88.       ): string;
  89.     var
  90.       c,i: Integer;
  91.     begin
  92.       result := '';
  93.       c := 0;
  94.       i := index;
  95.       while (Count>0) and (i<=Length(Desc)) do begin
  96.         c := c + ord(Desc[i]);
  97.         inc(i);
  98.         Dec(Count);
  99.       end;
  100.       i := {%H-}UTF8Index(Index, Desc);
  101.       if i>0 then begin
  102.         SetLength(Result, c);
  103.         Move(S[i],Result[1],c);
  104.       end;
  105.     end;
  106.  
  107.  
  108. //**********************************************
  109.   begin
  110.  
  111.     CRLF := False;
  112.     for i := 1 to Length(s) do
  113.     begin
  114.       if s[i] in [#10, #13] then
  115.       begin
  116.         CRLF := True;
  117.         break;
  118.       end;
  119.     end;
  120.  
  121.     last := 1; beg := 1;
  122.     if not CRLF and ((Length(s) <= 1) or (WCanvas.TextWidth(s) <= maxwidth)) then
  123.     begin
  124.       OutLine(s + #1)
  125.     end else
  126.     begin
  127.  
  128.       cur := 1;
  129.       Len := UTF8Desc(S, Desc);
  130.  
  131.       while cur <= Len do
  132.       begin
  133.         Ch := UTF8Char(s, cur, Desc);
  134.  
  135.         // check for items with soft-breaks
  136.         IsCR := Ch=#13;
  137.         if IsCR then
  138.         begin
  139.           //handle composite newline
  140.           ch := UTF8Char(s, cur+1, desc);
  141.           //dont increase char index if next char is LF (#10)
  142.           if ch<>#10 then
  143.             Inc(Cur);
  144.         end;
  145.         if Ch=#10 then
  146.         begin
  147.           OutLine(UTF8Range(s, beg, cur - beg, Desc) + #1);
  148.           //increase the char index since it's pointing to CR (#13)
  149.           if IsCR then
  150.             Inc(cur);
  151.           Inc(cur);
  152.           beg := cur;
  153.           last := beg;
  154.           Continue;
  155.         end;
  156.  
  157.         if ch <> ' ' then
  158.         if WCanvas.TextWidth(UTF8Range(s, beg, cur - beg + 1, Desc)) > maxwidth then
  159.         begin
  160.  
  161.           WasBreak := False;
  162.           if (Flags and flWordBreak) <> 0 then
  163.           begin
  164.  
  165.             // in case of breaking in the middle, get the full word
  166.             i := cur;
  167.             while (i <= Len) and not UTF8CharIn(ch, [' ', '.', ',', '-']) do
  168.             begin
  169.               Inc(i);
  170.               if i<=len then
  171.                 ch := UTF8Char(s, i, Desc);
  172.             end;
  173.  
  174.             // find word's break points using some simple hyphenator algorithm
  175.             // TODO: implement interface so users can use their own hyphenator
  176.             //       algorithm
  177.             aWord := UTF8Range(s, last, i - last, Desc);
  178.             if (FHyp<>nil) and (FHyp.Loaded) then
  179.             begin
  180.               try
  181.                 b := FHyp.BreakWord(UTF8Lowercase(aWord));
  182.               except
  183.                 b := '';
  184.               end;
  185.             end else
  186.               b := BreakWord(aWord);
  187.  
  188.             // if word can be broken in many segments, find the last segment that
  189.             // fits within maxwidth
  190.             if Length(b) > 0 then
  191.             begin
  192.               i := 1;
  193.               while (i <= Length(b)) and
  194.                 (WCanvas.TextWidth(UTF8Range(s, beg, last - beg + Ord(b[i]), Desc) + '-') <= maxwidth) do
  195.               begin
  196.                 WasBreak := True;
  197.                 cur := last + Ord(b[i]);  // cur now points to next char after breaking word
  198.                 Inc(i);
  199.               end;
  200.             end;
  201.  
  202.             if (not WasBreak) and (FHyp<>nil) and FHyp.Loaded then
  203.               // if hyphenator was specified and is valid don't break
  204.               // words which hyphenator didn't break
  205.             else
  206.               // last now points to nex char to be processed
  207.               last := cur;
  208.           end
  209.           else
  210.           begin
  211.             if last = beg then
  212.               last := cur;
  213.           end;
  214.  
  215.           if WasBreak then
  216.           begin
  217.             // if word has been broken, output the partial word plus an hyphen
  218.             OutLine(UTF8Range(s, beg, last - beg, Desc) + '-');
  219.           end else
  220.           begin
  221.             // output the portion of word that fits maxwidth
  222.             OutLine(UTF8Range(s, beg, last - beg, Desc));
  223.             // if space was found, advance to next no space char
  224.             while (UTF8Char(s, last, Desc) = ' ') and (last < Length(s)) do
  225.               Inc(last);
  226.           end;
  227.  
  228.           beg := last;
  229.         end;
  230.  
  231.         if UTF8CharIn(Ch, [' ', '.', ',', '-']) then
  232.           last := cur;
  233.         Inc(cur);
  234.       end;
  235.  
  236.       if beg <> cur then
  237.         OutLine(UTF8Range(s, beg, cur - beg + 1, Desc) + #1);
  238.     end;
  239.   end;
  240.  

Now I get unmatched begin-end pairs...

I stop here. Please provide compilable code, either as attached (zipped) file, as pasted text, but in code tags, or - ideally - as an svn diff file relative to the current Laz trunk sources.

And it would also be good to have a simple demo program which shows the issue.

[EDIT]
OK, I see now that you provided only part of the WrapMemo method - now it compiles...
« Last Edit: December 07, 2019, 03:40:35 pm by wp »
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

JuhaManninen

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 3858
  • I like bugs.
Re: Problem with polish letter in wrapped text
« Reply #20 on: December 07, 2019, 01:11:52 pm »
... or - ideally - as an svn diff file relative to the current Laz trunk sources.
+1
and please upload it to the relevant bug report.
Mostly Lazarus trunk and FPC 3.2 on Manjaro Linux.

 

TinyPortal © 2005-2018