Discussion :

[SergioMaster]

Bonjour,

Ma question en fait une demande de test est surtout destiné à nos amis arabisants nombreux sur le forum, je ne sais si ces derniers connaissent cette astuce.

Avec une version Tokyo ou Berlin je voudrais qu'une colonne d'une TGrid (voire même une TStringGrid) soit affichée en BiDi en théorie je sais comment faire reste à le tester.

Pour cela il vous faut une forme contenant une grille avec au minima une colonne que vous nommerez 'bdicol' qui contiendra du texte soit en "occidental" soit en "oriental" (c'est là où je bloque pour le test).
Ensuite il vous faut ajouter un "simple" évènement OnDrawCell pour la grille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
uses ..., FMX.TextLayout;
 
procedure TForm1.Grid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas;
  const Column: TColumn; const Bounds: TRectF; const Row: Integer;
  const Value: TValue; const State: TGridDrawStates);
var aTextLayout : TTextLayout;
begin
   if SameText(Column.Name,'bidicol') then
    begin
      Canvas.Fill.Color:=TAlphaColors.Black;
       Canvas.FillText(Bounds,Value.ToString,false,1,[TFillTextFlag.RightToLeft],TTextAlign.Leading);
 
     {  pour info FillText est marqué comme :  "deprecated, use TTextLayout" dans les sources (FMX.Graphics) 
        utiliser un TTextLayout permet plus de possibilités
        mais au détriment de la longueur du code }
     { code avec TextLayout}
     //ATextLayout:=TTextLayoutManager.TextLayoutByCanvas(Canvas.ClassType).Create(Canvas);
     //ATextLayout.BeginUpdate;
     //ATextLayout.Text:=Value.ToString;
     //ATextLayout.Color:=TAlphaColors.Black;
     //ATextLayout.TopLeft:=Bounds.TopLeft;
     //ATextLayout.MaxSize := PointF(Bounds.Width, Bounds.Height);
     //ATextLayout.VerticalAlign:=TTextAlign.Center;
     // c'est ici que ça se passe 
     //ATextLayout.RightToLeft := True;
     //ATextLayout.EndUpdate;
     //ATextLayout.RenderLayout(Canvas); 
    end;
 
end;

en PJ ma tentative qui me semble infructueuse

[SergioMaster]

Re,

une petite erreur s'est glissée dans mon code, le test des noms de colonne, utilisez if SameText(Column.Name,<nom>) then ...plutôt que if Column.Name=<nom> then ...et, désolé de vous décevoir, cela ne suffira pas, Firemonkey n'est pas fait pour les langues RTL (ou du moins mal fait)
pour obtenir quelque chose comme ceci


j'ai ajouté une fonction à revoir complètement car beaucoup trop simpliste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
procedure TForm1.Grid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas;
  const Column: TColumn; const Bounds: TRectF; const Row: Integer;
  const Value: TValue; const State: TGridDrawStates);
var aTextLayout : TTextLayout;
 
    function IsBidiString(S : String) : TTextAlign;
    var i : word;
    begin
      result:=TTextAlign.Trailing;
      if S.IsEmpty then exit;
      for I := 0 to Length(S)-1 do
       begin
        if Ord(S[i])>256 then
         begin
          result:=TTextAlign.Leading;
          break;
         end;
       end;
    end;
 
begin
   if SameText(Column.Name,'bidicol') then
    begin
      Canvas.Fill.Color:=TAlphaColors.Red;
      Canvas.FillText(Bounds,Value.ToString,false,1,[TFillTextFlag.RightToLeft],isBidiString(Value.ToString));
    end;

[SergioMaster]

J'ai décidé "d'améliorer" ma fonction de détection

hypothèse de travail : le premier caractère de la chaîne définit le sens

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
    function checkRtl ( S : string ) : TTextAlign;
    var carray : array of WideChar;
        i : int64;
        ws : String;
    begin
       // supprime les chiffres
       for I := 0 to 9 do
          S:=StringReplace(S,i.ToString,'',[rfReplaceAll]);
       // supprime autres caractères spéciaux
        S:=StringReplace(S,'(','',[rfReplaceAll]);
        S:=StringReplace(S,')','',[rfReplaceAll]); // peu probable
        S:=StringReplace(S,']','',[rfReplaceAll]); // peu probable
        S:=StringReplace(S,'[','',[rfReplaceAll]);
        S:=StringReplace(S,'"','',[rfReplaceAll]); // " 
        S:=StringReplace(S,'''','',[rfReplaceAll]); // '
 
       // autres n'hésitez pas à ajouter 
 
       S:=Trim(S);
       result:=TTextAlign.Trailing;
       if S.IsEmpty then exit;
 
       // arabe + hébreux  
       SetLength(carray,$6ff-$590);
       for I := $590 to $6ff do carray[i-$590]:=Char(I);
 
       // obtenir le premier caractère et vérifier si RTL 
       if inOpArray(S[1],carray) then result:=TTextAlign.Leading;
    end;

Qu'en pensez vous ?

[NABIL74]

Bonjour Serge,

Je viens tout juste de tester l'exemple que tu nous a fourni:

Voici la capture d'écran que j'ai faite:


les caractères arabes ou occidentales s'affichent bien dans "BidiColTextLayout" Je pense que c'est nickel !
Qu'en penses-tu Serge?

[SergioMaster]

Bonjour,

comme je ne lis pas l'arabe, ni l’hébreu je ne saurais le dire avec certitude et c'est bien mon problème
si tu arrives à lire les lignes 2 et 3 correctement alors c'est que mon objectif est atteint.

Le seul point qui resterait à éclaircir c'est la fonction checkRTL, y a t-il d'autres caractères comme les ",(,[ qu'il faudrait supprimer afin de tenter d'obtenir le premier caractère alphabétique de la chaine ?

[NABIL74]

Bonjour,

comme je ne lis pas l'arabe, ni l’hébreu je ne saurais le dire avec certitude et c'est bien mon problème
si tu arrives à lire les lignes 2 et 3 correctement alors c'est que mon objectif est atteint.

Bonjour,
Oui les caractères arabes s'affichent correctement et bien sûr on arrive à les lire
Pas de souci là dessus.

Le seul point qui resterait à éclaircir c'est la fonction checkRTL, y a t-il d'autres caractères comme les ",(,[ qu'il faudrait supprimer afin de tenter d'obtenir le premier caractère alphabétique de la chaine ?

Je pense au tiret "-" , "{}" . Qu'en penses-tu Sergio?