Discussion :

[SergioMaster]

Bonjour,

Pour des besoins de lecture rapide j'ai besoin de trier les résultats que j'obtiens dans un mémo

voici le code que j'ai "pondu", en fait je passe par un TStringList intermédiaire, pas encore assez familiarisé avec les TDictionnary et autre pour m'en passer

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
 
uses ... System.Bindings.Methods ...;
 
procedure TMainForm.ObtenirClick(Sender: TObject);
var
  AnArray : TArray<TMethodDescription>;
  AMethode : TMethodDescription;
  AStringList : TStringList;
begin
  AStringList:=TStringList.Create;
  try
  // Obtenir les méthodes enregistrées
  // pour en avoir une liste triée, je passe par une TStringList intermédiaire
  AnArray:= TBindingMethodsFactory.GetRegisteredMethods;
  for AMethode in AnArray do
   begin
    AStringList.Add(AMethode.Name);
   end;
  AStringList.Sort;
  MethodesMemo.Lines:=AStringList;
  finally
    AStringList.Free;
  end;
end;

Ma question, y aurait-il plus "propre" genre :
- trier directement AnArray selon l'élément Name
- remplir directement le mémo (MethodesMemo) et trier ensuite ses lignes
j'ai besoin d'un autre point de vue, merci

[Hermite]

Bonjour.

Sans être à l'aise sur le sujet non plus, pour aller au plus propre je dirais qu'on peut utiliser la méthode Sort de TArray :

http://docs.embarcadero.com/products...rray_of_T.html

Ceci dit, cela passe par l'utilisation de IComparer. Le code final n'en sera donc ni plus simple, ni plus court.

La TStringList reste quand même super accessible pour ce genre de cas, et à moins d'un soucis de performance ou de mémoire, je doute que passer par la méthode Sort de TArray apporte un réel gain (encore une fois, pour ce cas).

[anapurna]

salut
tout depand de se que tu veut faire si ce n'est qu'un trie
tu peut aussi modifier le TMemo et lui ajouter la fonction de trie

genre :

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
 
type
  TStringListSortCompare = function(List: TStrings; Index1, Index2: Integer): Integer;
 
  TMemo = Class(Vcl.StdCtrls.TMemo)
  private
    fSorted : Boolean;
    FOnChange: TNotifyEvent;
    FOnChanging: TNotifyEvent;
    procedure CustomSort(Compare: TStringListSortCompare);
    procedure QuickSort(L, R: Integer; SCompare: TStringListSortCompare);
    Procedure  Exchange(I,J : Integer);
  protected
    procedure Changed; virtual;
    procedure Changing; virtual;
    procedure SetSorted(value : Boolean);
  Public
    Procedure Sort;
    property Sorted: Boolean read FSorted write SetSorted;
    property OnChange   : TNotifyEvent read FOnChange write FOnChange;
    property OnChanging : TNotifyEvent read FOnChanging write FOnChanging;
  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
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
 
function CompareString(List : TStrings; Index1, Index2 : integer) : integer;
  begin
    result := AnsiCompareText(List[Index1], List[Index2]);
  end;
 
///////////////////////////////////
Procedure  TMemo.Exchange(I,J : Integer);
var
  s : String;
begin
  s := Self.Lines[i];
  Self.Lines[i] := Self.Lines[j];
  Self.Lines[j]:= s;
end;
///////////////////////////////////
Procedure TMemo.Sort;
begin
  CustomSort(CompareString);
end;
///////////////////////////////////
procedure TMemo.Changed;
begin
  if Assigned(OnChange) Then
    OnChange(self);
end;
///////////////////////////
procedure TMemo.Changing;
begin
  if Assigned(OnChanging) Then
    OnChanging(self);
end;
 
procedure TMemo.SetSorted(value : Boolean);
begin
  if Value <> fSorted Then
  begin
     if fSorted = True Then
       Sort;
     fSorted := Value ;
  end;
end;
 
procedure TMemo.QuickSort(L, R: Integer; SCompare: TStringListSortCompare);
var
  I, J, P: Integer;
begin
  repeat
    I := L;
    J := R;
    P := (L + R) shr 1;
    repeat
      while SCompare(Self.Lines, I, P) < 0 do Inc(I);
      while SCompare(Self.Lines, J, P) > 0 do Dec(J);
      if I <= J then
      begin
        Exchange(I, J);
        if P = I then
          P := J
        else
        if P = J then
          P := I;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(L, J, SCompare);
    L := I;
  until I >= R;
