IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

GENÈSE D'UN DICTIONNAIRE

Construction d'un lexique interactif avec Lazarus


précédentsommairesuivant

Ajouter un mot

Introduction

Nous sommes maintenant capables d'enrichir notre liste de mots en établissant des liens internes.

Mais la liste reste inchangée.

En effet, un ajout erroné remettrait en cause la fiabilité de nos données.

Et il y a plus inquiétant : nous avons construit les liens en utilisant le numéro implicite (position) de chaque mot : si ce numéro devient variable, tous nos liens sont compromis…

Voyons comment résoudre ces difficultés.

Environnement

Nous allons créer un nouveau répertoire de travail, compléter les variables globales et modifier l'interface graphique avant d'aborder le code proprement dit.

Répertoires

Chapitre 8…

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

  • ouvrir pLex7.lpi dans Lex8 avec Lazarus ;
  • enregistrer uLex7.pas sous le nom de uLex8.pas ;
  • accepter la suppression des références à uLex7.pas ;
  • enregistrer pLex7.pas sous le nom de pLex8.pas ;
  • renommer la fenêtre Lex7 en Lex8 ;
  • dans les procédures MAJBalayage et Lier, remplacer Lex7 par Lex8 ;
  • dans le répertoire Lex8 supprimer les anciens fichiers contenant la mention Lex7.

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 Lex7.

Variables et constantes

Nous avons vu que le traitement des accents et caractères spéciaux passait par l'utilisation de deux chaînes de caractères dont l'affectation devait être répétée à chaque recherche, c'est-à-dire fréquemment.

Pour éviter ces répétitions, nous créons deux variables globales, sans accent (sAcc) et avec accent (cAcc) qui regrouperont les caractères accentués et les caractères de remplacement :

 
Sélectionnez
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;

et nous fixons leur valeur définitive dans la procédure FormCreate :

 
Sélectionnez
procedure TForm1.FormCreate(Sender: TObject);
begin
  listeMots := TStringList.Create;
  listeMots.CaseSensitive:=True;
  LireFichier(listeMots);
  nMots := listeMots.Count;
  Memo1.Append('Premier mot : '+listeMots[0]);
  Memo1.Append('Dernier mot : '+listeMots[nMots-1]);
  lireLiens;
  iMot := 0;
  Edit3.Clear;
  MAJAffichage;
  MAJBalayage;
  cAcc := UTF8ToAnsi('àâäéèêëïîôùûüÿç-'' ');
//regroupe tous les caractères à remplacer
  sAcc := 'aaaeeeeiiouuuyc';
//regroupe tous les caractères de substitution
end;

Ces affectations sont maintenant lancées une seule fois, au démarrage du programme.

Évidemment, la création de constantes globales aurait simplifié la manipulation. Mais l'utilisation de chaînes ANSI complique un peu leur mise en œuvre.

La fonction SansAccent peut maintenant être sensiblement élaguée et donc accélérée :

 
Sélectionnez
function TForm1.SansAccent(rMot: string): string;
var i, j : integer;
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;

Lancez l'exécution pour vérifier que tout est correct, corrigez si nécessaire.

Onglets

L'onglet Édition est consacré au traitement des liens : nous le renommons précisément Liens, et nous créons un nouvel onglet tout simplement titré Mots : il nous servira pour les modifications de la liste principale.

Les interventions sur les onglets ont fait l'objet de présentations détaillées dans les chapitres précédents.

Dans la nouvelle page, nous plaçons un TEdit et trois boutons que nous renommons respectivement en Ajouter, Supprimer et Modifier :

Image non disponible Image non disponible

Pour synchroniser la zone de saisie avec le balayage de la liste, nous activons l'onglet Événements de la page, et à la ligne OnShow, nous cliquons sur les trois points pour créer la procédure TabSheet5Show qui peut s'écrire ainsi :

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

L'accès à l'onglet Événements de la page active peut se révéler compliqué. Il suffit pour cela de cliquer sur un composant de la page, par exemple un bouton. L'Inspecteur d'objets présente les propriétés de ce composant. Dans l'arborescence présentée au-dessus des propriétés, repérez le nom de la page concernée, par exemple TabSheet5:TTabSheet. Cliquez sur ce nom, puis sur l'onglet Événements : la ligne OnShow apparaît dans la liste.

