GENÈSE D'UN DICTIONNAIRE

Construction d'un lexique interactif avec Lazarus


précédentsommairesuivant

Extension et recherches élémentaires

Introduction

Les précédents chapitres nous ont permis de découvrir une base de vocabulaire consistante, et de créer avec Lazarus(29) les outils permettant de la parcourir et de l'enrichir.

Cet enrichissement est possible soit en ajoutant des mots, soit en établissant des liens entre eux, de façon à permettre de chercher des associations d'idées potentielles.

Dans le présent chapitre, nous allons introduire un complément substantiel à notre vocabulaire, clarifier l'interface graphique, et aborder le domaine des recherches en créant un masque de saisie.

Environnement

Chapitre 9…

Créons un répertoire Lex9 et recopions dans ce nouveau répertoire tous les fichiers du répertoire Lex8 utilisé précédemment. Pour éviter toute difficulté ultérieure, suivez la check-list :

  • ouvrir pLex8.lpi dans Lex9 avec Lazarus ;
  • enregistrer uLex8.pas sous le nom de uLex9.pas ;
  • accepter la suppression des références à uLex8.pas ;
  • enregistrer pLex8.pas sous le nom de pLex9.pas ;
  • renommer la fenêtre Lex8 en Lex9 ;
  • dans le répertoire Lex9, supprimer les anciens fichiers contenant la mention Lex8 ainsi que le fichier fondamental liste.de.mots.francais.frgut.txt désormais inutile ;
  • dans la procédure MAJBalayage, remplacer Lex8 par Lex9.

Nous retrouvons le projet dans l'état où nous l'avions laissé, et les modifications que nous allons effectuer n'affecteront pas l'étape précédente consultable dans le répertoire Lex8.

Extension du vocabulaire

Nous savons maintenant créer des liens (fichier fichLiens.bin, au format binaire) entre les différentes entrées de la liste principale (fichier liMots.txt, au format texte), et le précédent chapitre nous a montré comment modifier cette liste.

L'objectif est évidemment d'étendre les listes de mots et de liens de façon à constituer une base consistante pour nos recherches à venir.

Ce travail a déjà commencé, et les fichiers ci-jointsTéléchargez les deux fichiers vous éviteront une saisie fastidieuse : il a été réalisé à partir de définitions de mots croisés.

Pour les utiliser, il suffit de les enregistrer et de les placer dans le répertoire Lex9 que vous venez de créer, en remplacement des deux fichiers existants.

Un clic sur le petit triangle vert pour lancer l'exécution.

L'existence de deux fichiers distincts pour stocker nos données peut sembler inutilement compliquée. Nous verrons ultérieurement comment les fusionner.

Nombre de mots

Le nombre de mots passe de 336 531 à 337 254(30) : la variation est donc modeste, ce qui est naturel compte tenu de la taille impressionnante de la liste d'origine.

Attention à l'ordre des mots : ce n'est pas celui du dictionnaire, en raison des options adoptées, notamment au sujet des majuscules, des lettres accentuées et des caractères spéciaux.

Les apports proviennent essentiellement de noms propres, mais il y a également quelques mots courants qui, étonnamment, sont absents de la liste d'origine, comme « tansad », « addendum », « ilet », « dyne », « lieder », « cousinage », « athénien », « mât », « pet », « abracadabra », « crédit », « aquifère »…

Image non disponible

La nouvelle liste ne pourra que s'allonger avec l'évolution de la langue et… les ruses des cruciverbistes : qui ne connaît les verbes « stabiloter » ou « podcaster » alors qu'ils ne figurent encore dans aucun dictionnaire ?

Et les néologismes ne font pas peur à nos auteurs !

Nombre de liens

Le nombre de mots liés passe pour sa part de quelques dizaines à plus de 5 100 : c'est le résultat de la saisie de définitions, principalement dues à Michel Laclos, auteur récemment disparu à qui nous rendons particulièrement hommage en raison de la qualité de son humour et… du nombre de grilles qu'il a su créer.

Dans la pratique, un même mot de la liste principale peut se retrouver dans des définitions différentes, ce qui fait que le nombre de liens réels est très supérieur au nombre affiché.

Pour l'évaluer, il suffit d'ajouter une variable dans la procédure lireLiens, de l'incrémenter après chaque fonction Read, et d'afficher sa valeur : les plus curieux pourront vérifier que le nombre de liens dépasse déjà, dans l'état actuel des saisies, les 17 000 ! Le code peut s'écrire ainsi :

 
Sélectionnez
procedure lireLiens;
var
  j, m : integer;
  fLiens : file of integer;
  nombreL : integer;
begin
  nLiens := 0;   //nombre de mots liés
  nombreL := 0;   //nombre de liens
  AssignFile(fLiens, 'fichLiens.bin');
  {$I-}
  Reset(fLiens);
  {$I+}
  if IOResult<>0 then
    ShowMessage('Fichier liens inexistant')
  else
  while not EOF(fLiens) do
  begin
    SetLength(Liens, nLiens+1);      //taille du tableau principal
    Read(fLiens, m);
    SetLength(Liens[nLiens], m);     //taille du tableau secondaire
    for j := 0 to m-1 do
      Read(fLiens, Liens[nLiens, j]); //remplissage du tableau secondaire
    inc(nLiens);                      //nombre de mots liés
    inc(nombreL, m);                  //nombre de liens
  end;
  CloseFile(fLiens);
  ShowMessage('Nombre de liens : '+IntToStr(nombreL));
end;
end;

Une fois la vérification faite, il sera préférable de supprimer toutes les modifications apportées à la procédure.