end;
 
procedure TMemo.CustomSort(Compare: TStringListSortCompare);
begin
  if not Sorted and (self.lines.Count > 1) then
  begin
    self.lines.BeginUpdate;
    Changing;
    QuickSort(0,self.Lines.Count - 1, Compare);
    Changed;
    self.lines.EndUpdate;
  end;
end;

[ShaiLeTroll]

Pour le fun uniquement, j'ai utilisé le TArray.Sort
Je confirme que c'est lourd syntaxiquement

Sinon attention au WordWrap dans un TMemo qui altère les lignes

Code :

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

1
2
3
4
5
6
7
8
9
10
      TFTPFoundFile = record
        FileName: TFileName;
        FileDate: TDateTime;
        FileType: TThomEntitySDIFile.TFileType;
      end;
      TFTPFoundFiles = System.Generics.Collections.TList<TFTPFoundFile>;
      TFTPFoundFileOrderer = class(TComparer<TFTPFoundFile>)
      public
        function Compare(const Left, Right: TFTPFoundFile): Integer; override;
      end;

Code :

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

1
2
3
4
5
6
7
8
9
10
//------------------------------------------------------------------------------
function TCensure.TFTPFoundFileOrderer.Compare(const Left, Right: TFTPFoundFile): Integer;
begin
  Result := CompareDateTime(Left.FileDate, Right.FileDate);
  // Sur un FTP externe tel que ftp.Censure.com, la date est précise au mieux à la seconde
  // Sur le FTP interne (TCensureSpareFTPServer), la date est précise jusqu'à à la milli-seconde !
  // Pour compenser une égalité, le nom généralement horodaté à la milli-seconde décidera de l'ordre !
  if Result = 0 then
    Result := CompareStr(Left.FileName, Right.FileName);
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
 
var
  FoundFiles: TFTPFoundFiles;
  OrderedFoundFiles: TArray<TFTPFoundFile>;
  FoundListOrderer: TFTPFoundFileOrderer;
begin
  ...
            // Tri selon la Date, du plus ancien au plus récent
            OrderedFoundFiles := FoundFiles.ToArray();
            FoundListOrderer := TFTPFoundFileOrderer.Create();
            try
              TArray.Sort<TFTPFoundFile>(OrderedFoundFiles, FoundListOrderer);
            finally
              FoundListOrderer.Free();
            end;
 
 
            // Ajout des fichiers en attente de traitement dans l'ordre chronologique de réception
            for iOFF := Low(OrderedFoundFiles) to High(OrderedFoundFiles) do
            begin
              FoundFile := OrderedFoundFiles[iOFF];
              FParentBatch.PushInfo('FileReceiver Scrutation Found : ' + FoundFile.FileName + ' @ ' + FormatDateTime(FDT_YMDHNSZ, FoundFile.FileDate));
 
              case FoundFile.FileType of
...

alors avec le compteur de référence, on devrait pouvoir simplifier ceci

Code :

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

1
2
3
4
5
6
            FoundListOrderer := TFTPFoundFileOrderer.Create();
            try
              TArray.Sort<TFTPFoundFile>(OrderedFoundFiles, FoundListOrderer);
            finally
              FoundListOrderer.Free();
            end;

en cela

Code :

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

1
2
 
              TArray.Sort<TFTPFoundFile>(OrderedFoundFiles, TFTPFoundFileOrderer.Create());

Mais à force de jouer dans les génériques, les sous-types de classes ... Delphi XE2 me balance des erreurs internes du compilateur, j'ai du écrire des codes totalement autrement

[SergioMaster]

Bonjour et Merci.

C'est bien ce qu'il me semblait, passer par le TArray.Sort etc... le code devient un peu trop "lourd".
Comme il ne s'agit que d'une liste "hyper simple" de noms de méthodes accessibles (donc pas de wordwrap) le passage par la StringList me semble donc bien le plus court ou du moins le plus léger.

@anapurna : oui il s'agit d'un simple tri pour un simple programme de démonstration (un de mes futurs articles sur les Livebindings) donc pas de surcharge de TMemo.