Pour mettre à jour les onglets Balayage, Liens et Suppression lorsqu'ils deviennent actifs, nous créons les procédures TabSheet1Show, TabSheet3Show et TabSheet4Show :

 
Sélectionnez
procedure TForm1.TabSheet1Show(Sender: TObject);
begin
  MAJBalayage;
end;
 
procedure TForm1.TabSheet3Show(Sender: TObject);
begin
  MAJBalayage;
end;
 
procedure TForm1.TabSheet4Show(Sender: TObject);
begin
  MAJSupp;
end;

Lorsque l'utilisateur passera d'un onglet à un autre, il sera assuré de rester en phase avec l'action qu'il aura terminée précédemment.

Fichier de mots

Nous avons soigneusement conservé jusqu'à présent le fichier d'origine ; s'il devient modifiable, il faut prévoir son enregistrement.

L'homologue de la fonction de haut niveau LoadFromFile est tout simplement SaveToFile.

Dans l'unité uDisque, nous ajoutons, avant implémentation, la ligne regFichier :

 
Sélectionnez
interface
 
uses
  Classes, SysUtils, Dialogs;
 
procedure LireFichier(listeMots : TStringList);
procedure regLiens;
procedure lireLiens;
procedure regFichier(listeMots : TStringList);
 
implementation
 
uses
  uLex8;

Avec le curseur à la fin de cette ligne, nous appuyons sur les touches Ctrl+Maj+C de façon à créer dans l'espace de l'éditeur de source qui suit les instructions implementation et uses la structure de la procédure, qui sera complétée tout simplement :

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

Pour assurer l'enregistrement au moment du départ, nous ajoutons une ligne dans la procédure Button1Click :

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

Au lancement du programme, la liste d'origine est chargée ; à la fin du programme, le nouveau fichier est créé.

Un clic sur le petit triangle vert pour lancer l'exécution ; un clic sur le bouton Arrêt (premier onglet) pour le quitter en sauvegardant la liste. Vous pouvez vérifier la présence du nouveau ficher liMots.txt dans le répertoire.

Avant de redémarrer le programme, nous modifions la procédure de lecture, de façon à charger le nouveau fichier texte en remplacement du fichier originel :

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

Exécutez le programme, vérifiez que les accès aux mots et aux liens sont conservés.

Nous pouvons maintenant modifier la liste de mots à volonté, la liste d'origine restera préservée, et les modifications à venir seront enregistrées.

Le nouveau fichier texte révèle un surpoids de 10 % environ par rapport à l'ancien, alors qu'aucune information supplémentaire n'a été incluse. Le format Unix se révèle donc plus performant que le format Pascal… en termes de compacité.
Nous verrons ultérieurement comment réduire sa taille.

Ajout d'un mot

Notre liste de référence est facilement prise en défaut : manquent en particulier les noms de personnes, de lieux, de rivières, etc. qui agrémentent les mots croisés. Nous verrons également que sont absents des mots dont l'usage n'a rien d'exceptionnel.

Pour savoir si un mot existe dans la liste, nous connaissons la fonction IndexOf. Pour insérer un mot nouveau, nous allons créer la fonction fMotNouv(24) qui retournera la position future (indexMotNouv) du nouveau mot dans la liste.

Mots proches

Avant d'introduire un mot nouveau, l'utilisateur doit être informé de l'existence éventuelle de mots proches (au sens des mots croisés), de façon à éviter les entrées inutiles ou certaines fautes de frappe. La fonction fMotNouv devra en conséquence remplir parallèlement la liste auxiliaire des mots similaires ; cette liste sera soumise à l'utilisateur qui prendra sa décision en toute connaissance de cause.

 
Sélectionnez
function TForm1.fMotNouv(rechMot: string): integer;
var i, k : integer;
    referMot : string;
begin
      SetLength(tabApprox, 0);   //mise à zéro du tableau des mots proches
      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;

La dernière ligne prend en compte le mot nouveau qui arriverait en dernière position.

Traitement des index

L'introduction de ce mot va modifier les index utilisés par les liens :

  • les mots situés avant (index inférieur à indexMotNouv) conservent leur index ;
  • les mots situés après (index supérieur ou égal à indexMotNouv) voient leur index augmenté d'une unité.

