FPImage Font problem with Persian characters

[engkin]

simin_sh, it works. I attached the minimum needed changes for TFontManager.

To test:
1-Copy the contents of Lazarus\fpc\3.0.0\source\packages\fcl-image\src folder to your project folder.
2-Replace freetype.pp file with the one in this post.

You'll need to modify minibidi file to include Persian characters (Arabic Letter Perian Yeh) as mentioned in this post.

If you still have a problem, report back here.

1^st Edit:
I changed your example a bit:

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

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4. {$codepage UTF8}
5.  
6. uses
7.   minibidi,
8.   Classes,
9.   SysUtils,
10.   FPimage,
11.   FPImgCanv,
12.   ftfont,
13.   FPWritePNG,
14.   FPCanvas,
15.   lconvencoding,
16.   LazUTF8;
17.  
18. var
19.   vae: WideString;
20.   s: string;
21.   ImgCanvas: TFPImageCanvas;
22.   Img: TFPMemoryImage;
23.   AFont: TFreeTypeFont;
24. begin
25.   s :=  'السلام عليكم';
26.   vae := s;
27.   BidiString(vae, [bdoApplyShape], bdnArabic, bdpDefault, bdlNone);
28.   s := vae;
29.   ftfont.InitEngine;
30.   FontMgr.SearchPath := ExtractFilePath(ParamStr(0));
31.   AFont := TFreeTypeFont.Create;
32.   Img := TFPMemoryImage.Create(200, 100);
33.   Img.UsePalette := False;
34.   ImgCanvas := TFPImageCanvas.Create(Img);
35.   ImgCanvas.Brush.FPColor := colWhite;
36.   ImgCanvas.Brush.Style := bsSolid;
37.   ImgCanvas.Rectangle(0, 0, Img.Width, Img.Height);
38.   ImgCanvas.Font := AFont;
39.   //ImgCanvas.Font.Name := 'B Titr';
40.   ImgCanvas.Font.Name := 'Arial';
41.   ImgCanvas.Font.Size := 20;
42.   ImgCanvas.TextOut(10, 30, s);
43.   ImgCanvas.Image.SaveToFile('Pics.png');
44.  
45.   AFont.Free;
46.   ImgCanvas.Free;
47.   Img.Free;
48.   //writeln(vae);
49.   //ReadLn;
50. end.

Check the attached image.

2^nd Edit:
Changed bdlNone in BidiString to bdlComplex. The result is Pic2.png

3^rd Edit:
Pic3.png the original text in your first post 'فارسی'.

[Sanem]

Thank you for your replay, but i am not sure about this line you said: "2-Replace Freetype.pp file with the one in this post.", what do you mean exactly by Freetype.pp file in this post?? because i did the steps you said and the result of my project is still not showing the Persian characters! as you can see in screenshots attached.
here i uploaded my project folder in a zif file:
https://www.dropbox.com/s/rgkxdvgzyut6fwa/MinibidiTest2.zip?dl=0
 
any help appreciated prior

[engkin]

but i am not sure about this line you said: "2-Replace Freetype.pp file with the one in this post.", what do you mean exactly by Freetype.pp file in this post??

In my previous post there is a zip file "freetype.zip" before the first picture. it has a modified freetype.pp file to add support for multi-byte utf8 chars, like Arabic. You did not add it to your project. That's why you have wrong characters in your picture.