La base de données sera d'autant plus intéressante qu'elle aura été enrichie : une collaboration permettrait une évolution rapide. En attendant, un thésaurus personnel n'est pas non plus à négliger.

Interface de saisie

Pour l'instant, les mots nouveaux sont saisis dans l'onglet Mots, et les liens dans l'onglet Liens. Cette bascule ne présente pas l'ergonomie souhaitable pour une saisie confortable : le lien introduit peut se révéler être un mot nouveau, ce qui conduit à le saisir une seconde fois dans l'onglet Mots.

Image non disponible Image non disponible

Nous allons introduire un nouveau bouton dans l'onglet Liens : sa fonction sera de remplacer le mot titre par le mot saisi ; son libellé sera naturellement une flèche vers le haut. Pour sa part, le libellé « Lier » de l'ancien bouton sera remplacé par une flèche vers la droite, qui exprime bien que le mot saisi doit basculer dans l'espace réservé aux liens.

Les deux boutons seront déplacés et réduits pour tenir sur la même ligne que le TEdit, et donner un aspect à la fois simple et fonctionnel : voir ci-dessus.

L'introduction de signes spéciaux dans les boutons n'est pas simple.

Nous proposons la méthode suivante :

  1. Dans l'éditeur de source, placer le curseur en fin de ligne (n'importe laquelle) ;
  2. Dans le menu Lazarus, cliquer sur le mot Éditer, et choisir la dernière option : insérer depuis la table de caractères (Shift+Ctrl+M) ;
  3. Dans l'onglet Unicode, sélectionner la police Arrows ;
  4. Cliquer une fois sur la flèche choisie, par exemple la flèche à droite, qui porte le code UTF8 $E2$87$A8 ; flèche vers le haut code UTF8 $E2$87$AA ;
  5. Ce caractère est inséré dans l'éditeur de source : le couper puis le coller dans la propriété Caption du bouton…
  6. De même pour le second bouton (flèche vers le haut).

En fermant la table de caractères, vérifiez quand même que l'éditeur de source ne contienne pas de caractère parasite…

Image non disponible

Pour améliorer la présentation, nous avons ajusté quelques propriétés :

  • Color portée à $00E3FED8 pour Label et ListBox ;
  • BorderStyle portée à bsNone pour la ListBox ;
  • Font/Size portée à 24 pour les boutons ;
  • ShowHint portée à True pour les deux boutons ;
  • Hint renseignée à « vers Titre » pour l'un, « vers Liens » pour l'autre, de façon à informer l'utilisateur quand le curseur survolera l'un ou l'autre des composants.

Notre onglet, après compilation, se présente maintenant ainsi :

Image non disponible

Ancien bouton

Le libellé « Lier » de l'ancien bouton est remplacé maintenant par une flèche à droite.

Sa procédure OnClick est légèrement modifiée :

 
Sélectionnez
procedure TForm1.Button3Click(Sender: TObject);
var iLien, k : integer;
    motNouv : string;
begin
     if Edit3.Caption > #47 then
     begin
       motNouv := UTF8ToAnsi(Edit3.Caption);
       iLien := listeMots.IndexOf(motNouv);
       if iLien<0 then  iLien := fAnnonceMotNouveau(motNouv);
       if (iLien>=0) and  (iLien<>iMot) and not fDoublon(iMot, iLien) then
       begin
           Lier(iMot, iLien);
           Lier(iLien, iMot);
       end;
       AffLiens;
     end
     else ShowMessage('Entrez le mot');
     Edit3.Clear;
end; 

Vous notez pour commencer un premier contrôle sur le mot saisi : le premier caractère doit être un chiffre ou une lettre(31).

Si le mot est nouveau, la position future du mot est définie directement par la fonction fAnnonceMotNouveau(32), qui remplacera avec plus d'efficacité la procédure existante AnnonceMotNouveau :

 
Sélectionnez
function TForm1.fAnnonceMotNouveau(motNouv: string): integer;
var i, indexMotNouv  : integer;
    Rep : string;
begin
   if listeMots.IndexOf(motNouv)&lt;0 then
   begin
       indexMotNouv := fMotNouv(motNouv);
       Rep := 'Ajouter le mot '+ AnsiToUTF8(motNouv) +'&#160;? ';
       if Length(tabApprox)>0  then  //affichage des mots proches éventuels
       begin
         Rep := Rep +#13#10 + 'Mots existants : ';
         For i:=0 to Length(tabApprox) - 1 do
           Rep := Rep + ANSIToUTF8(listeMots[tabApprox[i]])+' /';
       end;
       if MessageDlg ('Mot nouveau', Rep, mtConfirmation,
                        [mbYes, mbNo],0) = mrYes
       then
       begin
         AjoutMot(motNouv, indexMotNouv);
         fAnnonceMotNouveau := indexMotNouv;
       end
       else fAnnonceMotNouveau := -1;
   end;
end;

La création du lien est maintenant précédée de deux contrôles supplémentaires :

  • le lien ne doit pas boucler un mot sur lui-même ;
  • le lien ne peut être ajouté s'il existe déjà.

Ce deuxième contrôle est réalisé par la fonction fDoublon :

 
Sélectionnez
function TForm1.fDoublon(iMot, iLien: integer): boolean;
var i, j : integer;
begin
  //vérifie que le lien n'existe pas déjà
  //cherche le tableau de liens correspondant à iMot
  fDoublon := False;
  j := chercheTab(iMot);
  if j>=0 then
  begin
    i := Length(Liens[j])-1;
    while (i>0) and (iLien&lt;Liens[j, i]) do dec(i);
    if iLien = Liens[j, i] then fDoublon := True;
    if fDoublon then ShowMessage('Doublon refusé');
  end;