En parlant de surcharge, je pensais qu'il aurait été possible de transtyper Memo.Lines en TStringList mais non juste en TArray donc : "le chat se mord la queue".
Je resterai donc sur cette solution pas très élégante mais très concise (il y a pourtant toujours ce petit doute qui me titille, il va falloir que je revisionne une video).

Merci encore pour votre implication, je clôturerai ce sujet dans un jour ou deux (ou cas où cette vidéo déclencherait quelque chose)

[Cirec]

Bonjour,

alors avec le compteur de référence, on devrait pouvoir simplifier ceci

Code :

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

1
2
3
4
5
6
            FoundListOrderer := TFTPFoundFileOrderer.Create();
            try
              TArray.Sort<TFTPFoundFile>(OrderedFoundFiles, FoundListOrderer);
            finally
              FoundListOrderer.Free();
            end;

en cela

Code :

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

1
2
 
              TArray.Sort<TFTPFoundFile>(OrderedFoundFiles, TFTPFoundFileOrderer.Create());

Mais à force de jouer dans les génériques, les sous-types de classes ... Delphi XE2 me balance des erreurs internes du compilateur, j'ai du écrire des codes totalement autrement

je me pose juste une question, en simplifiant ainsi on devrait avoir une fuite de mémoire (du moins sur les anciennes versions).
j'ai bien remarqué que le comportement avait changé sous Berlin & Tokyo
mais depuis quelle version de l'IDE cette amélioration est présente ?

Cordialement,
@+

[ShaiLeTroll]

Normalement comme c'est un IComparer donc c'est le compteur du TInterfacedObject qui libère l'objet instancié
C'est un très vieux mécanisme hérité de l'implémentation modèle COM en Delphi
Faudrait que je fasse le test de fuite


tient j'ai trouvé ce commentaire dans mon code

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
 
//------------------------------------------------------------------------------
class procedure TStyleManagerSLTAssistant.BuildChangeStyleMenu(AMenu: TMenuItem; AOnClick: TNotifyEvent; const ADefaultStyle: string = '');
var
  Styles: TArray<string>;
  StyleNames: TStringList;
  I: Integer;
  menu: TMenuItem;
  SystemStyleName, DefaultStyleName: string;
begin
  AMenu.AutoHotkeys := maManual;
  AMenu.Clear();
 
  SystemStyleName := Vcl.Themes.TStyleManager.SystemStyle.Name;
  if ADefaultStyle <> '' then
    DefaultStyleName := ADefaultStyle
  else
    DefaultStyleName := SystemStyleName;
 
  Styles := Vcl.Themes.TStyleManager.StyleNames;
 
  // TArray.Sort<> et TStringComparer semble bien buggé (mauvais ordre QC 104697, libération incorrecte QC 99861, QC 104642)
  // Effectivement, 'Windows' se retrouve en 7eme position alors qu'il devrait être dernier.
  // De plus 'Windows' (contenu de SystemStyleName), je le veux en Premier !
  StyleNames := TStringList.Create();
  try
    for I := Low(Styles) to High(Styles) do
      if Styles[I] <> SystemStyleName then
          StyleNames.Add(Styles[I]);
    StyleNames.Sort();
    StyleNames.Insert(0, SystemStyleName);
 
    for I := 0 to StyleNames.Count - 1 do
    begin
      menu := TMenuItem.Create(AMenu);
      AMenu.Add(menu);
      menu.Tag := I;
      menu.AutoHotkeys := maManual;
      menu.RadioItem := true;
      menu.GroupIndex := 1;
      menu.Caption := StyleNames.Strings[i];
 
      if menu.Caption = DefaultStyleName then
      begin
        menu.Checked := True;
        TStyleManager.SetStyle(menu.Caption);
      end;
 
      menu.OnClick := AOnClick;
    end;
  finally
    StyleNames.Free();
  end;
end;

[Papy214]

Pourquoi passer par une fonction de comparaison ?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
uses System.Generics.Collections, System.Generics.Defaults;
 
procedure TForm24.FormDblClick(Sender: TObject);
var
  AnArray: TArray<string>;
  S: string;
begin
  AnArray := ['jeudi', 'vendredi', 'lundi'];
  TArray.Sort<string>(AnArray, TStringComparer.Ordinal);
  for S in AnArray do
    Memo1.Lines.Add(S);
end;

[Cirec]

