[Solved]Printing unicode one character at a time

[bobonwhidbey]

I want to display a string variable one character at a time onto a Windows Canvas, using TextOut. One character at a time will enable me to use different font colors and font style on various characters. An approach like this:

Code: Pascal  [Select][+][-]

1. x := 10;
2. y := 50;
3. for i := 1 to length(str) do begin
4.   if odd(i) then
5.      Canvas.Font.Color := clRed
6.   else
7.      Canvas.Font.Color := clBlack;
8.   Canvas.TextOut(x,y,str[i]);
9.   x := x+Canvas.TextWidth(str[i]);
10. end;
11.  

stumbles when if comes across a string that contains characters other than UTF8. For example, when
str :='På fjelltur';

So my question is, how to parse a string 1 character at a time.

[cdbc]

Hi
Use 'Unicode'...

Code: Pascal  [Select][+][-]

1. var
2.   ls: string = 'På fjelltur';
3.   uc: unicodechar;
4.   us: unicodestring;
5. begin
6.   us:= UTF8Decode(ls);
7.   for uc in us do ...{your thing with 'uc' here};
8. end;
9.  

I know it's a conversion, but the easiest, I think, in your situation
...if it works, that is 
Regards Benny

[marcov]

This will also fail with UTF8. It is code that can't deal with variable sized sequences.

[bytebites]

Add Lazutf8 to uses.

Code: Pascal  [Select][+][-]

1. for i := 1 to Utf8Length(str) do  begin
2.    s := UTF8Copy (str,i,1);
3.    Canvas.TextOut(x,y,s);

[cdbc]

Hi
I found a thread that might help, in reply #12 Juha gave this snippet:

Code: Pascal  [Select][+][-]

1. uses ... LazUTF8, LazUnicode;
2. ...
3. procedure TForm1.Button1Click(Sender: TObject);
4. var
5.   ch, Str, Pattern: String;
6.   At: Integer;
7. begin
8.   Str := '一二三四五六七八九十';
9.   Pattern := '三六a一2ä';
10.   for ch in Pattern do begin
11.     At := Pos(ch, Str);
12.     if At > 0 then
13.       Memo1.Lines.Add(Format('%s found at byte position %d, character position %d.',
14.                              [ch, At, UTF8Pos(ch,Str)]));
15.   end;
16. end;

You need to work it a little bit to your needs...
It's from this thread.
HTH
Regards Benny

[bobonwhidbey]

This code does not work. BUT, if I remove the 4 indicated lines, it displays correctly - of course not with the desired font styles. I don't know why that is?

Code: Pascal  [Select][+][-]

1. procedure TForm1.Button1Click(Sender: TObject);
2. var
3.   s, str: string;
4.   x, i: integer;
5.   uc: unicodechar;
6. begin
7.   x := 30;
8.   str := 'På fjelltur';
9.   for i := 1 to Utf8Length(str) do
10.   begin
11.     s := UTF8Copy(str, i, 1);
12.     if i < 3 then                      // Remove
13.       Font.Style := [fsBold]           // Remove
14.     else                                // Remove
15.       Font.Style := [fsUnderline];      // Remove
16.     Self.Canvas.TextOut(x, 30, s);
17.     x := x + Self.Canvas.TextWidth(s);
18.   end;
19. end;
20.  

[wp]

Code: Pascal  [Select][+][-]

1. uses
2.   LazUnicode;  // important!
3.  
4. procedure TForm1.PaintBox1Paint(Sender: TObject);
5. var
6.   i, x, y: Integer;
7.   ch: String;
8. begin
9.   x := 10;
10.   y := 50;
11.   i := 0;
12.   for ch in str do
13.   begin
14.     if odd(i) then
15.        Canvas.Font.Color := clRed
16.     else
17.        Canvas.Font.Color := clBlack;
18.     Canvas.TextOut(x,y, ch);
19.     x := x+Canvas.TextWidth(ch);
20.     inc(i);
21.   end;
22. end;

[bobonwhidbey]

That coding works perfectly. Yes LazUnicode was crucial.