end;

Remarquez que la liste des liens est triée : il est inutile de la parcourir dans sa totalité.

La suppression de la procédure AnnonceMotNouveau conduit à remanier les opérations déclenchées par un clic sur le bouton Ajouter de l'onglet Mots :

 
Sélectionnez
procedure TForm1.Button7Click(Sender: TObject);
var i  : integer;
    motNouv : string;
begin
   motNouv := UTF8ToAnsi(Edit4.Caption);
   i := listeMots.IndexOf(motNouv);
   if (i >= 0) then ShowMessage('Mot existant')
   else
   begin
     i := fAnnonceMotNouveau(motNouv);
     if i>=0 then iMot :=  i;
     Edit4.Clear;
   end;
end;

De cette façon, les filtrages de sécurité s'appliqueront aussi quand l'utilisateur passera par cet onglet.

Nouveau bouton

Le nouveau bouton, dont le libellé (propriété Caption) est une flèche vers le haut, a pour fonction de remplacer le mot titre par le mot qui vient d'être saisi. Après filtrage, deux cas de figure se présentent : soit c'est un mot nouveau, soit c'est un mot existant. Cliquez deux fois sur le nouveau bouton et, dans la procédure OnClick qui est ainsi créée, nous complétons le code comme suit :

 
Sélectionnez
procedure TForm1.Button10Click(Sender: TObject);
var iLien : integer;
    motNouv : string;
begin
     if Edit3.Caption > #47 then
     begin
       motNouv := UTF8ToAnsi(Edit3.Caption);
       iLien := listeMots.IndexOf(motNouv);
       if iLien<0 then  iLien := fAnnonceMotNouveau(motNouv);
       if (iLien>=0) and  (iLien<>iMot) and not fDoublon(iMot, iLien) then
       begin
           Label4.Caption:= Edit3.Caption;
           iMot := iLien;
       end;
       AffLiens;
     end
     else ShowMessage('Entrez le mot');
     Edit3.Clear;
end;

Un clic sur le petit triangle vert de Lazarus, pour lancer l'exécution. Testez avec un mot nouveau, liez un mot nouveau… Notre moteur est maintenant bien rôdé et son interface plus simple.

Après avoir vérifié que tout se passe bien, vous pouvez nettoyer le code en éliminant la procédure AnnonceMotNouveau, devenue inutile(33).

Recherche

Chercher un mot peut s'envisager de deux façons élémentaires :

  • à l'aide d'un masque, on précise le nombre de lettres et les lettres connues avec leur position ;
  • dans une fenêtre, on indique le ou les mots apparentés au mot cherché et le programme doit indiquer la ou les solutions les plus logiques.

Nous avons déjà un onglet Recherche : il a eu son rôle au début de notre projet, mais semble nettement obsolète.

Pour orienter l'utilisateur, nous adopterons maintenant deux onglets :

  • un onglet Masque, qui remplacera l'onglet Recherche existant ;
  • un onglet Logique, dans lequel seront lancées les opérations de tri sur les liens.

Par ailleurs, revenons à notre bouton Arrêt qui provoque l'enregistrement des données au moment où on quitte le logiciel. Nous créons un onglet supplémentaire, appelé Fichiers, qui recevra ce bouton, et sera disponible pour des fonctions annexes.

Onglets