L'opération ne présente pas de difficulté, elle sera réalisée par la procédure AjoutMot :

 
Sélectionnez
procedure TForm1.AjoutMot(motNouv: string; indexMotNouv: integer);
var  
      i, j : integer;
begin
   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
   listeMots.Insert(indexMotNouv, motNouv); //modification de la liste principale
   inc(nMots) ;  //actualisation du nombre de mots
end;

Notez que la variable globale iMot fait également objet d'une révision.

Information

Le mot nouveau est identifié, mais l'utilisateur doit confirmer son intégration après avoir été averti de l'existence de mots proches.

Cette phase est confiée à la procédure AnnonceMotNouveau :

 
Sélectionnez
procedure TForm1.AnnonceMotNouveau(motNouv: string);
var i, indexMotNouv  : integer;
    Rep : string;
begin
   if (motNouv>'') and (listeMots.IndexOf(motNouv)<0) then
   begin
       indexMotNouv := fMotNouv(motNouv);
       Rep := 'Ajouter le mot '+ motNouv +' ? ';
       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 AjoutMot(motNouv, indexMotNouv);
   end;
end;

Événement déclencheur

Un clic sur le bouton Ajouter doit déclencher(25) l'insertion du mot nouveau. Un premier contrôle s'assure que ce mot n'est pas vide et qu'il n'existe pas encore dans la liste principale. Un appel à la procédure AnnonceMotNouveau invite à la réflexion. Si la décision est confirmée, l'ajout est réalisé, puis la mise à jour de l'affichage.

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

Application

Nous allons tester le code avec un premier mot.

Clic sur le petit triangle vert pour passer en mode exécution. Dans l'onglet Mots, nous écrivons « Aa » puis nous cliquons sur le bouton Ajouter ; après confirmation, le mot est intégré dans la liste.

Mais les liens ont-ils été ajustés correctement ?

Image non disponible

Il suffit de passer sur l'onglet Balayage, de cocher la case Filtre, et de balayer la liste pour vérifier que tous nos liens s'affichent sans problème.

Dans l'onglet Balayage, revenez sur le mot « Aa ». Dans l'onglet Liens, écrivez le mot « fleuve » puis cliquez sur le bouton Lier : le nouveau mot est lié sans difficulté à un mot préexistant.

Pour quitter, passez par l'onglet Recherche(26) et cliquez sur le bouton Arrêt : de cette façon le nouveau mot et son lien seront enregistrés.

Mot approché

Relancez le programme. Dans l'onglet Mots, entrez le nouveau mot « macon » et cliquez sur le bouton Ajouter. Immédiatement, vous êtes informé de l'existence de mots proches :

Image non disponible

Un clic sur le bouton No permet d'éviter la bévue.

L'information passe par une fenêtre standard qui laisse à désirer :
- les boutons sont en anglais ;
- mais surtout les mots proposés ne sont pas « activables », donc l'utilisateur ne peut cliquer dessus pour les sélectionner…
Nous y reviendrons.

Sécurité

L'intervention directe sur le tableau de liens fragilise notre projet : des milliers d'index sont traités en série, et il suffit d'un problème de fonctionnement quelconque (coupure de courant par exemple) pour remettre en cause l'ensemble de l'échafaudage. Il paraît plus sage de modifier un tableau provisoire, et, en fin de traitement, remplacer le tableau de liens par le tableau provisoire : une seule opération validera la totalité du traitement.

Mais les tableaux dynamiques imposent quelques précautions : le tableau provisoire sera créé élément par élément pour que la mémoire traite effectivement deux objets distincts.

La procédure AjoutMotSecur peut s'écrire ainsi(27) :

 
Sélectionnez
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 validée
   if iMot >= indexMotNouv then inc(iMot);
   listeMots.Insert(indexMotNouv, motNouv); //modification de la liste principale
   inc(nMots);
end;

Dans la procédure AnnonceMotNouveau, il suffit de remplacer AjoutMot par AjoutMotSecur pour donner à notre logiciel la stabilité souhaitée.

À titre de contrôle, il est possible d'ajouter après la mise à jour, l'instruction
SetLength(nouvLiens, 0); //suppression de l'objet en mémoire
pour s'assurer de la réalité du deuxième objet et de la libération de la mémoire en fin de procédure.
Essayez…
En fait, le compilateur réalise l'opération automatiquement.

