RichEdit et formatage de mot dans une ligne

Version imprimable

1 pièce(s) jointe(s)

Bonjour

Je ne voulais en arriver là mais j'en ai marre de tourner en rond.
Je cherche à écrire sur une ligne d'un TRichEdit des mots dans un format différent.
Le code que j'ai fait me parait bon et pourtant ça ne fonctionne et je ne comprends pas pourquoi.

Code:

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 
unit Unit8;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;
 
type
  TForm8 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  end;
 
var
  Form8: TForm8;
 
implementation
 
{$R *.dfm}
 
type
  TRichEditHelper = class helper for TRichEdit
    procedure AddText(Texte: string; Styles: TFontStyles);
  end;
 
var
  Passage: Integer;
 
procedure Log(Texte: string);
begin
  Form8.Memo1.Lines.Add(Texte);
end;
 
procedure TForm8.Button1Click(Sender: TObject);
begin
  Passage := 0;
  RichEdit1.AddText('Lundi', [fsBold]);
  RichEdit1.AddText(' Mardi', [fsItalic]);
  RichEdit1.AddText(' Mercredi', [fsUnderline]);
end;
 
{ TRichEditHelper }
 
procedure TRichEditHelper.AddText(Texte: string; Styles: TFontStyles);
begin
 
  Inc(Passage);
 
  Log(Format('Passage n° %d', [Passage]));
 
  if Length(Lines.Text) = 0 then
  begin
    Text     := Texte;
    SelStart := 0;
  end
  else
  begin
    Lines[Pred(Lines.Count)] := Trim(Lines[Pred(Lines.Count)]) + Texte;
    SelStart                 := Length(Lines.Text) - Texte.Length - 2;
  end;
  SelLength           := Texte.Length;
 
  Log(Format('SelStart = %d / SelLength = %d', [SelStart, SelLength]));
 
  SelAttributes.Style := Styles;
 
  SelStart            := Texte.Length;
  SelLength           := 0;
  SelAttributes.Style := [];
 
  Refresh;
end;
 
end.

Voilà le résultat :

Pièce jointe 656334