Pour accéder aux fonctions d'édition des onglets de notre interface graphique, nous effectuons un clic droit sur la ligne en grisé qui affiche les onglets existants. Le menu contextuel donne le choix entre six fonctions de page : ajouter, insérer, supprimer, déplacer (à droite ou à gauche) et afficher.

  1. Commençons par la fonction Ajouter : un nouvel onglet est créé en dernière position et nous le renommons (dans l'onglet propriétés/caption de l'inspecteur d'objets) en Fichier.
  2. Dans l'onglet Recherche, nous coupons le bouton Arrêt et nous le copions dans l'onglet Fichier. Nous renommons l'onglet Recherche en Masque.
  3. Nouveau clic droit dans la ligne supérieure, et cette fois nous sélectionnons la fonction Insérer : un nouvel onglet est créé et nous le renommons Logique ; nous le déplaçons pour qu'il soit en seconde position (TabIndex porté à 1).
  4. Nous pouvons supprimer l'onglet Info, devenu inutile. D'abord, enlevons tous les composants, un par un. Ensuite, supprimons les procédures Button4Click et Button5Click attachées aux boutons, ainsi que leurs déclarations (avant Implémentation). Dans la procédure MAJBalayage, nous supprimons également la ligne qui fait référence à Label3.Caption. L'onglet est maintenant propre, et nous pouvons le supprimer sans problème.
  5. Les boutons qui restent en haut et à droite de notre interface graphique peuvent provoquer des résultats inattendus, et il est donc préférable de les supprimer. Pour cela, nous sélectionnons, dans les propriétés de Form1 la ligne BorderIcons et portons les propriétés à False :

Image non disponible

Pour quitter le programme, il faudra passer par l'onglet Fichier et cliquer sur le bouton Arrêt pour assurer l'enregistrement des saisies.

Dans le présent chapitre, nous reconstruirons l'onglet Masque. La recherche logique, plus complexe, sera traitée dans le chapitre suivant.

Masque

Nous allons aborder successivement le principe de la saisie, sa mise en œuvre, et le traitement des cas particuliers.

Principe

Dans une grille de mots croisés, nous disposons du nombre de cases occupées par le mot et, éventuellement, d'une ou plusieurs lettres. Pour saisir ces données, nous allons donc entrer ces lettres connues, séparées par autant de signes « $ » que de cases vides. Par exemple, une entrée « a$b$e » indiquera une recherche d'un mot de cinq lettres, dont la première lettre est un a, la troisième un b, etc.

Interface graphique

Dans l'onglet Masque, nous consacrerons le composant TEdit à la saisie du masque, le Label à l'affichage du nombre de lettres, la ListBox à la présentation des résultats.

Les composants UpDown et Memo peuvent être supprimés, mais il faudra aussi supprimer la procédure UpDown1Click et sa déclaration.

Les procédures FormCreate et ListBox3Click doivent, pour leur part, être modifiées pour leurs références à Memo1 et Label1 :

 
Sélectionnez
procedure TForm1.FormCreate(Sender: TObject);
begin
  listeMots := TStringList.Create;
  listeMots.CaseSensitive:=True;
  LireFichier(listeMots);
  nMots := listeMots.Count;
  lireLiens;
  iMot := 0;
  Edit3.Clear;
  Edit2.Clear;
  Label1.Caption := 'saisir les lettres séparées par le signe $';
  MAJBalayage;
  cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
//regroupe tous les caractères à remplacer
  sAcc := 'aaaeeeeiiouuuyc';
//regroupe tous les caractères de substitution
end; 

procedure TForm1.ListBox3Click(Sender: TObject);
begin
 if ListBox3.ItemIndex>=0 then
 begin
  iMot := tabApprox[ListBox3.ItemIndex];
  Edit2.Clear;
  ListBox3.Clear;
  MAJBalayage;
 end;
end; 

Enfin, la procédure MAJAffichage peut être complètement supprimée(34).

Côté interface graphique, l'onglet Masque est nettement épuré :

Image non disponible

Code

Un clic va déclencher la recherche qui sera réalisée par la procédure Masque. La procédure onClick du bouton doit être remaniée(35) :

 
Sélectionnez
procedure TForm1.Button2Click(Sender: TObject);
begin
   //Recherche(UTF8ToAnsi(Edit2.Caption));
   Masque(SansAccent(UTF8ToAnsi(Edit2.Caption)));
end;

La recherche commence par noter la longueur du mot, puis balaye les lettres une par une. En cas de divergence avec le mot saisi, le mot en cours est abandonné. Si la recherche est positive, le mot est affiché dans la listbox.

 
Sélectionnez
procedure TForm1.Masque(rechMot: string);
var i, j, k : integer;
    motCour : string;
begin
  i := 0;
  k := Length(rechMot);
  Label1.Caption:= ('Mot de ' + IntToStr(k)+ ' lettres' );

  repeat
    motCour := SansAccent(listeMots[i]);
    if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
    begin
      j := 1;

      while (j<k) and ((rechMot[j]='$') or (rechMot[j] = motCour[j])) do inc(j);
      if j=k  then ListBox3.Items.Append(AnsiToUTF8(listeMots[i]));
    end;
    inc(i);
  until (i=nMots) or ((rechMot[1]='$') and (rechMot[1] > motCour[1]));
  //balayage tant que la première lettre est inférieure à celle du masque
end;

Faisons un essai avec le masque « a$b$e ».

Nous trouvons cinq occurrences pouvant convenir à une grille de mots croisés :

Image non disponible

Déjà, on peut apprécier la différence avec une recherche sur un dictionnaire habituel !

Que se passe-t-il si l'utilisateur clique sur l'un des mots présentés ? Il convient de modifier la procédure onClick de ListBox3 :

 
Sélectionnez
procedure TForm1.ListBox3Click(Sender: TObject);
begin
 if ListBox3.ItemIndex>=0 then
 begin
  iMot := listeMots.IndexOf(ListBox3.Items[ListBox3.ItemIndex]);
  Label1.Caption:= listeMots[iMot];
 end;
end;

Un clic fait apparaître le mot sélectionné en titre, et l'interface se met à jour.

Conclusion

Notre liste de mots trouve maintenant une flexibilité appréciable : les définitions de mots croisés peuvent être enregistrées aisément, et les recherches sont facilitées par la mise en place d'un masque.

Mais est-il possible d'exploiter la logique ou l'humour de ces définitions ? C'est ce que nous tenterons de faire dans le prochain chapitre.

Outre la logique, il nous reste à unifier les fichiers mots/liens, à améliorer l'ergonomie, à enrichir nos sources de mots et de définitions…

Et tant d'autres thèmes que nos lecteurs vont peut-être réclamer…

Beaucoup de divorces sont nés d'un malentendu.
Beaucoup de mariages aussi. »
Tristan Bernard

Le codeTéléchargez le code complet… L'unité uLex9 se présente maintenant comme suit :

 
Sélectionnez
unit ulex9;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls,
  Graphics, Dialogs, StdCtrls, ComCtrls, uDisque;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button10: TButton;
    Button2: TButton;
    Button3: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    CheckBox1: TCheckBox;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    ListBox4: TListBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    TabSheet7: TTabSheet;
    Zoom: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    AffListe: TListBox;
    PageControl1: TPageControl;
    Page1: TTabSheet;
    TabSheet1: TTabSheet;
    TrackBar1: TTrackBar;
    UpDown2: TUpDown;
    procedure AffListeClick(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure CheckBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure ListBox3Click(Sender: TObject);
    procedure ListBox4Click(Sender: TObject);
    procedure Recherche(rechMot: string);
    procedure TabSheet1Show(Sender: TObject);
    procedure TabSheet3Show(Sender: TObject);
    procedure TabSheet4Show(Sender: TObject);
    procedure TabSheet5Show(Sender: TObject);
    procedure TrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    //procedure MAJAffichage;
    procedure MAJBalayage;
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
    procedure ZoomMouseLeave(Sender: TObject);
    procedure MAJInfo;
    function chercheTab(iMot : integer) : integer;
    procedure Lier(iMot, iLien : integer);
    procedure AffLiens;
    //function TriSec(k : integer) : boolean;
    //function TriPPal : boolean;
    procedure PlaceLien(k : integer);
    function PlaceTab(k : integer) : integer;
    function SansAccent(rMot : string) : string;
    procedure listeApprox(rechMot : string);
    procedure MAJSupp;
    procedure SuppLien(iMot, iLien : integer);
    function fMotNouv(rechMot : string) : integer;
    function fAnnonceMotNouveau(motNouv : string) : integer;
    procedure AjoutMot(motNouv : string; indexMotNouv : integer);
    procedure AjoutMotSecur(motNouv : string ; indexMotNouv : integer);
    procedure SupMot(motCour : string; indexMotCour : integer);
    function fDoublon(iMot, iLien: integer): boolean;
    procedure Masque(rechMot: string);

  private
    { private declarations }
  public
    { public declarations }
  end;

const delta=5;

var
  Form1: TForm1;
  listeMots, listeInfo : TstringList;
  iMot, nMots, nLiens, iLien : integer;
  AffListe : TListBox;
  Liens : Array of Array of integer;
  tabApprox : Array of integer;  //index des mots approchants
  sAcc, cAcc : string;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
 regLiens;
 regFichier(listeMots);
 listeMots.Free;
 Application.Terminate;
end;

procedure TForm1.AffListeClick(Sender: TObject);
begin
   iMot := (iMot -delta + AffListe.ItemIndex + nMots) mod nMots;
   MAJBalayage;
end;

procedure TForm1.Button10Click(Sender: TObject);
var iLien : integer;
    motNouv : string;
begin
     if Edit3.Caption > #47 then
     begin
       motNouv := UTF8ToAnsi(Edit3.Caption);
       iLien := listeMots.IndexOf(motNouv);
       if iLien<0 then  iLien := fAnnonceMotNouveau(motNouv);
       if (iLien>=0) and  (iLien<>iMot) and not fDoublon(iMot, iLien) then
       begin
           Label4.Caption:= Edit3.Caption;
           iMot := iLien;
       end;
       AffLiens;
     end
     else ShowMessage('Entrez le mot');
     Edit3.Clear;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   //Recherche(UTF8ToAnsi(Edit2.Caption));
   ListBox3.Clear;
   Masque(SansAccent(UTF8ToAnsi(Edit2.Caption)));
end;




function TForm1.fMotNouv(rechMot: string): integer;
var i, k : integer;
    referMot : string;
begin
      SetLength(tabApprox, 0);   //mise à zéro du tableau
      referMot := SansAccent(rechMot);
      //point de démarrage de la recherche : première lettre du mot
      i := 0;
      k := 0;
      while SansAccent(listeMots[i][1]) < referMot[1] do inc(i);
      //début de la recherche
      repeat
        //k index futur du mot nouveau
        if (k=0) and (SansAccent(listeMots[i]) > referMot) then  k := i
        else if SansAccent(listeMots[i]) = referMot then
        begin
           //enregistrement des index pour réutilisation
           SetLength(tabApprox, Length(tabApprox)+1);
           tabApprox[Length(tabApprox)-1] := i;
        end;
        inc(i)
      until (i>nMots-1) or (SansAccent(listeMots[i][1]) > referMot[1]);
      if k=0 then fMotNouv := nMots else fMotNouv := k;
end;

//==========================
function TForm1.fAnnonceMotNouveau(motNouv: string): integer;
 var i, indexMotNouv  : integer;
     Rep : string;
 begin
    if listeMots.IndexOf(motNouv)<0 then
    begin
        indexMotNouv := fMotNouv(motNouv);
        Rep := 'Ajouter le mot '+ AnsiToUTF8(motNouv) +'&#160;? ';
        if Length(tabApprox)>0  then  //affichage des mots proches éventuels
        begin
          Rep := Rep +#13#10 + 'Mots existants : ';
          For i:=0 to Length(tabApprox) - 1 do
            Rep := Rep + ANSIToUTF8(listeMots[tabApprox[i]])+' /';
        end;
        if MessageDlg ('Mot nouveau', Rep, mtConfirmation,
                         [mbYes, mbNo],0) = mrYes
        then
        begin
          AjoutMot(motNouv, indexMotNouv);
          fAnnonceMotNouveau := indexMotNouv;
        end
        else fAnnonceMotNouveau := -1;
    end;
 end;

procedure TForm1.AjoutMot(motNouv: string; indexMotNouv: integer);
var   nouvLiens : array of array of integer;
      i, j : integer;
begin
   nouvLiens := Liens;
   for i:=0 to Length(Liens)-1 do
     for j:=0 to Length(Liens[i])-1 do
       if Liens[i, j] >= indexMotNouv then inc(Liens[i, j]);
   if iMot >= indexMotNouv then inc(iMot);                     //mise à jour effectuée
   SetLength(nouvLiens, 0);
   listeMots.Insert(indexMotNouv, motNouv); //modification de la liste principale
   inc(nMots);
end;
//===========doublons=======================
function TForm1.fDoublon(iMot, iLien: integer): boolean;
var i, j : integer;
begin
  //vérifie que le lien n'existe pas déjà
  //cherche le tableau de liens correspondant à iMot
  fDoublon := False;
  j := chercheTab(iMot);
  if j>=0 then
  begin
    i := Length(Liens[j])-1;
    while (i>0) and (iLien<Liens[j, i]) do dec(i);
    if iLien = Liens[j, i] then fDoublon := True;
    if fDoublon then ShowMessage('Doublon refusé');
  end;
end;

procedure TForm1.Masque(rechMot: string);
var i, j, k : integer;
    motCour : string;
begin
  i := 0;
  k := Length(rechMot);
  Label1.Caption:= ('Mot de ' + IntToStr(k)+ ' lettres' );
  ListBox3.Clear;
  repeat
    motCour := SansAccent(listeMots[i]);
    if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
    begin
      j := 1;

      while (j<=k) and ((rechMot[j]='$') or (rechMot[j] = motCour[j])) do inc(j);
      if j>k  then ListBox3.Items.Append(AnsiToUTF8(listeMots[i]));
    end;
    inc(i);
  until (i=nMots) or ((rechMot[1]='$') and (rechMot[1] > motCour[1]));
  //balayage tant que la première lettre est inférieure à celle du masque
  if ListBox3.Count=0 then Label1.Caption:= ('échec')
                      else Label1.Caption:= (IntToStr(ListBox3.Count)+
                                             ' mots trouvés');
end;


procedure TForm1.AjoutMotSecur(motNouv: string; indexMotNouv: integer);
var  nouvLiens : array of array of integer;
      i, j : integer;
begin
   SetLength(nouvLiens, Length(Liens));
   for i:=0 to Length(Liens)-1 do
     begin
       SetLength(nouvLiens[i], Length(Liens[i]));
       for j:=0 to Length(Liens[i])-1 do
         if Liens[i, j] >= indexMotNouv then nouvLiens[i, j] := Liens[i, j] + 1
         else nouvLiens[i, j] := Liens[i, j];
     end;
   Liens := nouvLiens;   //mise à jour effectuée
   //SetLength(nouvLiens, 0);  //suppression de l'objet en mémoire
   if iMot >= indexMotNouv then inc(iMot);
   listeMots.Insert(indexMotNouv, motNouv); //modification de la liste principale
   inc(nMots);
end;

//==============================

procedure TForm1.SupMot(motCour: string; indexMotCour: integer);
var  nouvLiens : array of array of integer;
     i, j : integer;
begin
   SetLength(nouvLiens, Length(Liens));
   for i:=0 to Length(nouvLiens)-1 do
     begin
       SetLength(nouvLiens[i], Length(Liens[i]));
       for j:=0 to Length(nouvLiens[i])-1 do
         if Liens[i, j] >= indexMotCour then nouvLiens[i, j] := Liens[i, j] - 1
         else  nouvLiens[i, j] := Liens[i, j];
     end;
   if iMot >= indexMotCour then dec(iMot);
   Liens := nouvLiens;
   //mise à jour effectuée
   listeMots.Delete(indexMotCour);        //modification de la liste principale
   dec(nMots);
end;


procedure TForm1.Button3Click(Sender: TObject);
var iLien, k : integer;
    motNouv : string;
begin
     if Edit3.Caption > #47 then
     begin
       motNouv := UTF8ToAnsi(Edit3.Caption);
       iLien := listeMots.IndexOf(motNouv);
       if iLien<0 then  iLien := fAnnonceMotNouveau(motNouv);
       if (iLien>=0) and  (iLien<>iMot) and not fDoublon(iMot, iLien) then
       begin
           Lier(iMot, iLien);
           Lier(iLien, iMot);
       end;
       AffLiens;
     end
     else ShowMessage('Entrez le mot');
     Edit3.Clear;
end;




procedure TForm1.Button6Click(Sender: TObject);
begin
  SuppLien(iMot, iLien);
  SuppLien(iLien, iMot);
end;

//=================
procedure TForm1.Button7Click(Sender: TObject);
var i  : integer;
    motNouv : string;
begin
   motNouv := UTF8ToAnsi(Edit4.Caption);
   i := listeMots.IndexOf(motNouv);
   if (i >= 0) then ShowMessage('Mot existant')
   else
   begin
     i := fAnnonceMotNouveau(motNouv);
     if i>=0 then iMot :=  i;
     Edit4.Clear;
   end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var indexMotCour  : integer;
    motCour, Rep : string;
begin
//le mot peut être supprimé si aucun lien ne lui est affecté
     motCour := UTF8ToAnsi(Edit4.Caption);
     indexMotCour := listeMots.IndexOf(motCour);
     if (indexMotCour<0) then ShowMessage ('Supprimé')
     else if (chercheTab(indexMotCour)<0) then
     begin
       Rep := 'Supprimer le mot '+ Edit4.Caption +' ? ';
       if MessageDlg ('Suppression', Rep, mtConfirmation,
                        [mbYes, mbNo],0) = mrYes
       then SupMot(motCour, indexMotCour);
       MAJBalayage;
       Edit4.Clear;
     end
     else ShowMessage ('Supprimez les liens avant de supprimer le mot');
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  ShowMessage('Supprimez le mot, puis ajoutez le nouveau mot');
end;


procedure TForm1.CheckBox1Change(Sender: TObject);
begin
  if CheckBox1.Checked then CheckBox1.Caption := 'Avec filtre'
  else CheckBox1.Caption := 'Sans filtre';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  listeMots := TStringList.Create;
  listeMots.CaseSensitive:=True;
  LireFichier(listeMots);
  nMots := listeMots.Count;
  lireLiens;
  iMot := 0;
  Edit3.Clear;
  Edit2.Clear;
  Label1.Caption := 'saisir les lettres séparées par le signe $';
  MAJBalayage;
  cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
//regroupe tous les caractères à remplacer
  sAcc := 'aaaeeeeiiouuuyc';
//regroupe tous les caractères de substitution
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
 If ListBox1.ItemIndex >= 0 then
 begin
   iMot := Liens[chercheTab(iMot), ListBox1.ItemIndex+1];
   Label4.Caption := AnsiToUTF8(listeMots[iMot]);
   AffLiens;
 end;
end;

procedure TForm1.ListBox2Click(Sender: TObject); //couleur $00C1FFDC
begin
 If ListBox2.ItemIndex >= 0 then
 begin
   iMot := Liens[chercheTab(iMot), ListBox2.ItemIndex+1];
   MAJBalayage;
 end;
end;

procedure TForm1.ListBox3Click(Sender: TObject);
begin
 if ListBox3.ItemIndex>=0 then
 begin
  iMot := listeMots.IndexOf(ListBox3.Items[ListBox3.ItemIndex]);
  Label1.Caption:= listeMots[iMot];
 end;
end; 

procedure TForm1.ListBox4Click(Sender: TObject);
begin
  if ListBox4.ItemIndex >= 0 then
  begin
    iLien := Liens[chercheTab(iMot), ListBox4.ItemIndex+1];
    Label6.Caption:= 'Supprimer le lien entre '+
                      AnsiToUTF8(listeMots[iMot]) +  ' et '+
                      AnsiToUTF8(listeMots[iLien])+ ' ?';
    Button6.Enabled := True;
  end;
end;

procedure TForm1.MAJBalayage;
var i : integer;
begin
   Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
   Label4.Caption:=Label2.Caption;
   TrackBar1.Position:= Round(iMot*1000/nMots);
   Edit2.Clear;
   AffListe.Clear;
   for i := 0 to 10 do
       AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-5 + i + nMots) mod nMots]));
   AffListe.Selected[5] := True;
   AffLiens;
   Caption := 'Lex9 '+IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens) + ' liés';
   MAJSupp;