Suppression d'un mot

Opération inverse évidemment si un mot doit être supprimé de la liste. Cliquez deux fois sur le bouton Supprimer et complétez la procédure comme suit :

 
Sélectionnez
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;

Notez le filtrage sur l'existence de liens.

Pour sa part, la procédure SupMot peut s'écrire ainsi, en gardant en tête notre souci de sécurité :

 
Sélectionnez
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;

La procédure est active si le mot ne dispose pas de lien. Mais que se passe-t-il dans le cas contraire ?

Il suffira de supprimer chacun de ces liens avant de supprimer le mot lui-même : nous disposons déjà des outils nécessaires pour supprimer les liens individuellement.

Quelques lignes de code supplémentaires permettraient de traiter d'un coup les mots liés, et donc de gagner en ergonomie… et de risquer davantage un effacement accidentel.

Modification d'un mot

Le troisième cas de figure consiste à modifier et non supprimer un mot.

Dans l'immédiat, nous nous limiterons à supprimer ce mot, puis à le réintroduire avec sa nouvelle graphie.

Double-clic sur le bouton Modifier et complétez le code par le message :

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

Là encore, quelques lignes de code supplémentaires permettraient d'améliorer l'ergonomie.

Lier un mot nouveau

L'onglet Mots permet d'entrer un mot isolé.

Mais dans la pratique, un mot nouveau peut être introduit lors de la création de liens, depuis l'onglet Liens.

Pour l'instant, lier un mot existant à un mot nouveau échoue. Nous allons corriger cela en complétant la procédure Button3Click, qui devient :

 
Sélectionnez
procedure TForm1.Button3Click(Sender: TObject);
var iLien, k : integer;
    motNouv : string;
begin
   motNouv := UTF8ToAnsi(Edit3.Caption);
   iLien := listeMots.IndexOf(motNouv);
   if iLien<0 then
   begin
     AnnonceMotNouveau(motNouv);
     iLien := listeMots.IndexOf(motNouv);
   end ;
   if iLien>=0 then
   begin
     Lier(iMot, iLien);
     Lier(iLien, iMot);
     AffLiens;
   end;
   Edit3.Clear;
end;

Nous pouvons essayer cette nouvelle méthode : lancez l'exécution(28). Dans l'onglet Liens, cliquez sur le mot « voyelle » pour le faire basculer en mot-titre. Dans la zone d'édition, entrez la lettre « e » et cliquez sur le bouton Lier. Confirmez : maintenant, le mot « voyelle » est lié à la fois à la lettre « a » et à la lettre « e ».

Conclusion

Intouchable… Notre liste principale ne l'est plus désormais. Nous pouvons maintenant exploiter à loisir toutes les définitions de grilles de mots croisés que l'on souhaite, de façon à constituer une base consistante pour nos futures recherches.

Mais ne vous lancez pas encore, une partie du travail est déjà faite !

Dans le prochain chapitre, nous intégrerons un premier volume de liens supplémentaires.

Notaire : arrive souvent au dernier acte.
Tristan Bernard

Le code… L'unité uLex8 se présente maintenant comme suit :

 
Sélectionnez
unit ulex8;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls,
  Graphics, Dialogs, StdCtrls, ComCtrls, uDisque;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    ListBox4: TListBox;
    Memo2: TMemo;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    Zoom: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    AffListe: TListBox;
    Memo1: TMemo;
    PageControl1: TPageControl;
    Page1: TTabSheet;
    TabSheet1: TTabSheet;
    TrackBar1: TTrackBar;
    UpDown1: TUpDown;
    UpDown2: TUpDown;
    procedure AffListeClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(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 UpDown1Click(Sender: TObject; Button: TUDBtnType);
    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);
    procedure AnnonceMotNouveau(motNouv : string);
    function fMotNouv(rechMot : string) : integer;
    procedure AjoutMot(motNouv : string; indexMotNouv : integer);
    procedure AjoutMotSecur(motNouv : string ; indexMotNouv : integer);
    procedure SupMot(motCour : string; indexMotCour : integer);
  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.Button2Click(Sender: TObject);