Normalement comme c'est un IComparer donc c'est le compteur du TInterfacedObject qui libère l'objet instancié
C'est un très vieux mécanisme hérité de l'implémentation modèle COM en Delphi
Faudrait que je fasse le test de fuite

Merci pour cette précision, je ne savais pas que "TFTPFoundFileOrderer" héritait de "TInterfacedObject" ... ceci explique cela
le teste de fuite me semble inutile du coup

en fait je faisais allusion à une autre amélioration apportée à Delphi à savoir :
si je fais ceci sous D7..D2009 j'ai une fuite de mémoire :

Code :

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

1
2
3
4
with TButton.Create(nil) do begin
  Caption := 'Ok';
  Parent := Self; 
end;

ce qui est normale
mais sous Berlin & Tokyo (je n'ai pas de Delphi entre D2009 & Berlin), surprise, il n'y a pas de fuite (sauf si Parent := nil).

C'est cette amélioration que j'avais en tête et je pensai que, peut être, d'autres types d'objets était couvert par cette nouveauté.

quand à ceci :

Code :

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

1
2
3
  // TArray.Sort<> et TStringComparer semble bien buggé (mauvais ordre QC 104697, libération incorrecte QC 99861, QC 104642)
  // Effectivement, 'Windows' se retrouve en 7eme position alors qu'il devrait être dernier.
  // De plus 'Windows' (contenu de SystemStyleName), je le veux en Premier !

Merci pour l'info. dès que j'ai le temps je testerai.

sinon juste pour le fun,
une autre voie qui permet un tri directement sur le mémo avec la possibilité
d'utiliser une fonction de tri personnalisée :

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
unit crSLHelper;
 
interface
uses Classes;
 
type
 
  TStringsHelper = class helper for TStrings
  public
   procedure Sort(const CompareFunction: TStringListSortCompare = nil);
  end;
implementation
 
procedure TStringsHelper.Sort(const CompareFunction: TStringListSortCompare);
var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    SL.Assign(Self);
    if Assigned(CompareFunction) then
      SL.CustomSort(CompareFunction)
    else
      SL.Sort;
    Self.Assign(SL);
  finally
    SL.Free;
  end;
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
var
  Form4: TForm4;
 
implementation
 
{$R *.dfm}
uses crSLHelper;
 
function CompareInt(const a, b: Integer): Integer;
begin
  if A > B then Result := 1
  else
  if A < B then Result := -1
  else Result := 0;
end;
 
function MyCompareFunc(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := CompareInt(StrToIntDef(List[Index1], 0), StrToIntDef(List[Index2], 0));
end;
 
procedure TForm4.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Sort;  // tri classique 
  Memo2.Lines.Sort(MyCompareFunc);  // tri sur une liste d'entier
end;
 
procedure TForm4.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;
end;
 
end.

Cordialement,
@+

[ShaiLeTroll]

Sympa le Helper
C'est vrai que je trie plutôt des ComboBox et tout simplement par le texte

en fait je faisais allusion à une autre amélioration apportée à Delphi à savoir :
si je fais ceci sous D7..D2009 j'ai une fuite de mémoire :

Code :

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

1
2
3
4
with TButton.Create(nil) do begin
  Caption := 'Ok';
  Parent := Self; 
end;

ce qui est normale
mais sous Berlin & Tokyo (je n'ai pas de Delphi entre D2009 & Berlin), surprise, il n'y a pas de fuite (sauf si Parent := nil).


C'est cette amélioration que j'avais en tête et je pensai que, peut être, d'autres types d'objets était couvert par cette nouveauté.

curieux !
Normalement en D7, c'était déjà écrit dans l'aide que le Parent était responsable de la libération (un peu en double du Owner d'ailleurs)
Voici un débat à ce sujet Parent et Owner

Etant en D7 à l'époque du sujet, je n'avais pas constaté de fuite mémoire

[Cirec]

Ha !!!

ce débat me laisse sans voix
je pourrai même dire qu'il me laisse sans voie
parce que je me sens un peu perdu là ...

Que puis-je dire de plus ?
au temps pour moi,
tout comme la majorité des intervenants du débat j'avais acquis des certitudes, sur le rôle du Owner et celui du Parent, à un tel point que j'ai même eut du mal croire le résultat des testes

Bon il n'y a pas de conséquence, heureusement mais quand même ça fait un micro-choc

En tous cas, je te remercie pour ce lien très instructif.

Cordialement,
@+