end;


procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
   if CheckBox1.Checked then
   repeat
     inc(iMot);
   until (chercheTab(iMot)>=0) or (iMot=nMots)
   else
     if Button=btNext then Inc(iMot, UpDown2.Increment)
                      else Dec(iMot, UpDown2.Increment);
   iMot := (iMot + nMots) mod  (nMots);
   MAJBalayage;
end;

procedure TForm1.ZoomMouseLeave(Sender: TObject);
begin
   if RadioButton1.Checked then UpDown2.Increment := 1
   else if RadioButton2.Checked then UpDown2.Increment := 10
   else if RadioButton3.Checked then UpDown2.Increment := 100
   else if RadioButton4.Checked then UpDown2.Increment := 1000;
end;

procedure TForm1.MAJInfo;
begin

end;

function TForm1.chercheTab(iMot: integer): integer;
var i : integer;
begin
 chercheTab := -1;
 i := 0;
 while (i<Length(Liens)) and (Liens[i, 0]<>iMot)do inc(i);
 if i<Length(Liens) then chercheTab := i;
end;

procedure TForm1.Lier(iMot, iLien: integer);
var k : integer;
begin
  k := chercheTab(iMot);
  if k < 0 then
  begin
     SetLength(Liens, Length(Liens)+1); //extension du tableau principal
     k := Length(Liens)-1;
     SetLength(Liens[k], 1);
     Liens[k][0] := iMot; //identifiant
     k := PlaceTab(k);    //nouvel emplacement
     Inc(nLiens); //mise à jour du nombre de mots liés
  end;
  SetLength(Liens[k], Length(Liens[k])+1);  //extension du tableau secondaire
  Liens[k, Length(Liens[k])-1] := iLien;  // lien
  PlaceLien(k);                           //tri