SelStart et SelLength semblent pourtant corrects et ça ne colle pas. :-(

Elle est où ma bêtise ?????

Pour un log, voici un code pouvant t'inspirer :

Code:

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
//------------------------------------------------------------------------------
procedure TTraceMonitor.AddMessage(const AMsg: string; AMsgType: TMessageType = mtInfo);
var
  MsgEx: string;
begin
  if Assigned(Form) then
  begin
    with FForm do
    begin
      RichEditMessages.Lines.BeginUpdate();
      try
         if RichEditMessages.Lines.Count > 10000 then
         begin
            RichEditMessages.Lines.Clear();
            RichEditMessages.Lines.Add('Effacement ...');
            FCaret := Length(RichEditMessages.Lines.Text);
         end;
         MsgEx := Trim(FormatDateTime('DD/MM/YYYY HH:NN:SS', Now()) + ' - ' + AMsg);
         RichEditMessages.Lines.Add(MsgEx);
         RichEditMessages.SelStart := FCaret;
         RichEditMessages.SelLength := Length(MsgEx) + 1; // + 1 pour la fin de ligne (curieux en D7, il fallait un +2 pour CR+LF)
         if AMsgType = mtCatastrophicFailure then
         begin
           RichEditMessages.SelAttributes.Color := clRed;
           RichEditMessages.SelAttributes.Style := [fsBold];
         end
         else if AMsgType = mtBusinessError then
         begin
           RichEditMessages.SelAttributes.Color := clMaroon;
           RichEditMessages.SelAttributes.Style := [];
         end
         else if AMsgType = mtSystemWarning then
         begin
           RichEditMessages.SelAttributes.Color := clWebOrange;
           RichEditMessages.SelAttributes.Style := [];
         end
         else
         begin
           RichEditMessages.SelAttributes.Color := clGreen;
           RichEditMessages.SelAttributes.Style := [];
         end;
 
         Inc(FCaret, RichEditMessages.SelLength);
         RichEditMessages.SelLength := 0;
         RichEditMessages.Perform(EM_LINESCROLL, 0, RichEditMessages.Lines.Count);
      finally
         RichEditMessages.Lines.EndUpdate();
      end;
    end;
  end;
end;

Ou alors un chargement d'un script mettant en évidence certaines sections, celle avait le login, celle après le logout et les lignes trop longues que le memo met à la ligne malgré un wordwrap à false

Code:

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
//------------------------------------------------------------------------------
procedure TxxxMainForm.LoadMemoFromStrings(AStrings: TStrings);
var
  Chrono: System.Diagnostics.TStopwatch;
  I, CurrentLine, NewLine, NewLineCount, LoginLine, LogoutLine: Integer;
  Line, LinePrior: string;
  Caret, CaretPrior: Integer;
begin
  Chrono := System.Diagnostics.TStopwatch.StartNew();
 
  pnlActions.Enabled := False;
  memoScript.ReadOnly := True;
  try
    memoScript.Lines.BeginUpdate();
    try
      memoScript.Lines.Clear();
 
      Caret := 0;
      CaretPrior := 0;
      CurrentLine := -1;
      LoginLine := -1;
      LogoutLine := -1;
      for I := 0 to AStrings.Count - 1 do
      begin
        Line := AStrings[I];
        if LoginLine < 0 then
          if StartsText('[Login]', Line) then
            LoginLine := I;
        if LogoutLine < 0 then
          if StartsText('[Logout]', Line) then
            LogoutLine := I;
 
        NewLine := -1;
        try
          NewLine := memoScript.Lines.Add(Line);
        except
          on E: EOutOfResources do // 'RichEdit line insertion error'
          begin
            memoScript.SelStart := Caret;
            memoScript.SelLength := Length(Line);
            memoScript.SelAttributes.Color := clMaroon;
            memoScript.SelLength := 0;
          end;
        end;
        // Attention, c'est sur la Ligne L que l'on détecte si la Ligne précédente a été découpée sur plusieurs lignes.
        if (NewLine >= 0) and (NewLine <> CurrentLine + 1) then
        begin
          NewLineCount := NewLine - CurrentLine;
          memoScript.SelStart := CaretPrior;
          memoScript.SelLength := Length(LinePrior);
          memoScript.SelAttributes.Color := clRed;
          memoScript.SelLength := 0;
        end;
 
        CaretPrior := Caret;
        Inc(Caret, Length(Line) + 1); // + 1 pour le Char CRLF
 
        CurrentLine := NewLine;
        LinePrior := Line;
 
        if not ByteBool(I) then
        begin
          edScriptFileName.EditLabel.Caption := Format('Script file : %d Lines load in %d ms, waiting ...', [memoScript.Lines.Count, Chrono.ElapsedMilliseconds]);
          ckbBatchRun.Left := edScriptFileName.Left + edScriptFileName.EditLabel.Width + 8;
          Application.ProcessMessages();
        end;
      end;
 
      if LogoutLine >= 0 then
      begin
        // Recalage à cause des lignes trop longues
        LogoutLine := LogoutLine + memoScript.Lines.Count - AStrings.Count;
        for I := memoScript.Lines.Count - 1 downto LogoutLine + 1 do
        begin
          // Caret a été calculé ci-dessus durant le remplissage
          Line := memoScript.Lines[I];
          Dec(Caret, Length(Line) + 1); // + 1 pour le Char CRLF
          memoScript.SelStart := Caret;
          memoScript.SelLength := Length(Line);
          if memoScript.SelAttributes.Color <> clMaroon then
            memoScript.SelAttributes.Color := clWebOrange;
        end;
      end;
 
      if LoginLine >= 0 then
      begin
        Caret := 0;
        for I := 0 to LoginLine - 1 do
        begin
          Line := memoScript.Lines[I];
          memoScript.SelStart := Caret;
          memoScript.SelLength := Length(Line);
          if memoScript.SelAttributes.Color <> clMaroon then
            memoScript.SelAttributes.Color := clWebOrange;
          Inc(Caret, Length(Line) + 1); // + 1 pour le Char CRLF
        end;
      end;
    finally
      memoScript.Lines.EndUpdate();
    end;
 
    edScriptFileName.EditLabel.Caption := Format('Script file : %d Lines load in %d ms', [memoScript.Lines.Count, Chrono.ElapsedMilliseconds]);
    ckbBatchRun.Left := edScriptFileName.Left + edScriptFileName.EditLabel.Width + 8;
    if memoScript.Lines.Count <> AStrings.Count then
      MessageDlg('Lignes de longueur excessive détectées', mtWarning, [mbOK], 0);
  finally
    memoScript.ReadOnly := False;
    pnlActions.Enabled := True;
  end;
end;

21/06/2024, 11h02
Papy214

Merci mais si je ne me trompe pas, ton code met un format différent par ligne selon le cas.
Mon problème ici est que mardi devrait être en italique et qu'il ne l'est pas.
Comme si le dernier appel de fonction modifiait le texte précédent avec le format du premier mot.

Ajoute

Code:

RichEdit1.AddText(' Jeudi', [fsStrikeOut]);

Tu noteras que le problème se décale

En pas à pas, on voit que le style est pris mais il doit y avoir un chevauchement (overlap) à un moment qui annule la fin du premier style qui s'applique du coup sur l'ensemble jusqu'au dernier style
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 begin Passage := 0; RichEdit1.Clear(); RichEdit1.AddText('Lundi', [fsBold]); ShowMessage('OK'); RichEdit1.AddText(' Mardi', [fsItalic]); ShowMessage('OK'); RichEdit1.AddText(' Mercredi', [fsUnderline]); ShowMessage('OK'); RichEdit1.AddText(' Jeudi', [fsStrikeOut]); ShowMessage('OK'); RichEdit1.AddText(' Vendredi', []); ShowMessage('OK'); end;
Je me demande si tu ne dois pas réappliquer les styles précédents à chaque du chevauchement, je me demande si TRichEditStrings.Put supporte plusieurs styles sur la même ligne lors de la modification de la ligne

1 pièce(s) jointe(s)

Code:

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
type
  TRichEditHelper = class helper for TRichEdit
  private
    type
      TLocalizedTextAttributes = class(TObject)
      strict private
        FSelStart: Integer;
        FSelLength: Integer;
        FSelStyles: TFontStyles;
      public
        constructor Create(ARichEdit: TRichEdit; ASelStart: Integer; ASelLength: Integer; AStyles: TFontStyles);
 
        property SelStart: Integer read FSelStart;
        property SelLength: Integer read FSelLength;
        property SelStyles: TFontStyles read FSelStyles;
      end;
      TLocalizedTextAttributesOfLine = TObjectList<TLocalizedTextAttributes>;
  public
    procedure AddText(const AText: string; AStyles: TFontStyles);
 
  public
    // Saloperie TRichEditStrings ne gère pas Objects[], faudrait maintenir une parallèle et qui sera incompatible avec WordWrapp
    class var TextAttributesOfLines: TObjectList<TLocalizedTextAttributesOfLine>; // A gérer par instance et non en class en var !!!
    // Remplacer le Helper par une redéfinition locale TRichEdit = class(Vcl.ComCtrls.TRichEdit) par ajouter des propriétés dont TextAttributesOfLines
 
  end;
 
var
  Passage: Integer;
 
procedure Log(Texte: string);
begin
  Form1.Memo1.Lines.Add(Texte);
end;
 
 
{ TRichEditHelper }
 
procedure TRichEditHelper.AddText(const AText: string; AStyles: TFontStyles);
var
  TotalLength, TextCaret: Integer;
  LineIndex, TrimOffset: Integer;
  Line, TrimLine: string;
  ltaof: TLocalizedTextAttributesOfLine;
  lta: TLocalizedTextAttributes;
begin
 
  Inc(Passage);
 
  Log(Format('Passage n° %d', [Passage]));
 
  TextCaret := 0;
  TotalLength := Length(Lines.Text);
  if TotalLength = 0 then
  begin
    if not Assigned(TextAttributesOfLines) then
      TextAttributesOfLines := TObjectList<TLocalizedTextAttributesOfLine>.Create(True);  // A libérer et à gérer par instance, là j'ai la flemme !!!
 
    // Lines.AddObject('', TLocalizedTextAttributesOfLine.Create(True)) // Saloperie TRichEditStrings ne gère pas Objects[]
    Lines.Add(''); // A libérer !!!
    TextAttributesOfLines.Add(TLocalizedTextAttributesOfLine.Create(True));
  end
  else
    TextCaret := TotalLength - 2;
 
  LineIndex := Lines.Count - 1;
  Line := Lines[LineIndex];
  TrimLine := Trim(Line);
  TrimOffset := Length(Line) - Length(TrimLine);
  Lines[LineIndex] := TrimLine + AText;
  SelStart := TextCaret;
  if TrimOffset > 0 then
    SelStart := SelStart - TrimOffset; // le Trim provoquera des décalages dans les attributs donc des chevauchements !
 
  SelLength           := AText.Length;
 
  ltaof := TextAttributesOfLines[LineIndex];
  ltaof.Add(TLocalizedTextAttributes.Create(Self, SelStart, SelLength, AStyles));
  for lta in ltaof do
  begin
    SelStart := lta.SelStart;
    SelLength := lta.SelLength;
    SelAttributes.Style := lta.SelStyles;
  end;
 
  Log(Format('SelStart = %d / SelLength = %d', [SelStart, SelLength]));
 
  Refresh;
end;
 
{ TRichEditHelper.TLocalizedTextAttributes }
 
constructor TRichEditHelper.TLocalizedTextAttributes.Create(ARichEdit: TRichEdit; ASelStart: Integer; ASelLength: Integer; AStyles: TFontStyles);
begin
  inherited Create();
 
  FSelStart := ASelStart;
  FSelLength := ASelLength;
  FSelStyles := AStyles;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Passage := 0;
  RichEdit1.Clear();
  RichEdit1.AddText('Lundi', [fsBold]);
  ShowMessage('OK');
  RichEdit1.AddText(' Mardi', [fsItalic]);
  ShowMessage('OK');
  RichEdit1.AddText(' Mercredi', [fsUnderline]);
  ShowMessage('OK');
  RichEdit1.AddText(' Jeudi', [fsStrikeOut]);
  ShowMessage('OK');
  RichEdit1.AddText(' Vendredi', []);
  ShowMessage('OK');
end;

Pièce jointe 656342

Je te laisse remplacer le Helper par une redéfinition locale TRichEdit = class(Vcl.ComCtrls.TRichEdit) pour gérer les Objects[] pour chaque instance, j'ai eu la flemme, la version ci-dessous est en class var, c'est juste pour la démo, si tu as plusieurs RichEdit, cela doit être impérativement géré par Instance et là tu arrives à la limite du helper qui ne peut pas ajouter de propriété

Un exemple de redéfinition locale d'un TLabeledEdit qui devrait t'aider à comprendre comme faire celle pour TRichEdit à la place du Helper, les deux peuvent être cumulé d'ailleurs

Toujours particulier ces richedit :koi:

Au plus simple, tu définis le style du texte à venir (avant insertion) :
Code:

1 2 3 4 5 6 procedure TRichEditHelper.AddText(const aTexte: string; aStyles: TFontStyles); begin SelStart := Length(Text); SelAttributes.Style := aStyles; SelText := aTexte; end;

21/06/2024, 14h24
Papy214

@ShaiLeTroll merci pour le code ! Je vais dériver sous forme d'objet

@Andnotor merci également

J'avais trouvé un exemple où c'est une classe qui gère le TRichEdit. Mais son utilisation était un peu compliquée.
Il 'agissait d'envoyer une ligne entière puis définir ensuite le format de chaque partie du texte.

Et tout ça pour afficher un texte formaté dans un QuickReport.
Si j'avais trouvé une solution en html, ça aurait été plus simple :)
21/06/2024, 16h54
ShaiLeTroll

Citation:

Envoyé par Papy214

Il 'agissait d'envoyer une ligne entière puis définir ensuite le format de chaque partie du texte.

En fait, c'est exactement ce que fais le code proposé, sauf qu'il se débrouille pour se souvenir à chaque incrément
Donc lors de l'ajout du dernier mot, cela réapplique à la ligne, tous les attributs mémorisé

Mais la version via SelText est bien plus simple, je n'avais pas pensé que l'on pouvait modifier un texte inexistant à l'origine, cela permet donc aussi d'insérer, je l'ai su, je l'ai oublié et je l'oublierais, je n'utilise du TRichEdit qu'une fois tous les cinq ans pour des outils internes, jamais pour des logiciels pour les utilisateurs finaux

et n'utilise rien d'autre que SelText (ou Lines.Add mais jamais Lines[]) sinon tu retomberas dans ton bug précédent si tu tentes d'ajouter autrement du texte

Sinon, c'est pour un QuickReport, pourquoi ne pas l'avoir dessiné directement ?
21/06/2024, 17h23
Papy214

Citation:

Sinon, c'est pour un QuickReport, pourquoi ne pas l'avoir dessiné directement ?

Toujours le même logiciel ... Le programmeur que j'aide avait un souci de formatage et je cherchais une solution pour le dépanner.
Et la zone qui contient le texte doit prendre son contenu dans un TRichEdit.