In addition to that s is of type string (you changed it to widestring, that's wrong):

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

1. var
2.   vae: WideString;
3.   s: string;  //<-----------
4. ...
5.  

[Graeme]

Two trivial changes are needed to add support for the rest of the characters:

Ah, perfect. Now it looks exactly like the same text in LibreOffice. Many thanks.

And just for fun, I added a second screenshot where I used a font outline with fill, and a slight blur background. 

[engkin]

Ah, perfect. Now it looks exactly like the same text in LibreOffice.

Looking at the top right side, LibreOffice image looks clipped?

[Graeme]

Looking at the top right side, LibreOffice image looks clipped?

I noticed that too - well spotted. The clipping also occurs  in the first and second characters. It's a rendering [to screen] bug in LibreOffice, and is not affected when exporting to PDF or printing. Simply covering LibreOffice with another application, and then moving that application away fixes the initial rendering.   I didn't check if this is only an issue on very large font point sizes or not.

[engkin]

And just for fun, I added a second screenshot where I used a font outline with fill, and a slight blur background. 

Is it possible to remove the connecting lines?

[Sanem]

Yes, my fault, i did not see the attachment,
It is now exactly what i needed, many thanks, to you engkin, and the others.

[Graeme]

Is it possible to remove the connecting lines?

Yes, it is possible.

[Sanem]

There is a problem with bgrabitmap now:
when i am using image of fpimage as a TFPCustomImage to use it in bgrabitmap create(i need to use bgrabitmap as my bitmap in my project), there is a problem with compiling of fpc package, that i think is because of i am changing fpimage and BGRABitmap is using fpc from somewhere else,

you can see in my project which is uploaded in this address:
https://www.dropbox.com/s/um50yy4t0b8vhim/TestFclBgraCanvas.zip?dl=0

i got this error which is in screenshot.

any help appreciated prior
 

[circular]

Hi simin_sh!

I think the problem comes from the fact that you have a copy of the FP units and that they are already included in Lazarus as well. I guess you can simply remove those units from the folder.

[benohb]

Graeme
Is it possible to add support RTL languages (Right-To-Left Script) to FPGUI  .

I've managed it but i find  problems with memo (select-clipboard) .. look to behavior of GEANY application in linux
libreoffice on selecting text  use  canvas for  each character .

[Sanem]

Hi,
is there a way to have wrapped text in FPImage?
as you can see in screen shots, i have a paragraph with multiple sentences for example, i wanted to display this text as wrapped in FPImage, first screenshot is what i want, and the second one is my code result.
here is my code:

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

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4. {$codepage UTF8}
5.  
6. uses
7.   minibidi,
8.   Classes,
9.   SysUtils,
10.   FPimage,
11.   FPImgCanv,
12.   ftfont,
13.   FPWritePNG,
14.   FPCanvas,
15.   lconvencoding,
16.   LazUTF8;
17.  
18. var
19.   vae: WideString;
20.   s: string;
21.   ImgCanvas: TFPImageCanvas;
22.   Img: TFPMemoryImage;
23.   AFont: TFreeTypeFont;
24. begin
25.   s := 'اگر هوشیاری و خودآگاهی اجتماعی به شکل ویژگی عمومی یک ملت و نه فقط در حد یک فرد درآید، آنگاه جامعه به یک ابزار دفاعی قدرتمند علیه شیادی عناصر و عوامل عوام فریب و بر ضد فردسالاری استبدادی مسلح خواهد بود. برای ایجاد تغییر و تحول، یک فرد، هرچه بیشتر به کار و کوشش و تلاش بپردازد، به همان میزان نیازش به معجزه کمتر می‌شود و هرچه کمتر به معجزه نیاز داشته باشد، کمتر به انتظار آن می‌نشیند. تنها کسانی به سحر و معجزه روی می آورند که منتظر وقوع آن هستند.';
26.   ;
27.   vae := s;
28.   BidiString(vae, [bdoApplyShape], bdnArabic, bdpDefault, bdlComplex);
29.   s := vae;
30.   ftfont.InitEngine;
31.   FontMgr.SearchPath := ExtractFilePath(ParamStr(0));
32.   AFont := TFreeTypeFont.Create;
33.   Img := TFPMemoryImage.Create(600, 360);
34.   Img.UsePalette := False;
35.   ImgCanvas := TFPImageCanvas.Create(Img);
36.   ImgCanvas.Brush.FPColor := colWhite;
37.   ImgCanvas.Brush.Style := bsSolid;
38.   ImgCanvas.Rectangle(0, 0, Img.Width, Img.Height);
39.   ImgCanvas.Font := AFont;
40.   ImgCanvas.Font.Name := 'segoeui';
41.   ImgCanvas.Font.Size := 14;
42.   ImgCanvas.TextOut(10, 30, s);
43.   ImgCanvas.Image.SaveToFile('Pics/test1.png');
44.  
45.   AFont.Free;
46.   ImgCanvas.Free;
47.   Img.Free;
48. end.
49.  

any help appreciated prior

[Graeme]

Is it possible to add support RTL languages (Right-To-Left Script) to FPGUI

I have zero experience with Right-to-Left script, except for what I tried based on this thread. I fully understand that there is much more work than simply rendering text from right-to-light. eg: button alignments in forms normally change, button icons normally flip sides, menubar and menu items and icons flip sides, text selection, cursor movement inside edit widgets etc. It is a very complex task and I simply don't think there is enough demand with fpGUI at the moment.

I would obviously welcome any contributions regarding this.

[engkin]

is there a way to have wrapped text in FPImage?

Yes, you'll have to divide the text into lines so that each line fits in the width of the bitmap. I changed your code to use variables for width and height instead of 600 & 360:

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

1. var
2. ...
3.   w, h: Integer;
4. ...
5.   w := 600;
6.   h := 360;
7. ...

and used variables for text margins:

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

1. var
2. ...
3.   XMargin, YMargin: Integer;
4. ...
5.   XMargin := 10;
6.   YMargin := 30;
7. ...

Replaced ImgCanvas.TextOut(10, 30, s) with:

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

1. var
2. ...
3.   rct: TRect;
4. ...
5.   rct := Rect(XMargin,YMargin,w-2*XMargin, h-2*YMargin);
6.   TextRect(ImgCanvas, rct, s);

TextRect is a quick implementation to wrap the text:

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

1. procedure TextRect(Canvas: TFPImageCanvas; const ARect: TRect; const Text: string);
2. type
3.   IntArray = array of integer;
4.  
5. var
6.   LSpaces: IntArray;
7.   LStart: Integer;
8.   aLine: String;
9.   Lines: TStringList;
10.   aLineWidth: Integer;
11.   w, h, y, dy, i: Integer;
12.  
13.   procedure LocateSpaces(const s: string; var a: IntArray);
14.   const
15.     RTL = True;
16.  
17.   var
18.     i,c: Integer;
19.   begin
20.     setLength(a, length(s));
21.     c := 1;
22.     //for i := 1 to length(s) do   { LTR }
23.     for i := length(s) downto 1 do { RTL }
24.     begin
25.       if s[i]=' ' then
26.       begin
27.         a[c] := i;
28.         inc(c);
29.       end;
30.     end;
31.  
32.     { Add two imaginary spaces before and after the text }
33.     if RTL then
34.     begin
35.       a[0] := length(s) + 1;
36.       a[c] := 0;
37.     end
38.     else
39.     begin
40.       a[0] := 0;
41.       a[c] := length(s) + 1;
42.     end;
43.  
44.     inc(c);
45.     SetLength(a, c);
46.   end;
47.  
48.   function BSearch: integer;
49.   var
50.     left, right: integer;  { names are not true }
51.     idx: integer;
52.     tmpS: String;
53.     tmpW: integer;
54.   begin
55.     { Find the number of words that fit using binary search }
56.     { Not optimal, just wanted to try it! }
57.     left := LStart;
58.     right := Length(LSpaces)-1;
59.  
60.     BSearch := -1;
61.     while left<=right do
62.     begin
63.       idx := (left+right) div 2;
64.       //tmpS := copy(Text, LSpaces[LStart]+1, LSpaces[idx]-LSpaces[LStart]);//LTR
65.       tmpS := copy(Text, LSpaces[idx]+1, LSpaces[LStart]-LSpaces[idx]);//RTL
66.       tmpW := Canvas.TextWidth(tmpS);
67.       if tmpW<w then
68.       begin
69.         aLine := tmpS;
70.         aLineWidth := tmpW;
71.         Result := idx;
72.         left := idx+1
73.       end
74.       else if tmpW>w then
75.         right := idx-1
76.       else
77.         exit(idx);
78.     end;
79.   end;
80.  
81.   procedure NextLine;
82.   var
83.     idx: integer;
84.   begin
85.     idx := BSearch();
86.     if idx=-1 then
87.       exit;
88.     LStart := idx;
89.   end;
90.  
91. begin
92.   { Find location of space characters where we could break a line }
93.   LocateSpaces(Text, LSpaces);
94.  
95.   { Width and height }
96.   with ARect do
97.   begin
98.     w := Right-Left;
99.     h := Bottom-Top;
100.   end;
101.  
102.   { Height of one line }
103.   dy := Canvas.TextHeight(Text)+1;
104.  
105.   { Break the text into lines that fit in the width w }
106.   Lines := TStringList.Create;
107.   LStart := 0;
108.   repeat
109.     NextLine;
110.     Lines.AddObject(aLine, TObject(aLinewidth)); {  Add each line and its width }
111.   until Length(aLine)=0;
112.  
113.   { Draw lines aligned to the right side }
114.   y := ARect.Top;
115.   for i := 0 to Lines.Count -1 do
116.   begin
117.     aLinewidth := Integer(Lines.Objects[i]);
118.     aLine := Lines[i];
119.     Canvas.TextOut(ARect.Left+w-aLinewidth, y, aLine);
120.     inc(y, dy);
121.   end;
122.  
123.   { Clean up }
124.   SetLength(LSpaces, 0);
125.   Lines.Free;
126. end;

It is just to get you started. I don't know if the result is correct, check the attached image.

Edit:
I suspect that freetype.pp is not providing the correct font kerning to the text.