end;

procedure TForm1.AffLiens;
var i, k : integer;
begin
 if Length(Liens)>0 then
 begin
   ListBox1.Clear;
   k := chercheTab(iMot);
   if k>=0 then
     for i :=1 to Length(Liens[k]) -1 do
       ListBox1.Items.Add(AnsiToUTF8(listeMots[Liens[k, i]]));
   ListBox2.Items := ListBox1.Items;
 end;
end;

procedure TForm1.PlaceLien(k: integer);
var i, Tamp : integer;
begin
 i := Length(Liens[k]) - 1;
 while (Liens[k, i] < Liens[k, i-1]) and (i>1)  do
 begin
      Tamp :=  Liens[k, i];
      Liens[k, i] := Liens[k, i-1];
      Liens[k, i-1] := Tamp;
      Dec(i);
 end;
end;

function TForm1.PlaceTab(k: integer): integer;
var i : integer;
    Tamp : Array of integer;
begin
 i := k;
 while (Liens[i, 0] < Liens[i-1, 0]) and (i>1)  do
    begin
      Tamp :=  Liens[i];
      Liens[i] := Liens[i-1];
      Liens[i-1] := Tamp;
      dec(i);
    end;
 PlaceTab := i;
end;

function TForm1.SansAccent(rMot: string): string;
var i, j : integer;
//les variables sAcc et cAcc sont créées au démarrage
begin
 SansAccent := '';
 rMot := LowerCase(rMot);
 for i:=1 to Length(rMot) do
   begin
     j := Pos(rMot[i], cAcc);
     case j of
       0     : SansAccent := SansAccent + rMot[i];
       1..15 : SansAccent := SansAccent + sAcc[j];
     end;
   end;