I was curious why this coding displayed correctly when placed in a ButtonClick event, but did not display when placed in FormShow

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
9.   LazUnicode;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Button1: TButton;
17.     procedure Button1Click(Sender: TObject);
18.     procedure FormShow(Sender: TObject);
19.   private
20.  
21.   public
22.  
23.   end;
24.  
25. var
26.   Form1: TForm1;
27.  
28. implementation
29.  
30. {$R *.lfm}
31.  
32.  
33. { TForm1 }
34.  
35. procedure TForm1.Button1Click(Sender: TObject);
36. var
37.   i, x, y: integer;
38.   str, ch: string;
39. begin
40.   str := 'På fjelltur';
41.   x := 10;
42.   y := 100;
43.   i := 0;
44.   for ch in str do
45.   begin
46.     if odd(i) then
47.       Canvas.Font.Color := clRed
48.     else
49.       Canvas.Font.Color := clBlack;
50.     Canvas.TextOut(x, y, ch);
51.     x := x + Canvas.TextWidth(ch);
52.     Inc(i);
53.   end;
54.  
55. end;
56.  
57. procedure TForm1.FormShow(Sender: TObject);
58. var
59.   i, x, y: integer;
60.   str, ch: string;
61. begin
62.   str := 'På fjelltur';
63.   x := 10;
64.   y := 50;
65.   i := 0;
66.   for ch in str do
67.   begin
68.     if odd(i) then
69.       Self.Canvas.Font.Color := clRed
70.     else
71.       Self.Canvas.Font.Color := clBlack;
72.     Self.Canvas.TextOut(x, y, ch);
73.     x := x + Self.Canvas.TextWidth(ch);
74.     Inc(i);
75.   end;
76.  
77. end;
78.  
79. end.  

[cdbc]

Hi
You need to place your drawing code in the form's 'OnPaint' handler, otherwise your drawings keep getting erased by the system's own redrawing...
If you then call 'Invalidate' of the form, it will repaint itself and your stuff along with it...
Regards Benny

[bobonwhidbey]

Thank you everyone. I learned a lot.

[cdbc]

Hi
Here's quick and dirty test unit:

Code: Pascal  [Select][+][-]

1. unit view.main;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, StdCtrls,SysUtils, Forms, Controls, Graphics, Dialogs;
9.  
10. type
11.   TForm1 = class(TForm)
12.     Button1:TButton;
13.     procedure Button1Click(Sender:TObject);
14.     procedure FormPaint(Sender:TObject);
15.   private
16.     fstr: string;
17.   public
18.     procedure AfterConstruction;override;
19.   end;
20.  
21. var
22.   Form1: TForm1;
23.  
24. implementation
25. uses LazUnicode;
26. {$R *.lfm}
27.  
28. procedure TForm1.FormPaint(Sender:TObject);
29. var
30.   i, x, y: Integer;        uc: UnicodeChar;
31.   ch: String;              us: UnicodeString;
32. begin
33.   Canvas.Brush.Style:= bsClear;
34.   Canvas.Pen.Style:= psSolid;
35.   Canvas.Font.Name:= 'DejaVu Sans Mono';
36.   Canvas.Font.Size:= 14;
37.   Canvas.Font.Quality:= fqAntialiased;
38.   x := 10;
39.   y := 50;
40.   i := 0;
41.   for ch in fstr do
42.   begin
43.     if odd(i) then
44.        Canvas.Font.Color := clRed
45.     else
46.        Canvas.Font.Color := clGreen;
47.     Canvas.TextOut(x,y, ch);
48.     x := x+Canvas.TextWidth(ch)+4;
49.     inc(i);
50.   end;
51.  
52.   us:= UTF8Decode(fstr);
53.   x := 10;
54.   y := 100;
55.   i := 0;
56.   for uc in us do begin
57.     if odd(i) then
58.        Canvas.Font.Color := clFuchsia
59.     else
60.        Canvas.Font.Color := clAqua;
61.     Canvas.TextOut(x,y, uc);
62.     x := x+Canvas.TextWidth(uc)+4;
63.     inc(i);
64.   end;
65. end;
66.  
67. procedure TForm1.AfterConstruction;
68. begin
69.   inherited AfterConstruction;
70.   fstr:= 'æ ø å Æ Ø Å ñ';
71. end;
72.  
73. procedure TForm1.Button1Click(Sender:TObject);
74. begin
75.   fstr:= InputBox('Draw-string','What to draw:','På fjelltur');
76. end;
77.  
78. end.
79.  

...and screenshot attached...
Regards Benny

[bobonwhidbey]

Very nice.  Thanks Bennny