Txt classement par ordre alphabétique

Télécharger le projet
Commenter

Description

Cette fontion permet de classer une liste de mot par ordre alphabétique,
en prenant uniquement compte des trois premiers caractères.
Le problème majeur de cette fonction, c'est qu'elle prend un temps
relativement long à classer une liste comprenant plus de 100 mots.
J'aimerais donc que quelq'un me dise comment faire, pour optimiser
le rendement de cette fonction. Mon raisonnement est je sais un peu
"viello", mais c'est en faisant des erreurs qu'on apprend.

Source / Exemple : 


function TForm1.Alpha:string;
var
mot1 ,mot2: string;
M, N, I, F, Nbr, powlet1, powlet2, powlet3, powlet4, powlet5, powlet6: integer;
Fin: boolean;
begin
M := 0;
N := 0;
I := 0;
F:= 0;
Nbr := Memo1.lines.count-1; // Nbr = Nombre de ligne dans Memo1 - 1
Fin := False;
repeat
  mot1 := Memo1.lines.Strings[M];
  powlet1 := ord(mot1[1]);  // powlet1 = valeur 1er lettre du mot1
  powlet2 := ord(mot1[2]);  // powlet2 = valeur 2eme lettre du mot1
  powlet3 := ord(mot1[3]);  // powlet3 = valeur 3eme lettre du mot1
  for F := N to Nbr do
  begin
      mot2 := Memo1.lines.Strings[N];
      powlet4 := ord(mot2[1]);  // powlet4 = valeur 1er lettre du mot2
      powlet5 := ord(mot2[2]);  // powlet5 = valeur 2eme lettre du mot2
      powlet6 := ord(mot2[3]);  // powlet6 = valeur 3eme lettre du mot2
//      showmessage('Je compare '+mot1+' avec '+mot2);
//      showmessage('I = '+IntToStr(I)+#13+#13+'mot1 = '+mot1+#13+#13+'mot2 = '+mot2);
      if (powlet1 = powlet4) then
      // si valeur 1er lettre du mot1 = valeur 1er lettre du mot2 alors
        begin
          if (powlet2 = powlet5) then
          // si valeur 2eme lettre du mot1 = valeur 2eme lettre du mot2 alors
            begin
              if (powlet3 < powlet6) then
              // si valeur 3eme lettre du mot1 est superieur à valeur 3eme lettre du mot2 alors
                begin
//                  showmessage('valeur 3eme lettre de '+mot1+' est superieur à valeur 3eme lettre de '+mot2);
//                  showmessage('remplace '+Memo1.lines[N]+' par '+mot1);
                  Memo1.lines[N] := mot1;
                  // remplace mot2 par mot1
//                  showmessage('remplace '+Memo1.lines[M]+' par '+mot2);
                  Memo1.lines[M] := mot2;
                  // remplace mot1 par mot2
                  M := M + 1;
                  N := N + 1;
                end;
            end;
          if (powlet5 < powlet2) then
          // si valeur 2eme lettre du mot1 est superieur à valeur 2eme lettre du mot2 alors
            begin
//              showmessage('valeur 2eme lettre de '+mot1+' est superieur à valeur 2eme lettre de '+mot2);
//              showmessage('remplace '+Memo1.lines[N]+' par '+mot1);
              Memo1.lines[N] := mot1;
              // remplace mot2 par mot1
//              showmessage('remplace '+Memo1.lines[M]+' par '+mot2);
              Memo1.lines[M] := mot2;
              // remplace mot1 par mot2
              M := M + 1;
              N := N + 1;
            end;
        end;
      if (powlet4 < powlet1) then
      // si valeur 1eme lettre du mot1 est superieur à valeur 1eme lettre du mot2 alors
        begin
//          showmessage('valeur 1er lettre de '+mot1+' est superieur à valeur 1er lettre de '+mot2);
//          showmessage('remplace '+Memo1.lines[N]+' par '+mot1);
          Memo1.lines[N] := mot1;
          // remplace mot2 par mot1
//          showmessage('remplace '+Memo1.lines[M]+' par '+mot2);
          Memo1.lines[M] := mot2;
          // remplace mot1 par mot2
          M := M + 1;
          N := N + 1;
        end;
  end;
M := I;
I := I + 1;
N := I;
if (I = Nbr+1) then Fin := True;
Application.ProcessMessages;
Until Fin;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
I, Nbr: integer;
begin
I := 1;
Nbr := Memo1.lines.count;
for I := I to Nbr do
Alpha;
end;

Conclusion :


J'ai extrait cette fonction de mon programme qui a pour but de traiter les fichiers TXT.
Il est donc possible qu'une certaine incompatibilitée apparaisse au niveau d'une incrustation
dans un autre programme. J'ai modifier des parametres, mais bon ... on ne sait jamais.

Vous pouvez aussi enlever les // devant les 'showmessage' vous verrez ainsi les étapes.

Je crois que je n'ai rien oublié, sinon un grand merci pour l'aide que vous pourrez m'apporter.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_askil2000)