end;

procedure TForm1.listeApprox(rechMot: string);
var i, k : integer;
    referMot, testMot : string;
    begin
     SetLength(tabApprox, 0);   //mise à zéro du tableau
     referMot := SansAccent(rechMot);
     if referMot>'' then
     begin
        //point de démarrage de la recherche : première lettre du mot
        i := 0;
        while SansAccent(listeMots[i][1]) < referMot[1] do inc(i);
        //début de la recherche
        repeat
          if SansAccent(listeMots[i]) = referMot then
          begin
             listBox3.Items.Append(AnsiToUTF8(listeMots[i]));
             //enregistrement des index pour réutilisation
             SetLength(tabApprox, Length(tabApprox)+1);
             tabApprox[Length(tabApprox)-1] := i;
          end;
          inc(i)
        until (i>nMots-1) or (SansAccent(listeMots[i][1]) > referMot[1]);
        //la première lettre a changé
    end;
end;
procedure TForm1.MAJSupp;
begin
  Label5.Caption := Label4.Caption;
  ListBox4.Items := ListBox1.Items;
  Label6.Caption:= '';
  Button6.Enabled:= False;
end;

procedure TForm1.SuppLien(iMot, iLien: integer);
var i, k : integer;
begin
//dans le tableau secondaire de iMot, on supprime iLien
  k := chercheTab(iMot);
  i:=1;
  while Liens[k, i]<> iLien do inc(i);
  while (i<Length(Liens[k])-1) do
  begin
     Liens[k, i] :=  Liens[k, i+1];
     inc(i);
  end;
  SetLength(Liens[k], Length(Liens[k]) - 1);
  if (Length(Liens[k]) = 1) then  //le mot n'a plus de lien
  begin
     for i := k to Length(Liens)-2 do
         Liens[i] := Liens[i+1];
     SetLength(Liens, Length(Liens)-1);
     nLiens := Length(Liens);
  end;
  MAJBalayage;
