Discussion :

[Gregory666]

Bonjour ,

j'aimerais améliorer le temps de traitement de cette procédure qui consiste a indenter chaque ligne d'un mémo , je la trouve énormément longue à traiter toute les lignes du mémo.

Ma méthode :

Exemple d'une ligne : "G01 j0 x-10 F52"

1: On retire les espaces de la ligne (LnTrim) : "G01j0x-10F52"
2: On convertie la ligne en majuscule (UpperCase) : "G01J0X-10F52"
3: On recherche les délimiteurs de la chaine (if pos then), pour chaque délimiteurs qui correspond a la condition, on luis insert un espace a la position du délimiteur : "G01 J0 X-10 F52"

Code :

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

1
2
3
4
5
6
7
8
9
10
{ABC := LnTrim(A B C)}
function LnTrim(Ln: String): String;
var
  ILn: Integer;
begin
  for ILn := 1 to Length(Ln) do
   begin
     if not CharInSet(Ln[ILn], [#32]) then Result := Result + Ln[ILn];
   end;
end;

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
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
procedure TForm1.BtIndenterClick(Sender: TObject);
var
  ILn: Integer;
  Ln: String;
begin
 
  with Memo do
   begin
    Gauge.MaxValue := Lines.Count;
 
    ReadOnly := True;
    Lines.BeginUpdate;
 
    for ILn := 0 to Lines.Count -1 do
     begin
// On touche pas au commentaire (*//);
       if Pos('*//', Lines.Strings[ILn]) = 1 then Continue;
 
       Ln := EmptyStr;
// On retire les espaces & convertie la ligne en majuscule
       Ln := LnTrim(UpperCase(Lines.Strings[ILn]));
 
// Si la ligne est vide , on la remplace par un commentaire (*//)
       if Ln = EmptyStr then
        begin
          Ln := '*// !!! Ln n/a !!!';
          Lines.Strings[ILn] := Ln;
          Continue;
        end;
 
       if Pos('J', Ln) <> 0 then
        begin
          Insert(#32, Ln, Pos('J', Ln));
        end;
 
       if Pos('F', Ln) <> 0 then
        begin
          Insert(#32, Ln, Pos('F', Ln));
        end;
 
       if Pos('X', Ln) <> 0 then
        begin
          Insert(#32, Ln, Pos('X', Ln));
        end;
 
       Lines.Strings[ILn] := Ln;
 
       Gauge.Progress := ILn;
       Application.ProcessMessages;
     end;
 
    Gauge.Progress := 0;
    Gauge.Refresh;
 
    Lines.EndUpdate;
    ReadOnly := False;
 
  end;

Auriez vous une méthode plus efficace qui pourrai amélioré le temps de traitement ?

Merci.

[retwas]

Un StringReplace des espaces par '' est peut etre plus rapide que ta fonction Lntrim, en tout cas c'est plus simple ^^

Tu peux encapsuler le beginupdate et endupdate dans un try ... finally, tu n'as pas besoin du Application.ProcessMessages nan ?

[Gregory666]

J'ai fait quelque teste en supprimant " Application.ProcessMessages & Gauge.Progress := ILn "

le temps de traitement de la procédure se joue à quelque millisecondes sans " Application.ProcessMessages & Gauge.Progress := ILn "

Finalement, c'est pas sa qui réduit énormément temps de traitement.

J'avais déjà fait quelque teste sur la fonction "Lntrim" pour une longue de chaine de 2000 caractères son temps de traitement été de 0 milliseconde.

[SergioMaster]

Bonjour,

c'est quoi les "délimiteurs' GJXF ? toujours dans le même ordre ?
quelle est la version de Delphi ?
avez vous pensé aux expressions régulières ?

[Gregory666]

Oui il son toujours dans le mème ordre logiquement. mais je préféré anticipé le désordre

G01 : Une fonction
J : N° Servomoteur
X : Coordonné de déplacement
F: Vitesse programmé

j'ai pris comme exemple G01 mais j'ai d'autre fonction qui comporte d'autre délimiteur exemple : SVM J0 I200/2500 DEG180 F500 OP86

Delphi XE8

[exoseven]

tu gagnerais beaucoup à faire tout tes traitement directement dans une seule boucle lors du parcourt pour éliminer les espaces, puisque tu testes tout les caractères autant que cela serve

dans ton code en plus tu fais plusieurs fois le même calcul pour les Pos(...)

[retwas]

C'est quasiment instantané avec une StringList locale, plutôt que de travailler directement sur le Memo.

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
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
procedure TForm2.Button2Click(Sender: TObject);
var
   iLn  : integer;
   ln   : string;
   List : TStringList;
begin
   List := TStringList.Create;
 
   try
      Memo.Lines.BeginUpdate;
      Memo.ReadOnly := True;
 
      List.Assign(Memo.Lines);
      Gauge.Max     := List.Count;
 
      for iLn := 0 to List.Count - 1 do
      begin
         if Pos('*//', List[iLn]) = 1 then
            Continue
         else
         begin
            ln := UpperCase(StringReplace(List[iLn], ' ', '', [rfReplaceAll, rfIgnoreCase]));
 
            if ln = '' then
            begin
               Ln := '*// !!! Ln n/a !!!';
               List[iLn] := ln;
               Continue;
            end
            else
            begin
               if Pos('J', Ln) <> 0 then
               Insert(#32, Ln, Pos('J', Ln));
 
               if Pos('F', Ln) <> 0 then
               Insert(#32, Ln, Pos('F', Ln));
 
               if Pos('X', Ln) <> 0 then
               Insert(#32, Ln, Pos('X', Ln));
 
               List[ILn] := Ln;
            end;
         end;
 
         Gauge.Position := iLn;
         Application.ProcessMessages;
      end;
 
      Memo.Lines.Assign(List);
   finally
      FreeAndNil(List);
      Memo.ReadOnly := False;
      Memo.Lines.EndUpdate;
   end;
end;

[Gregory666]

Oui effectivement , j'ai fait un teste avec plus de 5000 ligne sa a durée à peine 2 secondes