begin
   Recherche(UTF8ToAnsi(Edit2.Caption));
end;
 
 
procedure TForm1.AnnonceMotNouveau(motNouv: string);
var i, indexMotNouv  : integer;
    Rep : string;
begin
   if (motNouv>'') and (listeMots.IndexOf(motNouv)<0) then
   begin
       indexMotNouv := fMotNouv(motNouv);
       Rep := 'Ajouter le mot '+ motNouv +' ? ';
       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 AjoutMotSecur(motNouv, indexMotNouv);
   end;
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;
 
//==========================
procedure TForm1.AjoutMot(motNouv: string; indexMotNouv: integer);
var
      i, j : integer;
begin
   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
   listeMots.Insert(indexMotNouv, motNouv); //modification de la liste principale
   inc(nMots);
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
   motNouv := UTF8ToAnsi(Edit3.Caption);
   iLien := listeMots.IndexOf(motNouv);
   if iLien<0 then
   begin
     AnnonceMotNouveau(motNouv);
     iLien := listeMots.IndexOf(motNouv);
   end ;
   if iLien>=0 then
   begin
     Lier(iMot, iLien);
     Lier(iLien, iMot);
     AffLiens;
   end;
   Edit3.Clear;
end;
 
procedure TForm1.Button4Click(Sender: TObject);
var k : integer;
    okTri : boolean;
begin
   for k := 0 to Length(Liens)-1 do
     if (Length(Liens[k]) > 2) then
        repeat
           okTri := TriSec(k);
        until okTri;
end;
 
procedure TForm1.Button5Click(Sender: TObject);
var i : integer;
begin
 for i := 0 to Length(Liens) - 1 do
    Memo2.Append(listeMots[Liens[i, 0]]);
 repeat
 until TriPPal;
 for i := 0 to Length(Liens) - 1 do
    Memo2.Append(listeMots[Liens[i, 0]]);
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
     AnnonceMotNouveau(motNouv);
     i := listeMots.IndexOf(motNouv);
     if i>=0 then iMot :=  i;
     MAJBalayage;
     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;
  Memo1.Append('Premier mot : '+listeMots[0]);
  Memo1.Append('Dernier mot : '+listeMots[nMots-1]);
  lireLiens;
  iMot := 0;
  Edit3.Clear;
  MAJAffichage;
  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 := tabApprox[ListBox3.ItemIndex];
  Label1.Caption:=AnsiToUTF8(listeMots[iMot]);
  Edit2.Clear;
  ListBox3.Clear;
  MAJBalayage;
 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]);
   Label3.Caption:= Label2.Caption;
   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 := 'Lex8 '+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;
 
function TForm1.TriSec(k: integer): boolean;
var i, Tamp : integer;
begin
  TriSec := True;
  for i := Length(Liens[k]) - 1 downto 2 do
    if Liens[k, i] < Liens[k, i-1] then
    begin
      Tamp :=  Liens[k, i];
      Liens[k, i] := Liens[k, i-1];
      Liens[k, i-1] := Tamp;
      TriSec := False;
    end;
end;
 
function TForm1.TriPPal: boolean;
var i : integer;
    Tamp : Array of integer;
begin
  TriPPal := True;
  for i := Length(Liens) - 1 downto 1 do
    if Liens[i, 0] < Liens[i-1, 0] then
    begin
      Tamp :=  Liens[i];
      Liens[i] := Liens[i-1];
      Liens[i-1] := Tamp;
      TriPPal := False;
    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;
 
 
 
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
   if Button=btNext then Inc(iMot)
                       else Dec(iMot);
   iMot := iMot + nMots   mod  nMots;
   MAJAffichage;
end;
 
procedure TForm1.MAJAffichage;
begin
   Label1.Caption:=AnsiToUTF8(listeMots[iMot]);
   Edit2.Caption:= '';
   Memo1.Append('Index '+IntToStr(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
Voir ci-dessus comment introduire une nouvelle fonction ou procédure.
La création de la procédure a été détaillée précédemment.
L'ergonomie laisse encore à désirer.
Voir précédemment pour la façon de créer une nouvelle procédure.
Nous supposons ici que la lettre « a » est déjà liée au mot « voyelle ». Établissez ce lien si nécessaire.

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 ni 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.