end;


procedure TForm1.TrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   iMot := Round(TrackBar1.Position*nMots/1000);
   iMot := (iMot + nMots) mod  nMots;
   MAJBalayage;
end;


procedure TForm1.Recherche(rechMot: string);
var irechMot : integer;
begin
 listBox3.Clear;
 irechMot := listeMots.IndexOf(rechMot);
 if irechMot >= 0 then
  begin
    Label1.Caption:= AnsiToUTF8(listeMots[irechMot]);
    iMot := irechMot;
    MAJBalayage;
  end
  else
  begin
    Label1.Caption:= 'échec';
    listeApprox(rechMot);
  end;
end;

procedure TForm1.TabSheet1Show(Sender: TObject);
begin
  MAJBalayage;
end;

procedure TForm1.TabSheet3Show(Sender: TObject);
begin
  MAJBalayage;
end;

procedure TForm1.TabSheet4Show(Sender: TObject);
begin
  MAJSupp;
end;

procedure TForm1.TabSheet5Show(Sender: TObject);
begin
   Edit4.Caption := AnsiToUTF8(listeMots[iMot]);
end;

end.

Et l'unité uDisque :

 
Sélectionnez
unit uDisque;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Dialogs;

procedure LireFichier(listeMots : TStringList);
procedure regLiens;
procedure lireLiens;
procedure regFichier(listeMots : TStringList);

implementation

uses ulex8;

procedure LireFichier(listeMots: TStringList);
begin
  //listeMots.LoadFromFile('liste.de.mots.francais.frgut.txt');
  listeMots.LoadFromFile('liMots.txt');
end;

procedure regLiens;
var i, j, k : integer;
    fLiens : file of integer;

begin
  AssignFile(fLiens, 'fichLiens.bin');
  {$I-}
  Reset(fLiens);
  {$I+}
  ReWrite(fLiens, 1);
  for i := 0 to Length(Liens)-1 do
  begin
    j := Length(Liens[i]);
    Write(fLiens, j);
    for k:=0 to j-1 do
      Write(fLiens, Liens[i, k]);
  end;
  CloseFile(fLiens);
end;



procedure lireLiens;
var
  j, m : integer;
  fLiens : file of integer;
begin
  nLiens := 0;   //nombre de mots liés
  AssignFile(fLiens, 'fichLiens.bin');
  {$I-}
  Reset(fLiens);
  {$I+}
  if IOResult<>0 then
    ShowMessage('Fichier liens inexistant')
  else
  while not EOF(fLiens) do
  begin
    SetLength(Liens, nLiens+1);      //taille du tableau principal
    Read(fLiens, m);
    SetLength(Liens[nLiens], m);     //taille du tableau secondaire
    for j := 0 to m-1 do
      Read(fLiens, Liens[nLiens, j]); //remplissage du tableau secondaire
    inc(nLiens);                      //nombre de mots liés
  end;
  CloseFile(fLiens);
end;

procedure regFichier(listeMots: TStringList);
begin
   listeMots.SaveToFile('liMots.txt');
end;


end.

précédentsommairesuivant
Le passage à la version 1.0.12 se signale ici par quelques modifications dans l'aspect des fenêtres.
Ces chiffres sont susceptibles de varier selon les saisies effectuées par chacun.
Un filtrage plus strict pourra être envisagé.
La création de fonction a déjà fait l'objet de plusieurs présentations.
Dans l'éditeur de source, effacer le texte de la procédure et supprimer sa déclaration.
Code et déclaration.
Le filtre transforme la saisie en éliminant majuscules, accents et caractères spéciaux tels que espace, apostrophe ou tiret.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2014 dimanche2003. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.