GENÈSE D'UN DICTIONNAIRE

Construction d'un lexique interactif avec Lazarus

dimanche2003

Cette série d'articles a pour objectif la construction d'un lexique interactif, chaque étape traitant les difficultés rencontrées dans la gestion du vocabulaire, et présente une ou des solutions.

Commentez

Je remercie Claude Leloup et f-leb pour leur relecture.

- Titre : GENÈSE D'UN DICTIONNAIRE

- Auteur : dimanche2003

- Parution : 1 octobre 2012

- Mise à jour : 11 février 2014

- Public visé :

- Licence : 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.

Sommaire

- Lecture d'une liste de mots

- Introduction

- Présentation

- Liste de départ

- La source

- Lecture directe

- Utilisation

- Conclusion

- Affichage sous Lazarus

- Introduction

- Démarrage de Lazarus

- Sauvegarde de l'unité

- Sauvegarde du projet

- Interface graphique

- Code

- Deuxième méthode

- Troisième méthode

- Chronomètre

- Conclusion

- Navigation dans le fichier

- Introduction

- Espace de travail

- Unité uDisque

- Unité uLex2

- Vérification

- Lancement et arrêt du programme

- Recherche et affichage d'un mot

- Interface graphique

- Code

- Exécution

- Options de base

- Les accents

- Majuscules

- Lettres accolées

- Autres signes

- Balayage mot par mot

- Extension de l'espace graphique

- III-7. Introduction d'onglets

- Conclusion

- Onglet Balayage

- Introduction

- Environnement

- Curseur

- ListBox

- Navigateur

- Zoom

- Conclusion

- Premiers liens

- Introduction

- Environnement

- Code

- Événement TrackBar1

- Couple Nom-Valeur

- Valeur littérale

- Valeur numérique

- Saisie des mémos

- Affichage

- Navigation

- Développements complémentaires

- Propriété Object

- Saisie des mémos

- Affichage

- Filtre

- Compatibilité

- Conclusion

- Liens multiples

- Introduction

- Environnement

- Architecture

- Tableaux de liens

- Nettoyage de l'interface et du code

- Écriture de liens

- Méthode

- Premier essai

- Création d'un lien

- Recherche du tableau de liens

- Création du lien

- Exécution

- Réciprocité

- Enregistrement des liens

- Lecture des liens

- Filtre

- Conclusion

- Classements et approximations

- Introduction

- Environnement

- Onglet Balayage

- Tri des liens

- Tri des tableaux secondaires

- Tri du tableau principal

- Ajout d'un lien

- Création d'un tableau secondaire

- Suppression d'un lien

- Mots approchés

- Principes

- Méthode

- Interface graphique

- Élimination des accents

- Balayage de la liste principale

- Conclusion

- Ajouter un mot

- Introduction

- Environnement

- Répertoires

- Variables et constantes

- Onglets

- Fichier de mots

- Ajout d'un mot

- Mots proches

- Traitement des index

- Information

- Événement déclencheur

- Application

- Mot approché

- Sécurité

- Suppression d'un mot

- Modification d'un mot

- Lier un mot nouveau

- Conclusion

- Extension et recherches élémentaires

- Introduction

- Environnement

- Extension du vocabulaire

- Nombre de mots

- Nombre de liens

- Interface de saisie

- Ancien bouton

- Nouveau bouton

- Recherche

- Onglets

- Masque

- Principe

- Interface graphique

- Code

- Conclusion

- Recherche logique

- Introduction

- Environnement

- Humour

- Interface graphique

- Méthode

- Fréquence

- Profondeur

- Variables

- Initialisation

- Requête

- Recherche

- Application

- Complément d'information

- Interprétation

- Liens du premier niveau

- Deuxième niveau

- Conclusion

- Compression

- Introduction

- Environnement

- Modification du stockage

- Temps d'accès aux deux fichiers

- Fichier unique

- Compression des mots

- Mode retenu

- Fenêtre de choix

- Principe de fonctionnement

- Fenêtre modale

- Déclarations

- Interface graphique

- Code

- Ouverture du dialogue

- Application

- Conclusion

- Code

- Unité uLex11

- Unité uDisque

- Unité uDialog

- Projet complet

- Synthèse

- Introduction

- Environnement

- Conventions

- Interface graphique

- Page Fichier

- Page Lecture

- Navigation par le curseur

- Navigation par les flèches

- Sélection d'un mot voisin

- Sélection d'un lien

- Page Recherche

- Logique

- Masque

- Page Ajout

- Mots proches

- Fenêtre modale

- Ajout d'un mot

- Ajout d'un lien

- Exécution

- Page Suppression

- Sauvegarde

- Conclusion

- Code

- Unité uLex12

- Unité uDisque

- Unité uDialog

- Téléchargements

Lecture d'une liste de mots

Introduction

La saisie assistée de SMS, l'accès aux moteurs de recherche et la correction automatique d'orthographe nous ont familiarisés avec un processus remarquable : en temps réel, un robot nous propose de compléter le mot que l'on a en tête…
La prestation est d'autant plus notable qu'elle s'est insinuée dans nos tâches quotidiennes sans crier gare : l'assistance est là, permanente, rassurante, quelquefois même envahissante ; ceci dans des conditions techniques  stockages de données monstrueux, flux d'échanges à débits élevés, algorithmes de tri rapide mieux gardés que Fort Knox, etc.  que l'on peut difficilement imaginer.
Il n'est pas question ici d'aborder cet arsenal à la pointe de l'informatique d'aujourd'hui, mais modestement d'étudier comment réaliser une base de vocabulaire personnelle, évolutive, consultable aisément, ce qui est déjà une approche intéressante, mais, pourquoi pas, susceptible de donner un coup de main dans le cadre d'un jeu de mots :

- recherche formelle avec l'utilisation d'un masque précisant la longueur du mot et les lettres connues,

- recherche logique à partir d'une définition souvent humoristique. Un exemple célèbre est celui de Tristan Bernard : « Vide les baignoires et remplit les lavabos ». Réponse… à la fin du chapitre.

En quelques étapes, nous allons construire une imposante base de mots avec les outils nécessaires pour la consulter et l'enrichir.

Oui, ça marche : mieux que Google !

L'approche se veut méthodique et progressive. Didactique. Les geeks ne trouveront rien de transcendant. Les débutants et les curieux pourront au contraire apprécier une méthode essentiellement pragmatique…
Et après tout, rien n'empêchera de porter l'application sur Android, pour que l'application, une fois achevée, soit accessible sur son PDA…
Les passionnés et les bonnes volontés pourront apporter leur compétence, qui sera la bienvenue.

Présentation

La première étape est consacrée au chargement d'une liste et à sa consultation. Les suivantes constituent une initiation ludique à la programmation sous Lazarus, mais elles restent transposables aisément à tout autre langage.

La saisie d'un vocabulaire de 300 000 mots est une tâche digne des copistes du Moyen Âge : à raison d'un mot par seconde, il faudrait quatre jours de frappe ininterrompue…
Heureusement, avec internet, l'accès à ce volume de données est facile.

Liste de départ

Dans votre navigateur préféré, collez l'adresse suivante, ou cliquez tout simplement sur le lien :

http://pallier.org/liste-de-mots-francais.html

Sur la page qui apparaît, cliquez sur liste.de.mots.francais.frgut.txt.

Le navigateur s'ouvre sur une nouvelle page qui présente la liste recherchée. Un clic droit, dans le menu contextuel, choisissez Enregistrer sous ; vous pouvez conserver le nom proposé ; choisissez comme répertoire celui du projet, par exemple Lexique, et sauvegardez.

La source

Le fichier qui vient d'être chargé est un véritable trésor : il contient exactement 336 531 entrées, donc beaucoup plus que les plus gros dictionnaires ou encyclopédies jamais édités sur papier ! C'est le résultat d'un travail initié notamment par l'Université de Lausanne (merci à nos amis suisses) et poursuivi en France au CNRS et différentes universités dont Paris Descartes.

Christophe Pallier est un éminent chercheur en sciences cognitives, et je ne résiste pas à la tentation de reprendre ici la présentation qu'il fait de lui-même, les nuls en anglais me (lui) pardonneront :

I am a middle age homo-sapiens drinking too much coffee.
I am also the father of 3 homo-sapiens-sapiens (2 males/1 female). During the day, I work as a scientific researcher, sponsored by the french tax-payers to try and understand the brain machinery that allows us to speak.
As no one seems willing to write a Wikipedia entry about me or my accomplishments, I have decided to create this website (in 1994, long before the advent of Wikipedia, but let us not be sidetracked by this apparent paradox).

Tout le monde a compris qu'il buvait trop de café, qu'il avait trois enfants, qu'il vivait aux crochets du contribuable et que Wikipedia ne parlait pas de lui !

Merci à ce brillant chercheur pour son humour et… l'autorisation qu'il nous a donnée d'utiliser sa publication(1).

Lecture directe

Il suffit de cliquer sur le nouveau fichier pour que le programme par défaut de votre ordinateur affiche le texte. Le bloc-notes de Windows est lent et présente tous les mots sans retour à la ligne ; WordPad convient, mais Notepad++ est mieux adapté, car les numéros de ligne sont indiqués :

Peut-on vérifier le nombre exact d'entrées ?

Il suffit de rejoindre la fin du fichier dans la fenêtre du programme. Notepad++ donne les informations cherchées :

Le dernier mot s'écrit zythums(2) et il figure sur la ligne 336531. Objectif atteint.

Utilisation

L'ensemble du fichier texte et de son programme de lecture donne accès aux fonctions essentielles :

- lecture d'un mot ;

- modification ;

- ajout ;

- recherche ;

- sauvegarde, etc.

Donc notre projet pourrait s'arrêter là, avec une belle collection de mots d'un côté, et un outil tout prêt pour la consulter…

Mais faisons un rêve. Ne pourrait-on pas :

- dessiner une interface plus accueillante ;

- disposer d'une petite fenêtre pour dialoguer avec la machine ;

- attacher une information, pas forcément une documentation complète, style wiki, mais au moins un lien avec un autre mot…

C'est ce que l'on va aborder dans le prochain chapitre en utilisant Lazarus que l'on peut charger dès maintenant à partir du site Developpez.com ou directement ici :

http://sourceforge.net/projects/lazarus/files/

Attention, la page affiche des boutons Téléchargez ou Download qui sont des liens publicitaires.

La cible à repérer s'intitule

- Lazarus Windows 32 bits

- Lazarus Windows 64 bits

- ou Lazarus Mac, Linux, etc.

dans des versions datées du 28 ou 29 juillet 2012.
Cliquez sur la ligne qui vous convient et installez Lazarus.

Conclusion

Pour la langue française, la ressource disponible se révèle mieux que copieuse : notre projet démarre dans de bonnes conditions. Mais il est difficile d'imaginer que des ressources homologues n'existent pas pour d'autres langues : Internet est une mine féconde où il suffit souvent de chercher…

Sans oublier la colle du début de chapitre : les baignoires sont (également) des loges au théâtre ; les lavabos sont (également) des toilettes. Si on associe théâtre et toilettes, avec l'aide peut-être de quelques lettres déjà identifiées, on aboutit à… entracte !

Un essai avec Google : le moteur de recherche propose Jacob Delafon… Logique purement commerciale, loin de tout humour !

Voyons si nos petits bras musclés et nos quelques neurones encore valides seront en mesure de relever le défi…

Le prochain chapitre abordera différentes méthodes pour ouvrir le fichier texte avec Lazarus.

« Je ne retomberai jamais en enfance, j'y suis toujours resté. »
Tristan Bernard

Affichage sous Lazarus

Introduction

Le premier chapitre a conduit au chargement d'un fichier texte. Fichier quand même exceptionnel puisqu'il apporte plus de 336 000 mots de la langue française !
Cette liste est consultable à l'aide d'un programme courant, style bloc-notes ou WordPad, mais l'intérêt de cette consultation reste alors très restreint. Un outil tel que Lazarus va ouvrir des possibilités intéressantes. Dans ce chapitre seront présentées trois méthodes de lecture, et une technique d'évaluation.
Dans le chapitre suivant, le programme sera complété pour aborder différentes façons d'afficher et de balayer le texte.

Démarrage de Lazarus

Votre ordinateur dispose de Lazarus d'un côté, du fichier de mots d'un autre. Pour simplifier les explications à venir, nous vous proposons de créer un répertoire Lexique dans lequel seront ouverts les sous-répertoires Docs et Lex1.

Le répertoire Docs recevra les documents textes et pour commencer, le fichier de mots.

Lex1 sera réservé à Lazarus, donc au programme source, au programme compilé et à l'ensemble des fichiers de service.

Pour les chapitres suivants, on créera le répertoire Lex2, Lex3, etc. de façon à faciliter à chaque instant le retour à un état antérieur du programme.

Lancez Lazarus, cliquez sur Fichier/Nouveau/Application. Au premier plan apparaît une fenêtre intitulée Form1 : c'est elle qui recevra les boutons de commande et les modules d'affichage.

Au second plan s'ouvre la fenêtre de l'éditeur de code intitulée Éditeur de source.

Sauvegarde de l'unité

La première ligne de l'éditeur s'intitule unit Unit1 ; cliquez sur Fichier/Enregistrer sous. Choisissez :

- votre répertoire de travail, par exemple Lex1 ;

- le nom de votre unité, par exemple uLex1, sauvegardez, option Préserver le nom.

Le fichier uLex1.pas est créé dans le répertoire Lex1.

Sauvegarde du projet

Dans le menu, sous le mot Fichier, se présente une icône avec le menu contextuel Nouvelle unité. Sous cette icône, une autre avec l'information Afficher les Unités. Cliquez sur cette seconde icône : deux unités sont listées. La première, uLex1, est celle que l'on vient de créer. Cliquez sur la seconde et enregistrez sous le nom de pLex1.

L'unité et le projet sont en sécurité sur votre disque dur. Toutes les modifications seront enregistrées et Lazarus permettra un retour en arrière après toute une série de saisies.

Cette phase préalable d'enregistrement (choix du répertoire, enregistrement de l'unité et du projet) est fondamentale sous Lazarus, qui connaît dorénavant son espace de travail : votre programme est maintenant localisé et la compilation (construction du fichier exe) se fera dans le répertoire que vous aurez choisi.

Interface graphique

Pour l'instant, l'interface graphique se présente sous la forme d'une fenêtre intitulée Form1. Nous nous limiterons, dans l'immédiat, à trois modifications :

- Nom de l'interface. Dans le menu Fenêtre de Lazarus, sélectionnez Form1. Cliquez dans cette fenêtre pour indiquer à Lazarus que vous vous intéressez à cet objet précis. Effectivement, Lazarus, dans sa fenêtre Inspecteur d'objets a sélectionné la ligne Form1:TForm1 . Au-dessous, dans l'onglet Propriétés, ligne Caption, on lit Form1. Remplacez ce nom par Lex1 : immédiatement le nouveau nom s'affiche en tête de notre interface graphique ;

- Bouton.

Sous la ligne du menu, cliquez sur le bouton marqué Ok, puis cliquez au centre de la fenêtre Lex1 : un bouton appelé Button1 apparaît. Dans l'inspecteur d'objets, la sélection a basculé sur ce nouvel objet. Dans l'onglet Propriétés, ligne Caption, remplacez Button1 par Lire ;

- Texte. Sous la ligne du menu, à côté du bouton, figure un objet qui se présente sous le sigle Abc. Cliquez dessus, puis cliquez dans l'interface graphique : l'objet Label1 apparaît. Il est sélectionné automatiquement dans l'inspecteur d'objets.

L'interface est minimaliste, mais nous aurons l'occasion de l'enrichir !

Code

Nous voilà maintenant au pied du mur : nous imaginons un clic sur le bouton, qui déclenche la lecture du fichier texte, et une information apparaît sur l'interface pour signaler que l'opération s'est déroulée normalement.

Voici le code qui permet la lecture du fichier texte :

procedure LireListeDeMots;
var
MotCour: string;
lettre: char;
fLex:   file;
listeMots : TStringList;
begin
TopChro := 0;
TopChrono('');
listeMots := TStringList.Create;
AssignFile(fLex, 'liste.de.mots.francais.frgut.txt');
{$I-}
Reset(fLex, 1);
{$I+}
if IOResult = 0 then
begin
Seek(fLex, 0);
MotCour := '';
while not EOF(fLex) do
begin
BlockRead(fLex, lettre, 1);
if lettre <> Chr(10) then
MotCour := MotCour + lettre
else
begin
listeMots.Append(MotCour);
MotCour     := '';
end;
end;
CloseFile(fLex);
TopChrono('Lecture octets');
Form1.Label1.Caption := 'Dernier mot (n° '
+ IntToStr(listeMots.Count) + ') : ' + listeMots.Strings[listeMots.Count-1];
end
else
ShowMessage('Erreur d''accès au fichier');
Beep;
end;

Il faut copier ce texte dans l'éditeur de source, sous la ligne implementation. Le compilateur cherchera le fichier texte dans le répertoire de travail : il faut donc copier le fichier de mots (en principe dans le répertoire Docs) dans le répertoire de travail, Lex1.

Un clic sur le petit triangle vert (sous le mot Éditer dans le menu Lazarus) déclenche un contrôle général du projet, sa compilation et son exécution (en mode débogage).

Si rien ne se passe, c'est que tout va bien, le compilateur a fait son travail jusqu'au bout sans rencontrer de problème. Si une erreur est intervenue, lisez attentivement les informations présentées dans la fenêtre Messages. Corrigez selon les indications données.

Pour revenir en mode édition, il suffit de cliquer sur le carré rouge, à droite du triangle vert : le mode débogage est arrêté, l'édition du programme peut reprendre.

À quoi sert le bouton Lire ? Pour l'instant, le programme n'inclut aucune instruction pour le cas où l'on cliquerait dessus ! Cette omission va être rapidement corrigée.

Dans l'interface graphique Lex1, cliquez une fois sur le bouton Lire : son cadre est souligné par huit petits carrés permettant par exemple de modifier sa forme. Dans la fenêtre Inspecteur d'objets, l'objet Button1 est alors sélectionné. Dans la partie inférieure de la fenêtre, dans l'onglet Propriétés, cliquez sur la ligne OnClick : à droite, trois points apparaissent ; cliquez dessus : l'éditeur de source est immédiatement enrichi d'une nouvelle procédure, et le curseur d'édition clignote entre les instructions begin et end ;

Une seule instruction est à écrire :

LireListeDeMots

qu'il faut terminer par un point-virgule « ; ».

Dans la pratique, notre programme uLex1 fabrique (à l'aide de tout l'environnement Lazarus évidemment) une interface graphique Lex1 avec un bouton et une ligne de texte.

Lorsque l'on clique sur le bouton, le programme exécute la procédure LireListeDeMots. Quand celle-ci est terminée, la ligne de texte nous présente les informations voulues.

Cliquez sur le petit triangle vert pour compiler. Cliquez sur le bouton Lire et… patientez, car la lecture du fichier de mots peut durer de 30 à 60 secondes selon le matériel utilisé. L'information voulue apparaît enfin :

Deuxième méthode

L'accès au contenu du fichier par l'intermédiaire de Lazarus semble bien lent. En effet, le code contient l'instruction

BlockRead(fLex, lettre, 1);

qui impose au matériel de lire le fichier lettre par lettre, chaque lettre occupant un octet. Comme le fichier a une longueur de 3,7 mégaoctets, il y a autant d'accès disque, ce qui est pénalisant.

La seconde méthode consiste à regrouper la lecture par blocs de textes (les mots) séparés par un octet de retour à la ligne. Le code devient alors :

procedure LireListe2;
var
MotCour: string;
fLex:   TextFile;
listeMots : TStringList;
begin
listeMots := TStringList.Create;
AssignFile(fLex, 'liste.de.mots.francais.frgut.txt');
{$I-}
Reset(fLex);
{$I+}
if IOResult = 0 then
begin
while not EOF(fLex) do
begin
ReadLn(fLex, MotCour);
listeMots.Append(MotCour);
end;
CloseFile(fLex);
Form1.Label1.Caption := 'Lecture par mot ; mot (n° '
+ IntToStr(listeMots.Count) + ') : ' + listeMots.Strings[listeMots.Count-1];
end
else
ShowMessage('Erreur d''accès au fichier');
Beep;
end;

Pour lancer cette procédure, on va ajouter un bouton, appelé Lire2, et dans la procédure OnClick de ce bouton, glisser l'instruction LireListe2 ; un clic sur le petit triangle vert pour compiler, un clic sur le bouton Lire2 et… cette fois on apprécie une réaction presque immédiate.

Le premier mode de lecture imposait un déchiffrage caractère par caractère, et le second passe directement d'un mot à l'autre. En gros, les accès disques passent de 3 700 000 (nombre d'octets) à 330 000 (nombre de mots).
Plus loin nous verrons comment évaluer précisément la performance.

Troisième méthode

Le rythme pourrait encore s'accélérer si la lecture pouvait s'opérer d'un bloc, avec une séparation automatique des mots…

Cela est possible en remplaçant les instructions BlockRead (version 1) ou ReadLn (version 2) par l'instruction de haut niveau

listeMots.LoadFromFile(nomFichier)

(listeMots est la liste utilisée précédemment). LoadFromFile indique tout simplement qu'il faut la remplir à partir du fichier précisé.

Le code se réduit encore :

procedure LireListeTexte;
var
listeMots : TStringList;
begin
listeMots := TStringList.Create;
listeMots.LoadFromFile('liste.de.mots.francais.frgut.txt');
Form1.Label1.Caption := 'Lecture 3 ; dernier mot (n° '
+ IntToStr(listeMots.Count) + ') : ' + listeMots.Strings[listeMots.Count-1];
Beep;
end;

Pour lancer cette procédure, on va ajouter un bouton, appelé Lire3, et dans la procédure OnClick de ce bouton, glisser l'instruction :

LireListeTexte ;

Un clic sur le petit triangle vert pour compiler, un clic sur le bouton Lire3 et… cette fois on apprécie encore. Simplicité et efficacité.

Chronomètre

Pour y voir clair sur les performances de tel ou tel programme, rien de tel que de mesurer la durée qui sépare le démarrage d'une tâche et son achèvement.

Il existe dans la bibliothèque LCL une fonction GetTickCount qui donne, en millièmes de seconde, la position du compteur Temps du processeur. Pour rendre cette fonction accessible, il suffit de rajouter dans la ligne uses l'unité LclIntf :

unit uLex1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, LclIntf;

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

Lazarus saura identifier l'instruction GetTickCount ; le code de la procédure pourrait s'écrire ainsi :

procedure TopChrono(Info : string);
begin
if TopChro = 0 then
begin
TopChro := GetTickCount;
Form1.Memo1.Append('Départ chrono');
end
else
Form1.Memo1.Append(Info +' Durée du processus '
+ IntToStr(GetTickCount-TopChro)+' ms');
end;

La procédure modifie la variable globale TopChro. Si elle vaut 0, le champ Memo signale le départ du chronomètre. Sinon, le Memo présente l'écart de temps, en millisecondes, depuis le départ.

Pour que ce code soit utilisable, il convient de :

Primo, déclarer la variable globale TopChro ; pour cela, sous les lignes :

var Form : Tform1 ;

on ajoute :

TopChro : integer ;

Secundo, ajouter un composant Memo dans l'interface graphique : ce composant est présenté dans le menu Lazarus entre le bouton marqué Ok, déjà utilisé, et le bouton marqué on. On clique une fois sur le composant, une fois sur l'interface Lex1 et on agence l'ensemble pour obtenir sensiblement la présentation suivante :

Le champ Memo dispose également de nombreuses propriétés directement accessibles dans l'inspecteur d'objets : cliquez sur la propriété Scrollbars ; faites passer le paramètre de ssNone à ssAutoBoth.
Ainsi, les ascenseurs latéral et vertical permettront de naviguer sans difficulté dans ce composant.

Tertio, compléter chaque procédure de lecture par une mise à zéro de la variable globale et un premier appel à TopChrono, ceci en début de procédure, et un second appel à TopChrono en fin de procédure.

Pour vérifier que tout fonctionne, compilez, et cliquez successivement sur les boutons Lire, Lire2 et Lire3.

Les mesures de durée sont affichées dans le mémo.

Sur une machine, on obtient par exemple :

Type de lecture

Durée millisecondes

Octet par octet

39171

Mot par mot

437

Globale

156

Conclusion

Une bonne utilisation du code permet de réaliser des économies spectaculaires dans les temps d'accès.

En l'occurrence, l'instruction BlockRead se révèle désastreuse par rapport à l'instruction LoadFromFile.

Alors, pourquoi l'avoir utilisée ?

D'abord pour les besoins de comparaison : aucune solution ne peut être a priori considérée comme la meilleure.

Ensuite parce que, la suite le montrera, cette instruction nous sera bien utile !

Le présent chapitre a montré comment Lazarus permet de lire un fichier de mots. Le suivant abordera l'affichage des mots et le balayage du fichier depuis le début jusqu'à la fin.

L'unité uLex1 se présente dorénavant comme suit :

L'unité uLex1

unit uLex1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, LclIntf;

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
Form1: TForm1;
TopChro : integer;
implementation

{ TForm1 }
procedure TopChrono(Info : string);
begin
if TopChro = 0 then
begin
TopChro := GetTickCount;
Form1.Memo1.Append('Départ chrono');
end
else
Form1.Memo1.Append(Info +' Durée du processus '
+ IntToStr(GetTickCount-TopChro)+' ms');
end;

procedure LireListeDeMots;
var
MotCour: string;
lettre: char;
fLex:   file;
listeMots : TStringList;
begin
TopChro := 0;
TopChrono('');
listeMots := TStringList.Create;
AssignFile(fLex, 'liste.de.mots.francais.frgut.txt');
{$I-}
Reset(fLex, 1);
{$I+}
if IOResult = 0 then
begin
Seek(fLex, 0);
MotCour := '';
while not EOF(fLex) do
begin
BlockRead(fLex, lettre, 1);
if lettre <> Chr(10) then
MotCour := MotCour + lettre
else
begin
listeMots.Append(MotCour);
MotCour     := '';
end;
end;
CloseFile(fLex);
TopChrono('Lecture octets');
Form1.Label1.Caption := 'Dernier mot (n° '
+ IntToStr(listeMots.Count) + ') : ' + listeMots.Strings[listeMots.Count-1];
end
else
ShowMessage('Erreur d''accès au fichier');
Beep;
end;

procedure LireListe2;
var
MotCour: string;
fLex:   TextFile;
listeMots : TStringList;
begin
TopChro := 0;
TopChrono('');
listeMots := TStringList.Create;
AssignFile(fLex, 'liste.de.mots.francais.frgut.txt');
{$I-}
Reset(fLex);
{$I+}
if IOResult = 0 then
begin
while not EOF(fLex) do
begin
ReadLn(fLex, MotCour);
listeMots.Append(MotCour);
end;
CloseFile(fLex);
TopChrono('Lecture mots');
Form1.Label1.Caption := 'Lecture par mot ; mot (n° '
+ IntToStr(listeMots.Count) + ') : ' + listeMots.Strings[listeMots.Count-1];
end
else
ShowMessage('Erreur d''accès au fichier');
Beep;
end;

procedure LireListeTexte;
var
listeMots : TStringList;
begin
TopChro := 0;
TopChrono('');
listeMots := TStringList.Create;
listeMots.LoadFromFile('liste.de.mots.francais.frgut.txt');
TopChrono('Lecture texte');
Form1.Label1.Caption := 'Lecture 3 ; dernier mot (n° '
+ IntToStr(listeMots.Count) + ') : ' + listeMots.Strings[listeMots.Count-1];
Beep;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LireListeDeMots;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
LireListe2;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
LireListeTexte;
end;

initialization
{$I uLex1.lrs}

end.

Navigation dans le fichier

Introduction

En premier lieu, nous avons accédé à un fichier de mots d'une taille exceptionnelle, l'étape suivante étant de le charger sous Lazarus(3).

Le présent chapitre va examiner comment il est possible de naviguer dans cette liste immense et comment effectuer des recherches simples.

À cette occasion, des problèmes liés aux majuscules et aux accents vont apparaître, et il faudra prendre des options pour la suite de notre projet.

Espace de travail

Pour commencer, nous allons organiser notre espace de travail sous Lazarus. Dans le répertoire Lexique, nous créons un nouveau répertoire Lex2 qui recevra le fichier de mots et tous les fichiers de Lazarus.

Ouvrez Lazarus/Fichier/Nouveau/Application : nous sauvegardons la nouvelle unité dans ce répertoire sous le nom de uLex2. Nous sauvegardons le projet sous le nom de pLex2.

Unité uDisque

Tous les accès au disque (lecture/enregistrement de la base de mots) seront réservés à une nouvelle unité que nous appellerons uDisque. Dans le menu Fichier/Nouveau, nous choisissons Nouvelle unité ; elle apparaît dans l'Éditeur de source ; enregistrement sous le nom de uDisque.

Nous revenons à l'unité principale, uLex2, et nous ajoutons la nouvelle unité dans la liste existante sous la clause uses.

unit uLex2;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

Pour la lecture des données, nous avons remarqué l'efficacité de l'instruction LoadFromFile. Nous allons la reprendre ici, en deux étapes :

1 - dans l'unité uDisque, sous la ligne des unités et avant la commande implementation, nous écrivons la ligne suivante :

procedure LireFichier(listeMots : TStringList);

et nous appuyons simultanément sur les touches Ctrl, Maj et C : la procédure est créée immédiatement sous la ligne implementation :

unit uDisque;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils;
procedure LireFichier(listeMots : TStringList);
implementation

procedure LireFichier(listeMots: TStringList);
begin

end;

end.

2 - le curseur clignote entre les mots begin et end ; nous écrivons l'instruction

listeMots.LoadFromFile('liste.de.mots.francais.frgut.txt');

Unité uLex2

C'est l'unité principale du projet. Nous reprenons rapidement les étapes déjà connues :

- la fenêtre Form1 est renommée en Lex2 ;

- on ajoute un composant bouton et un composant memo ;

- dans la procédure onClick du bouton, on remplit l'espace entre les mots begin et end comme suit :

procedure TForm1.Button1Click(Sender: TObject);
begin
listeMots := TStringList.Create;
LireFichier(listeMots);
Memo1.Append('Premier mot : '+listeMots[0]);
Memo1.Append('Dernier mot : '+listeMots[listeMots.Count-1]);
end;

Il faudra enfin déclarer la variable listeMots en ajoutant, sous la ligne Form1 : Tform1, la déclaration :

listeMots: TstringList;

Vérification

Un clic sur le petit triangle vert lance l'exécution. Si tout se passe bien, après un clic sur le bouton de l'interface Lex2, la liste est chargée et le composant Memo indique presque instantanément quels sont les premier et dernier mots de la liste :

Cliquez sur le petit carré rouge du menu Lazarus pour arrêter l'exécution.

Il est aussi possible de cliquer sur la petite croix en haut et à droite de Lex2.

Une fenêtre indique « Exécution interrompue » ; cliquez sur Ok pour reprendre l'édition du projet.

Lancement et arrêt du programme

Il serait plus rationnel que la mise en route du programme déclenche automatiquement le chargement de la liste de mots. Pour cela, on utilise la propriété onCreate de l'interface.

Dans l'inspecteur d'objets, cliquez sur Form1 pour sélectionner l'objet. Au-dessous, dans l'onglet Évènements, cliquez sur le mot OnCreate, puis sur les trois points qui apparaissent à droite. Automatiquement, la procédure est créée. On y place toutes les instructions qui figuraient jusqu'à présent dans la procédure Button1Click.

Pour arrêter le programme, il est logique d'utiliser un bouton spécialisé. Pour cela, on rebaptise button1 en Arrêt (dans la propriété Caption) et dans le code, on insère les instructions suivantes :

listeMots.Free;Application.Terminate;

La première libère proprement la mémoire, et la seconde termine l'application.

Recherche et affichage d'un mot

Peu à peu, nous allons enrichir notre programme avec des fonctions de balayage, d'édition et de recherche. Il suffit pour cela d'un peu d'imagination, de plonger sur l'interface graphique et compléter le code en fonction de ce que nous désirons.

Interface graphique

Dans la fenêtre Lex2 nous glissons trois nouveaux composants :

1. Un TLabel qui affichera le mot cherché ; propriété Font, ligne Size : remplacer 0 par 14 ;

2. Un TEdit qui recevra la requête(4) ;

3. Un TButton qui déclenchera la requête, propriété Caption modifiée en Chercher.

La logique est simple : un clic sur le bouton Chercher devra déclencher la lecture du texte saisi dans le TEdit. Ce texte est comparé à la liste en mémoire ; s'il existe, il est affiché dans le TLabel.

Code

L'unité uLex2 comprend maintenant quatre procédures :

implementation

{ TForm1 }

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

procedure TForm1.Button2Click(Sender: TObject);
begin
Recherche(Edit2.Caption);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
listeMots := TStringList.Create;
iMot := 0;
LireFichier(listeMots);
Memo1.Append('Premier mot : '+listeMots[0]);
Memo1.Append('Dernier mot : '+listeMots[listeMots.Count-1]);
MAJAffichage;
//ListBox1.Items.Create;
end;

procedure TForm1.Recherche(nMot: string);
var iMot : integer;
begin
iMot := listeMots.IndexOf(nMot);
if iMot >= 0 then Label1.Caption:= listeMots[iMot]
else Label1.Caption:= 'échec';
Memo1.Append('Index '+IntToStr(iMot));
end;

end.

Un clic sur le bouton2 (Chercher) envoie le contenu du composant Edit2 à la procédure Recherche.

Si le mot n'est pas trouvé, la variable iMot est négative. Dans ce cas, l'afficheur indique « échec ».

Pour permettre de suivre l'activité de recherche, le Memo reçoit la valeur de l'index.

Une variante consisterait à entrer un numéro à la place d'un mot, mais son intérêt pratique est moins évident.

Les procédures Button ou FormCreate sont créées par le système, donc reconnues sans problème au moment de la compilation. Par contre, la procédure Recherche est ignorée si elle n'est pas déclarée dans la même rubrique que les autres, sous la ligne Tform1 = class(TForm).

Exécution

Un clic sur le petit triangle vert…

Le mémo affiche les premier et dernier mots.

Dans la zone d'édition, on entre le mot à chercher, par exemple « bonjour » : le résultat s'affiche. Si on cherche « bonjoux », on lit la mention « échec » ; le memo affiche un index de 33608(5) dans le premier cas, -1 dans le second.

Options de base

La liste de mots que nous utilisons pour l'instant constitue un trésor de référence : toute modification risque d'être dommageable avec l'omission d'un mot, par exemple, ou l'introduction d'une faute d'orthographe, ce qui serait consternant.

Pourtant, il est nécessaire de la modifier pour l'enrichir en fonction des besoins. Des options sont alors à prendre.

Les accents

Tout va bien, ou presque… Si on cherche « a », la recherche aboutit (index 0, qui correspond au premier mot de la liste). Si on cherche « à », on obtient un échec (index -1 alors que la liste contient bien ce mot à l'index 1). D'une façon générale, une erreur se présente pour tous les mots qui contiennent des lettres accentuées(6).

Dans le chapitre 1, nous avions pourtant constaté qu'un programme basique comme WordPad affichait correctement les lettres accentuées. Il y a donc un problème avec Lazarus…

Ce logiciel de programmation est en effet conçu pour s'adapter à toutes les langues (en tout cas à un maximum), et l'option retenue pour le traitement des chaînes de caractères est la norme UTF8. Les lettres accentuées sont traitées non comme un caractère unique, mais comme une séquence formée de plusieurs octets. Encore un effet de la mondialisation…

Au contraire, la norme ANSI, beaucoup plus ancienne, utilisée pour constituer la liste de mots que nous essayons maintenant de maîtriser, code tous les caractères par un unique octet. Avantage : fichiers plus courts, recherches plus rapides… Inconvénient : les procédures de traitement de texte ne s'appliquent plus automatiquement aux autres langues…

Heureusement, des passerelles existent. Passer d'un codage à un autre ne présente aucune difficulté. Il faut donc simplement choisir une option et adopter les passerelles disponibles pour qu'une chaîne de caractères ANSI soit convertie en UTF8 quand c'est nécessaire, et inversement.

Option 1 - Par souci d'homogénéité avec le fichier de mots, nous adopterons le codage ANSI pour notre projet de dictionnaire.
L'interface graphique de Lazarus sera donc alimentée par des chaînes à convertir en UTF8.
Mais la conversion du fichier de mots au standard UTF8 aurait eu également sa logique ! Elle pourrait se révéler nécessaire pour d'autres langues.

Majuscules

Contrairement aux accents, la recherche de mots contenant une ou des majuscules n'offre aucune difficulté : les essais avec « bonjour », « Bonjour » ou « bonJour » donnent le même résultat.

Si on se rappelle que les grilles de mots croisés utilisent exclusivement des lettres majuscules et sans accent, on peut conclure que tout va bien ainsi.

Mais si on a l'ambition d'introduire un peu de logique dans la recherche, la présence ou non de majuscules peut se révéler déterminante. Un pari, des paris, la ville de Paris... les concepts sont vraiment différents. Les mots corse, Corse, corsé s'écrivent de la même façon dans une grille de mots croisés, mais relèvent de définitions différentes… Ignorer les majuscules conduirait, comme pour les accents, à réduire fortement la qualité des informations que nous voulons traiter.

Et pourtant, la liste que nous consultons ne contient actuellement aucune majuscule ! Oui, mais nous devons l'ouvrir aux noms propres et étrangers, ainsi qu'aux abréviations, pour la rendre compatible avec les usages des mots croisés.

Option 2 - Les majuscules et les minuscules seront distinguées de façon à conserver le maximum de sens aux mots stockés.

Lettres accolées

Il existe une troisième convention, pas évidente mais adoptée implicitement, c'est celle des lettres accolées comme dans « cœur », ou « nævus »  : notre dictionnaire les considérera comme des lettres distinctes, c'est-à-dire que œ sera écrit et traité comme o suivi d'un e.

Option 3 - Les mots comme « cœur », « œdème », « sœur », etc. seront enregistrés et traités avec des lettres séparées.

Autres signes

Les définitions des mots croisés introduisent fréquemment des valeurs numériques, par exemple le code postal, la longueur d'un fleuve, l'âge du capitaine, etc. Pour autoriser ultérieurement une recherche, il est donc nécessaire d'autoriser ces caractères.

Par ailleurs, les traits-d'union sont escamotés dans les grilles : « Notre-Dame » s'écrira « NOTREDAME ». De même pour les espaces : « urbi et orbi » s'écrira « URBIETORBI ». Dans les deux cas, la première graphie est correcte, et la seconde réservée aux mots croisés, ce qui complique un peu les opérations d'enregistrement, de recherche et d'affichage. Pour autant, il reste nécessaire de conserver l'orthographe originale : c'est précisément celle qui est utilisée dans les définitions, point de départ de toute recherche. Il restera à soigner les résultats pour que leur format soit compatible avec celui d'une grille.

Option 4 - Les chiffres, les espaces et les traits-d'union seront acceptés dans notre dictionnaire.

Notre projet n'a pas l'ambition de concurrencer l'Académie. Il veut s'ouvrir à toutes les graphies, et esquiver toutes les querelles de chapelles. Les noms propres, étrangers, sigles et index numériques seront acceptés comme c'est l'usage dans les définitions de mots croisés.

Mais cette ouverture ne signifie pas laxisme, et une attention particulière sera portée à l'introduction de mots nouveaux.

Balayage mot par mot

Dans le menu de Lazarus, onglet Common Controls, on trouve le composant TUpDown qui est représenté par une double flèche haut-bas. Cliquez dessus, puis cliquez sur la fenêtre Lex2 pour le coller. Dans l'inspecteur d'objets, onglet Propriétés, ligne Orientation, choisissez le paramètre udHorizontal. Dans l'onglet Événements, ligne OnClick, cliquez sur les trois points pour provoquer la création de la procédure UpDown1Click.

Dans Lex2, élargissez le composant pour lui donner un aspect de navigateur : un clic sur la flèche droite devra afficher le mot suivant, et inversement.

Entre les mots begin et end de la procédure UpDown1Click entrez les quatre lignes suivantes :

if Button = btNext
then Inc(iMot) else Dec(iMot);
iMot := (iMot + listeMots.Count) mod (listeMots.Count);
MAJAffichage;

Dans la procédure FormCreate, il faut ajouter les instructions :

iMot:= 0 ;MAJAffichage ;

La procédure MAJAffichage se présente comme indiqué ci-dessous.

Enfin, la variable globale iMot doit être déclarée avant implementation, juste après listeMots, avec l'instruction

iMot : integer ;

Voici l'ensemble du code.

unit uLex2;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit2: TEdit;
Label1: TLabel;
Memo1: TMemo;
UpDown1: TUpDown;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Recherche(nMot : string);
procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
procedure MAJAffichage;
private
{ private declarations }
public
{ public declarations }
end;

var
Form1: TForm1;
listeMots: TStringList;
iMot : integer;

implementation

{ TForm1 }

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

procedure TForm1.Button2Click(Sender: TObject);
begin
Recherche(Edit2.Caption);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
listeMots := TStringList.Create;
iMot := 0;
LireFichier(listeMots);
Memo1.Append('Premier mot : '+listeMots[0]);
Memo1.Append('Dernier mot : '+listeMots[listeMots.Count-1]);
MAJAffichage;
end;

procedure TForm1.Recherche(nMot: string);
var iMot : integer;
begin
iMot := listeMots.IndexOf(nMot);
if iMot >= 0 then Label1.Caption:= listeMots[iMot]
else Label1.Caption:= 'échec';
Memo1.Append('Index '+IntToStr(iMot));
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then Inc(iMot)
else Dec(iMot);
iMot := (iMot + listeMots.Count) mod  listeMots.Count;
MAJAffichage;
end;

procedure TForm1.MAJAffichage;
begin
Label1.Caption:=listeMots[iMot];
Edit2.Caption:= '';
Memo1.Append('Index '+IntToStr(iMot));
end;

end.

Exécutez le programme : un clic sur l'une des flèches fait apparaître au choix le mot suivant ou le mot précédent. Rudimentaire, mais efficace.

Extension de l'espace graphique

Le tableau de commande est pour l'instant limité à cinq composants regroupés sur notre interface graphique. Que souhaitons-nous faire, maintenant que la liste de mots est entièrement accessible ? Nous pourrions par exemple, en vrac :

- ajouter un mot nouveau ;

- le placer au bon endroit ;

- le modifier ;

- le supprimer, avec dans les deux cas un contrôle du classement ;

- ajouter une information spécifique à ce mot ;

- éditer à volonté cette information : la modifier ou même la supprimer ;

- regrouper plusieurs mots ensemble, si un lien logique (ou culturel…) existe entre eux ;

- éditer ces liens (modification, suppression…) ;

- permettre l'introduction de plusieurs mots dans une requête et analyser les liens éventuels ;

- enregistrer les modifications et, progressivement, enrichir la base de connaissances ;

- lier un fichier rassemblant notes et rappels divers…

Ouf, cela fait déjà un beau programme, mais il est bon de se rappeler que ses limites sont celles que l'on voudra lui donner…

Pour l'instant, nous allons agrandir l'espace graphique affecté à notre programme.

III-7 - Introduction d'onglets

Au lieu de partir de zéro(7), nous allons utiliser la fenêtre existante (Lex2) en ajoutant un composant TPageControl (dans le menu Lazarus, cliquez sur l'onglet(8) Common Controls).

Faites un clic droit dans sur ce composant pour faire apparaître le menu contextuel, et choisissez la première ligne :

Ajouter une page

Renommez (Caption) cette page en Page1.

Les transferts des composants déjà installés peuvent maintenant commencer.

Label1 : cliquez dessus pour le sélectionner, clic droit, choisissez Couper ; cliquez sur la page 1 et collez le label.

Procédez de même pour les autres composants, en déplaçant si nécessaire le composant PageControl.

Lorsque la fenêtre d'origine est vide, il est possible d'agrandir le composant PageControl pour qu'il occupe la totalité de la surface disponible. L'ensemble peut être ajusté pour que la fenêtre ressemble plus ou moins à celle d'origine… mais avec un avantage certain puisque, à la page 1, il est possible d'ajouter autant de pages que nécessaire.

En principe, le programme reste totalement opérationnel. Pour le vérifier, cliquez sur le petit triangle vert ; notez les erreurs éventuelles, corrigez et relancez… Cliquez sur le carré rouge pour revenir en position d'édition.

Conclusion

Nous disposons maintenant de la matière (la liste de mots), d'un outil (Lazarus), d'une interface graphique modulable et… de quelques idées directrices pouvant servir de feuille de route : le prochain chapitre s'intéressera à différentes techniques d'affichage.

Diamantaire : suit le cours des rivières.
Tristan Bernard

Rappelons avant de terminer le code de l'unité uDisque :

L'unité uDisque

unit uDisque;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils;

procedure LireFichier(listeMots : TstringList);

implementation

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

end.

L'unité principale uLex2 se présente maintenant comme suit :

L'unité uLex2

unit uLex2;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit2: TEdit;
Label1: TLabel;
Memo1: TMemo;
PageControl1: TPageControl;
Page1: TTabSheet;
UpDown1: TUpDown;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Recherche(rechMot: string);
procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
procedure MAJAffichage;
private
{ private declarations }
public
{ public declarations }
end;

var
Form1: TForm1;
listeMots: TstringList;
iMot : integer;

implementation

{$R *.lfm}

{ TForm1 }

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

procedure TForm1.Button2Click(Sender: TObject);
begin
Recherche(Edit2.Caption);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
listeMots := TStringList.Create;
LireFichier(listeMots);
Memo1.Append('Premier mot : '+listeMots[0]);
Memo1.Append('Dernier mot : '+listeMots[listeMots.Count-1]);
iMot := 0;
MAJAffichage;
end;

procedure TForm1.Recherche(rechMot: string);
var iMot : integer;
begin
iMot := listeMots.IndexOf(rechMot);
if iMot >= 0 then Label1.Caption:= listeMots[iMot]
else Label1.Caption:= 'échec';
Memo1.Append('Index '+IntToStr(iMot));
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then Inc(iMot)
else Dec(iMot);
iMot := (iMot + listeMots.Count)   mod  (listeMots.Count);
MAJAffichage;
end;

procedure TForm1.MAJAffichage;
begin
Label1.Caption:=listeMots[iMot];
Edit2.Caption:= '';
Memo1.Append('Index '+IntToStr(iMot));
end;

end.

Une lecture attentive permet de déceler, dans la deuxième procédure, la fonction UTF8ToANSI qui convertit la saisie dans le TEdit (standard UTF8) au standard ANSI adopté pour la liste de mots. Cette passerelle permet de lancer des recherches sur des mots incluant des lettres accentuées. L'opération inverse est réalisée simplement par la fonction ANSIToUTF8.

Onglet Balayage

Introduction

Notre projet comprend maintenant, outre une liste de mots impressionnante, une interface graphique qui permet de chercher et d'afficher n'importe quel élément de la liste.

Dans le présent chapitre seront abordées différentes techniques de navigation et d'affichage.

Environnement

Avant d'opérer les premières modifications, nous allons créer un nouveau répertoire, Lex3, et y recopier tous les fichiers du répertoire Lex2 : de cette façon, il sera toujours facile de retrouver notre projet dans un état antérieur.
Lancez Lazarus, dans le répertoire Lex3, ouvrez le projet Lex2.lpi et sauvegardez l'unité uLex2 sous le nom uLex3 ; de même pour le projet, qui prendra le nom de pLex3.pas. Acceptez la suppression des anciens fichiers. L'unité uDisque reste inchangée. Nettoyez le répertoire de tous les fichiers dont le nom inclut « Lex2 ».
Nous allons introduire de nouveaux composants : un curseur, un ListBox, deux boutons de navigation et un outil de zoom.
Dans l'état, notre interface graphique est insuffisante.
La fenêtre est extensible, en hauteur comme en largeur, ce qui dégagerait de l'espace pour de nombreux composants ; mais ce choix conduirait rapidement à une interface complexe donc difficilement utilisable.
Comment enrichir cette interface en conservant une ergonomie satisfaisante ? Rien de plus simple : cliquez sur la ligne en gris, à la hauteur et à droite de Page1. Clic droit pour faire apparaître le menu contextuel ; choisir Ajouter une page…
Dans la fenêtre Inspecteur d'objets, onglet Propriétés, ligne Caption, remplacez TabSheet1 par Balayage. Le nouvel espace de travail est disponible.

Curseur

Dans le menu Lazarus, onglet Common Controls, cliquez sur le deuxième composant (TTrackBar) ; cliquez maintenant sur l'interface graphique, onglet Balayage : le composant est installé. Placez-le en haut de la page et élargissez-le pour qu'il occupe toute sa largeur. Dans la fenêtre Inspecteur d'objets, fixez la propriété Max à 1000.

Ajoutez un TLabel ; propriétés Font, Size, fixez la taille à 14.
Cliquez sur le composant Curseur ; dans l'inspecteur d'objets, onglet Événements, propriété OnMouseLeave, cliquez sur les trois points : l'éditeur de source fait apparaître une nouvelle procédure, intitulée TrackBar1MouseLeave.
Entre les directives begin et end recopiez les lignes suivantes :

iMot := Round(TrackBar1.Position*listeMots.Count/1000);
iMot := (iMot + listeMots.Count) mod  (listeMots.Count);
Label2.Caption:=AnsiToUTF8(listeMots[iMot]);

- la première ligne calcule la position du mot à partir de la position du curseur. Round retourne un nombre entier ;

- la seconde ligne - nous l'avons déjà rencontrée - encadre le résultat dans l'intervalle disponible ;

- enfin la troisième affiche le mot correspondant avec la conversion ANSI vers UTF-8, qui résout le problème d'affichage des caractères accentués.

Essayez… le balayage est extrêmement rapide, mais… reste grossier puisque pour une unité du curseur, iMot varie de 340 environ.

En effet, le curseur contient 1000 graduations et la liste environ 336 000 entrées.
Pour le vérifier, ajoutez un second TLabel sous le premier. Au code précédent, ajoutez la ligne
Label3.Caption:= IntToStr(iMot);
Relancez le programme et déplacez le curseur, non avec la souris, trop imprécise, mais avec les flèches droite/gauche du clavier.
Prenez soin de supprimer ce composant et la ligne de code avant de poursuivre.

ListBox

L'affichage mot par mot va être complété par la présentation des dix mots qui encadrent celui qui est affiché en titre, de façon à situer la consultation dans son contexte.
Dans l'onglet Standard du menu Lazarus, cliquez sur le composant TListBox situé juste après le TRadioButton. Cliquez ensuite sur notre interface graphique, dans l'onglet Balayage, et agencez l'ensemble sensiblement comme ci-dessous.

Dans l'inspecteur d'objets, onglet Propriétés :

- ligne BorderStyle, faites basculer la valeur bsSingle vers bsNone, pour faire disparaître le cadre ;

- ligne Name, entrez AffListe.

Il est possible de charger la liste de mots complète dans le nouveau composant : des ascenseurs permettent théoriquement de naviguer d'une extrémité à l'autre de la liste.
Dans la pratique, il se révèle que le chargement est long, et la navigation laborieuse. Les plus courageux feront la vérification.
Pour la suite du projet, nous limiterons par conséquent l'affichage de la liste à un nombre réduit d'entrées de part et d'autre du mot affiché en titre.

Revenons au code pour modifier la procédure TrackBar1MouseLeave. Les instructions sont les suivantes :

procedure TForm1.TrackBar1MouseLeave(Sender: TObject);
var i, iMin, iMax : integer;
begin
iMot := Round(TrackBar1.Position*listeMots.Count/1000);
iMot := (iMot + listeMots.Count) mod  listeMots.Count;
Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
AffListe.Clear;
iMin := iMot - 5;
if iMin < 0 then iMin :=0;
iMax := iMot + 5;
if iMax > listeMots.Count - 1 then iMax := listeMots.Count - 1 ;
for i := iMin to iMax do
AffListe.Items.Add(AnsiToUTF8(listeMots[i]));
AffListe.Selected[5] := True;
end;

Après avoir nettoyé la ListBox, le programme affiche tous les mots dont les index vont de iMot-5 à iMot+5, en assurant aux limites (iMin et iMax) de rester dans le cadre autorisé.
La dernière instruction sélectionne le mot titre avec surlignement graphique.
Avant de lancer l'exécution, il faut revenir en tête de l'unité uLex3 pour déclarer la nouvelle variable :

AffListe : TlistBox;

Lancez l'exécution. Un déplacement du curseur fait apparaître le mot correspondant à l'index choisi, accompagné, au-dessous, des mots les plus proches.

Le mot « mimosa » figure en titre ; il est surligné dans la liste qui affiche les cinq mots précédents et les cinq mots suivants.
Avant de poursuivre le développement, nous allons structurer un peu le code en regroupant dans la procédure MAJBalayage toutes les instructions réservées à l'affichage.
Par ailleurs, le code utilisé révèle des difficultés en limites de listes. Les variables iMin et iMax deviennent inutiles si on envisage une permutation circulaire de la liste en utilisant la fonction Modulo. En outre, il est bon de synchroniser la position du curseur avec la nouvelle valeur de l'index iMot.
La procédure précédente est donc scindée en deux et modifiée en conséquence :

procedure TForm1.MAJBalayage;
var i : integer;
begin
Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
TrackBar1.Position:= Round(iMot*1000/listeMots.Count);
AffListe.Clear;
for i := 0 to 10 do
AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-5 + i + ListeMots.Count) mod              ListeMots.Count]));
AffListe.Selected[5] := True;
end;

procedure TForm1.TrackBar1MouseLeave(Sender: TObject);
begin
iMot := Round(TrackBar1.Position*listeMots.Count/1000);
iMot := (iMot + listeMots.Count) mod  listeMots.Count;
MAJBalayage;
end;

Attention à la nouvelle procédure MAJBalayage : pour s'assurer que le compilateur la localise correctement, il convient de commencer par l'ajouter à la liste des procédures, avant le mot Implementation. En fin de saisie, un appui sur les touches Ctrl+Maj+C crée la procédure dans le corps de l'unité, où les instructions pourront être recopiées sans difficulté.

La deuxième procédure effectue les calculs et passe la main à la première.
Pour que l'onglet Balayage soit correctement renseigné dès le démarrage, on ajoute dans la procédure FormCreate l'instruction :

MAJBalayage;

Est-il possible de sélectionner un autre mot dans la liste ?
Il suffit pour cela d'utiliser l'événement OnClick du composant.
Quittez le mode exécution (carré rouge), sélectionnez le composant AffListe, et dans la fenêtre Inspecteur d'objets, onglet Événements, ligne OnClick, cliquez sur les trois points : la procédure adéquate est créée dans la fenêtre de code.
Entre les directives begin et end recopiez les lignes :

iMot := (iMot -5 + AffListe.ItemIndex + listeMots.Count) modlisteMots.Count;
MAJBalayage;

Passez en mode exécution (triangle vert), déplacez le curseur, cliquez sur le navigateur, cliquez sur un mot de la liste… Test sur les limites, action sur le curseur, utilisation des flèches du clavier… tout fonctionne correctement.
Le balayage commence à se construire. Mais… il reste grossier puisque le curseur a un pas de 340, et la liste affiche seulement 11 entrées. Un outil supplémentaire est indispensable pour se déplacer.

Navigateur

Dans le menu Lazarus, cliquez sur le petit carré rouge pour revenir en mode Édition.
Dans l'onglet Common Controls, cliquez sur le composant TUpDown (déjà vu), puis cliquez sur notre interface, onglet Balayage : le nouveau composant est installé.
Dans la fenêtre Inspecteur d'objets, onglet Propriétés, choisissez la valeur udHorizontal à la ligne Orientation.
Avec la souris, déplacez et modifiez la forme du composant pour obtenir sensiblement ceci :

Dans la fenêtre Inspecteur d'objets, onglet Événements, ligne OnClick, cliquez sur les trois points.
Dans l'éditeur, entre les mots begin et end recopiez les instructions suivantes :

if Button=btNext then Inc(iMot, UpDown2.Increment)
else Dec(iMot, UpDown2.Increment);
iMot := (iMot + listeMots.Count) mod  (listeMots.Count);
MAJBalayage;

- la première ligne déclenche l'incrémentation de l'index iMot. La valeur de l'incrément est précisée par le paramètre UpDown2.Increment qui, par défaut, vaut 1 (voir les propriétés de l'objet) ;

- la seconde replace la variable iMot dans l'intervalle autorisé ;

- la troisième provoque la mise à jour de l'affichage.

Lancez l'exécution… Le balayage un par un fonctionne, mais reste réellement insuffisant : d'où la nécessité de rendre le pas (incrément) modifiable.

Zoom

Stoppez l'exécution pour revenir en mode Édition.
Nous allons ajouter un composant TGroupBox, qui se situe dans l'onglet Standard du menu Lazarus : clic sur ce composant, clic sur notre interface pour l'installer. Dans l'onglet Propriétés de ce composant, ligne Caption, écrivez le mot Zoom.
Dans le GroupBox(9), nous allons placer quatre composants TRadioButton, dont les propriétés Caption seront fixées respectivement à x1, x10, x100 et x1000. Sélectionnez le premier composant et portez, dans l'inspecteur d'objets, sa propriété Checked à True : il s'agit d'une valeur par défaut, modifiable évidemment pendant l'exécution.
À l'aide de la souris, modifiez la présentation pour obtenir une interface qui ressemble à celle qui est présentée :

Sélectionnez le GroupBox. Dans l'onglet Événements, ligne OnMouseLeave, cliquez sur les trois points. Entre les mots begin et end recopiez les instructions suivantes :

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;

Lancez l'exécution, testez le curseur, le navigateur, le zoom, la sélection dans la liste…
Enfin une interface qui tient la route.

L'événement OnMouseLeave se déclenche lorsque le curseur de la souris quitte l'espace graphique réservé au composant GroupBox : pour modifier le pas de balayage, l'utilisateur doit cliquer sur l'un des RadioButton ; dès que la souris sera appelée pour une autre tâche (curseur, navigateur, liste…) la valeur de l'incrément sera mise à jour.

Conclusion

Nous disposons maintenant d'une interface graphique extensible à volonté, et d'un outil pratique pour consulter facilement notre liste de mots.
Il nous faut maintenant l'enrichir en permettant à l'utilisateur d'ajouter à chacune des entrées telle ou telle information qu'il jugerait utile.
Dans le prochain chapitre, nous verrons comment lier un mot à un nombre, un mot ou un texte, et enregistrer ce lien.

Notaire : arrive souvent au dernier acte.
Tristan Bernard

Dans l'état actuel du projet, l'unité uDisque reste inchangée. Voyons comment se présente l'unité uLex3.

1. La liste de mots est affichée avec les cinq mots qui précèdent le mot titre, et les cinq mots suivants. Pour fixer ce choix, nous créons la constante delta qui vaut 5. Les modifications de la taille seront ainsi facilitées en cas de besoin.

2. Au démarrage, il est préférable que l'onglet Balayage soit mis à jour correctement : il suffit pour cela d'ajouter l'instruction MAJBalayage dans la procédure FormCreate.

3. Par ailleurs, on retrouve fréquemment la variable ListeMots.Count qui compte le nombre d'entrées dans la liste principale. Pour alléger l'écriture et gagner en temps d'exécution, il sera judicieux de la remplacer par une variable globale, nMots par exemple : nous la mettrons en œuvre dans le chapitre suivant.

unit ulex3;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit2: TEdit;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
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 FormCreate(Sender: TObject);
procedure Recherche(rechMot: string);
procedure TrackBar1MouseLeave(Sender: TObject);
procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
procedure MAJAffichage;
procedure MAJBalayage;
procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
procedure ZoomMouseLeave(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

const delta=5;

var
Form1: TForm1;
listeMots: TstringList;
iMot : integer;

implementation

{$R *.lfm}

{ TForm1 }

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

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

procedure TForm1.Button2Click(Sender: TObject);
begin
Recherche(Edit2.Caption);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
listeMots := TStringList.Create;
LireFichier(listeMots);
Memo1.Append('Premier mot : '+listeMots[0]);
Memo1.Append('Dernier mot : '+listeMots[listeMots.Count-1]);
iMot := 0;
MAJAffichage;
MAJBalayage;
end;
procedure TForm1.MAJBalayage;
var i : integer;
begin
Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
TrackBar1.Position:= Round(iMot*1000/listeMots.Count);
AffListe.Clear;
for i := 0 to 10 do
AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-delta + i
+ ListeMots.Count) mod ListeMots.Count]));
AffListe.Selected[delta] := True;
end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then Inc(iMot, UpDown2.Increment)
else Dec(iMot, UpDown2.Increment);
iMot := (iMot + listeMots.Count) mod  (listeMots.Count);
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.TrackBar1MouseLeave(Sender: TObject);
begin
iMot := Round(TrackBar1.Position*listeMots.Count/1000);
iMot := (iMot + listeMots.Count) mod  listeMots.Count;
MAJBalayage;
end;

procedure TForm1.Recherche(rechMot: string);
var iMot : integer;
begin
iMot := listeMots.IndexOf(rechMot);
if iMot >= 0 then Label1.Caption:= listeMots[iMot]
else Label1.Caption:= 'échec';
Memo1.Append('Index '+IntToStr(iMot));
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then Inc(iMot)
else Dec(iMot);
iMot := (iMot + listeMots.Count)   mod  (listeMots.Count);
MAJAffichage;
end;

procedure TForm1.MAJAffichage;
begin
Label1.Caption:=listeMots[iMot];
Edit2.Caption:= '';
Memo1.Append('Index '+IntToStr(iMot));
end;

end.

Premiers liens

Introduction

Notre liste de mots peut maintenant faire l'objet d'une consultation aisée, mais son utilité reste modeste puisque l'accès à un mot donné, aussi rapide soit-il, débouche sur… le néant ! Dans ce chapitre, nous allons voir comment attacher une information à ce mot, la stocker et la retrouver.

Environnement

Chapitre 5… Adoptons cet indice pour cette phase du projet : il n'y aura pas de répertoire Lex4.

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

- ouvrir pLex3.lpi dans Lex5 avec Lazarus ;

- enregistrer uLex3.pas sous le nom de uLex5.pas ;

- accepter la suppression des références à uLex3.pas ;

- enregistrer pLex3.pas sous le nom de pLex5.pas ;

- renommer la fenêtre Form1 : Lex3 devient Lex5 ;

- dans le répertoire Lex5 supprimer les anciens fichiers contenant la mention Lex3 ;

- relancer le projet en ouvrant pLex5.lpi avec Lazarus ;

- renommer l'interface graphique de Lex3 à Lex5.

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 conservée dans le répertoire Lex3.

Code

Pour alléger l'écriture du code, nous allons remplacer dans l'unité uLex5 toutes les occurrences de « listeMots.Count » par « nMots ».

Dans la procédure FormCreate, nous initions la variable par l'instruction :

nMots:= listeMots.Count ;

Nous complétons enfin la liste des variables globales (avant le bloc implementation) par la déclaration :

iMot, nMots : integer ;

Un essai d'exécution (petit triangle vert) pour vérifier que tout va bien…

Au plan graphique, un espace supplémentaire est nécessaire. Nous avons déjà vu que ce n'était pas compliqué.

Dans la fenêtre Lex5, clic droit sur la ligne en grisé, à droite de l'onglet Balayage. Dans le menu contextuel, choisissez Ajouter une page.

Dans la fenêtre Inspecteur d'objets, onglet Propriétés, remplacez TabSheet (ou Page, selon le composant utilisé) par Info, à la ligne Caption.

Le nouvel espace de travail est disponible.

Événement TrackBar1

Lors de la mise en place du composant TrackBar, qui donne un aperçu de la position du mot dans la liste principale, nous avons choisi d'utiliser l'événement onChange pour actualiser la relation entre la position du curseur et la valeur de l'index.

Il apparaît que des interférences peuvent perturber le balayage de la liste, notamment lors de l'utilisation d'un filtre.

Pour éviter ce type de problème dans la suite de notre projet, nous décidons d'abandonner cette procédure et d'utiliser à la place l'événement MouseUp, qui se déclenche tout simplement dès que le bouton de la souris est relâché à la fin du déplacement du curseur.

Voici la marche à suivre :

- cliquer sur le composant TrackBar dans l'onglet Balayage ;

- dans l'inspecteur d'objets, onglet Événements, ligne OnMouseUp, cliquer sur les trois points ;

- dans l'éditeur de source, entre les mots begin et end, recopier les instructions qui figuraient dans la procédure TrackBar1Change :

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;

Toujours dans l'éditeur de source, supprimez complètement l'ancienne procédure, y compris sa déclaration avant implémentation. Dans l'inspecteur d'objets, onglet Événement, supprimez toute référence dans la ligne OnChange.

Un clic sur le petit triangle vert, vérifiez que votre curseur fonctionne bien…

Le conteneur de la liste de mots (StringList) possède une structure dotée de nombreuses propriétés dont certaines permettent de lier un élément de la liste à une information externe :

- utilisation du couple Nom-Valeur ;

- utilisation de la propriété Object.

Nous allons aborder leur mise en œuvre pour les évaluer.

Couple Nom-Valeur

C'est la solution la plus simple : elle est précâblée dans la liste, il est donc inutile d'entrer dans le cambouis. Pratique pour faire correspondre le nom d'une personne avec un numéro d'identification, une commune avec un code postal, etc.

Pour l'utiliser, il suffit d'affecter une chaîne quelconque à un élément de la liste.

Supposons que l'on s'intéresse au mot « a » et que l'on veuille le relier au mot « voyelle », il suffit d'écrire, en remplacement du premier mot :

'a=voyelle'

pour établir la liaison.

À chaque fois que l'on consultera le premier mot, le lien sera activé.

Il ne s'agit pas d'affecter une valeur à une variable.
Le signe « = » est le caractère de séparation par défaut. On peut en changer, par exemple avec « > ».
Dans ce cas, il faudra ajouter, dans la procédure de création de la liste, l'instruction :
listeMots.NameValueSeparator:='>' ;

Notons que la propriété Value est alphanumérique, ce qui permet d'introduire, au choix, des expressions numériques ou littérales.

Dans l'onglet Info, nous ajoutons successivement :

- un Label (Propriété Font/Size portée à 14) ;

- un Memo (Propriété ScrollBars portée à ssAutoVertical) ;

- un Edit ;

- et un bouton (Propriété Caption portée à Value).

Après divers agencements, l'onglet Info se présente sensiblement comme ceci :

Valeur littérale

Un double-clic sur le bouton Value crée le squelette de la procédure événement dans l'éditeur de source. Entre les mots begin et end, on place l'instruction :

MAJInfo ;

procedure TForm1.Button3Click(Sender: TObject);
begin
MAJInfo;
end;

Pour créer la procédure MAJInfo, nous commençons par la déclarer en tête de l'unité, dans la classe Tform, à la suite des autres procédures. Un appui sur les touches Ctrl+Maj+C crée la structure recherchée ; entre les mots begin et end, nous recopions :

procedure TForm1.MAJInfo;
begin
listeMots[0] := 'a=voyelle';
Label3.Caption:= listeMots.Names[0];
Edit1.Caption:= listeMots.Values[listeMots.Names[0]];
Memo2.Append('en mémoire : '+listeMots[0]);
end;

La première instruction institue le lien voulu, en remplacement de la chaîne qui existait auparavant.

La seconde affiche la partie gauche de l'élément (propriété Names).

La troisième affiche la partie droite (propriété Values) ; il faut remarquer que l'index n'est plus numérique, c'est la partie gauche de l'élément qui constitue le nouvel index.

La quatrième ligne affiche l'élément au complet.

Pour vérifier ces indications, cliquez sur le petit triangle vert, puis sur le bouton Value.

Utilisez le balayage dans l'onglet précédent : après un aller et retour sur le mot courant, on peut constater que la chaîne d'origine a bien été remplacée par un binôme.

Les autres chaînes n'ont pas été modifiées et s'affichent correctement. Dans l'onglet Info, le mot titre est bien « a » qui est bien relié au mot « voyelle ».

1. La procédure MAJBalayage peut être modifiée pour que soit affichée en titre non pas l'enregistrement complet correspondant à l'index iMot, mais seulement sa partie gauche (Names[iMot]).

2. L'enregistrement de la liste « enrichie » est aisé : il suffit d'utiliser l'instruction SaveToFile().

Mais attention à ne pas écraser la liste d'origine !
En cas de problème, remplacez le fichier corrompu par celui qui est resté dans le répertoire Lex3.

Valeur numérique

L'intérêt du lien entre le mot « a » et l'information « voyelle » est incontestable, mais… limité. D'autant qu'il n'est pas réversible : en l'état, si on consulte le mot « voyelle », aucune indication n'est donnée quant à son lien avec le mot « a ».

Et si, par excès de zèle, on décide d'établir la réciprocité au moyen de l'instruction 'voyelle=a', nous arrivons à une absurdité, puisque « a » n'est pas la seule voyelle, et que notre système ne permet pas l'établissement de liens multiples…

Un lien numérique est autrement plus puissant : le nombre éventuellement détecté peut servir d'index dans une table auxiliaire qui regrouperait une collection d'objets quelconques, par exemple des textes, des images, des sons, etc.

Nous allons voir comment procéder avec quatre mémos qui seront affectés respectivement aux mots « couleur », « teinte », « vert » et « rouge »(le désordre est intentionnel).

Saisie des mémos

Une consultation rapide de Wikipedia nous donne un peu de matière (totalement dépourvue d'humour, désolé…) pour nos mémos. Chaque texte va être stocké(10) dans une chaîne (string) et les quatre chaînes dans une liste (StringList). Pour commencer, il faut déclarer la nouvelle variable globale listeInfo : TStringList avant implementation :

Nous créons la procédure regInfo qui se chargera de placer les chaînes en mémoire :

- déclarez procedure regInfo ; avant implementation ;

- appuyez sur Ctrl+Maj+C pour créer le squelette de la procédure ;

- entre les mots clés begin et end recopiez les instructions :

procedure TForm1.regInfo;
begin
listeInfo := TstringList.Create;
//indice 0
listeInfo.Add('Resa');
//indice 1
listeInfo.Add('La couleur est la perception subjective qu''a un animal '
+'d''une ou plusieurs fréquences d''ondes lumineuses, '
+'avec une (ou des) amplitude(s) donnée(s), au travers de sa vision oculaire.');
//indice 2
listeInfo.Add('Une teinte est la forme pure d''une couleur, '
+'c''est-à-dire sans adjonction de blanc ou de noir qui permettent d''obtenir '
+'ses nuances. Les teintes sont visualisées sur le pourtour d''une roue       chromatique.');
//indice 3
listeInfo.Add('La perception de la couleur verte est évoquée par la lumière d''un'
+' spectre dominé par de l''énergie avec une longueur d''onde d''environ 520-570 nm.');
//indice 4
listeInfo.Add('Le rouge est, sur le cercle chromatique, une des trois couleurs '
+'(avec le jaune et le bleu) primaires. Pour la théorie ondulatoire de la lumière, '
+'son rayonnement se situe entre l''orange et l''infrarouge du spectre électromagnétique.');
end;

Les indices 1 à 4 correspondent aux chaînes associées aux mots « couleur », « teinte », « vert » et « rouge ».
Une lecture attentive permet de remarquer que l'indice 0 est utilisé implicitement pour adresser le mot « Resa »qui ne sert à rien… sinon à éviter les pièges de l'indice zéro.
Notez à nouveau que l'ordre des mots est indifférent.

Pour automatiser cette procédure, nous allons l'ajouter à la liste des tâches réalisées lors de la création de la fiche :

procedure TForm1.FormCreate(Sender: TObject);
begin
listeMots := TStringList.Create;
LireFichier(listeMots);
nMots:= listeMots.Count;
Memo1.Append('Premier mot : '+listeMots[0]);
Memo1.Append('Dernier mot : '+listeMots[nMots-1]);
iMot := 0;
regInfo;
MAJAffichage;
MAJBalayage;
end;

Un clic sur le bouton Value doit réaliser les liens entre les mots-clés et les chaînes correspondantes :

procedure TForm1.Button3Click(Sender: TObject);
begin
listeMots[listeMots.IndexOf('couleur')] := 'couleur=1';
listeMots[listeMots.IndexOf('teinte')] := 'teinte=2';
listeMots[listeMots.IndexOf('vert')] := 'vert=3';
listeMots[listeMots.IndexOf('rouge')] := 'rouge=4';
end;

La procédure modifie la liste de mots (liste principale) en ajoutant aux mots choisis le numéro du texte les concernant, mots et numéros étant séparés par le signe « = ».

Cliquez sur le petit triangle vert pour exécuter le programme :

- la création de la fenêtre provoque la mise en mémoire de quatre textes ;

- un clic sur le bouton Value remplace les mots choisis par le couple mot=index.

Dans l'onglet Balayage, cherchez un des mots-clés, par exemple « teinte » et vérifiez que le mémo correspondant s'affiche.

Affichage

L'onglet Balayage permet d'atteindre n'importe quel mot de la liste. Nous allons le compléter pour qu'il affiche, à côté du mot, le mémo qui lui est affecté, s'il existe.

Dans le menu Lazarus, cliquez sur le composant TMemo, puis cliquez sur l'onglet Balayage et placez le composant à droite du zoom ; dans l'onglet Propriétés de l'Inspecteur d'objets, ligne ScrollBars, choisissez ssAutoVertical pour faire apparaître un ascenseur.

Les procédures MAJBalayage et MAJInfo sont modifiées comme suit :

procedure TForm1.MAJBalayage;
var i : integer;
begin
Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
Label3.Caption:= Label2.Caption;
TrackBar1.Position:= Round(iMot*1000/nMots);
AffListe.Clear;
for i := 0 to 10 do
AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-5 + i
+ nMots) mod nMots]));
AffListe.Selected[5] := True;
Memo3.Clear;
if (Pos('=', listeMots[iMot])>0) then MAJInfo;
end;

procedure TForm1.MAJInfo;
begin
//listeMots[0] := 'a=voyelle';
Label3.Caption:= listeMots.Names[iMot];
Edit1.Caption:= listeMots.Values[Label3.Caption];
Memo2.Clear;
Memo2.Append(listeInfo[StrToInt(Edit1.Caption)]);
Label2.Caption:= listeMots.Names[iMot];
Memo3.Append(listeInfo[StrToInt(Edit1.Caption)]);
end;

Le programme est opérationnel.

Pour le vérifier, clic sur le petit triangle vert. Dans l'onglet Info, clic sur le bouton Value pour lier les mémos à la liste principale.

Dans l'onglet Balayage, actionnez le curseur et les flèches de navigation, en utilisant le zoom si nécessaire, et vérifiez que, pour chacun des mots « couleur », « teinte », « vert » et « rouge », le mémo correspondant s'affiche.

Navigation

La recherche de nos mots « renseignés » se révèle fastidieuse : la liste principale est immense et il faut beaucoup de manœuvres pour les retrouver.

Un filtre va régler ce problème.

Dans l'onglet Balayage, on ajoute un CheckBox, propriété Caption modifiée avec « Filtre ».

Dans l'onglet Événements, ligne OnChange, cliquez sur les trois points pour provoquer la création de la procédure CheckBox1Change, où l'on insérera les lignes :

if CheckBox1.Checked then CheckBox1.Caption := 'Avec filtre'

else CheckBox1.Caption := 'Sans filtre';

La procédure UpDown2 est modifiée pour traiter le cas où la case est cochée (filtre actif) :

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

Si une flèche est cliquée alors que le filtre est actif, la liste de mots est balayée automatiquement jusqu'à ce qu'un mot « renseigné » (décelé par la présence du signe « = ») apparaisse.

Relancez le programme. Dans l'onglet Info, cliquez sur le bouton Value pour établir les liens. Dans l'onglet Balayage, activez le filtre et… naviguez.

Développements complémentaires

Chaque mot peut maintenant être relié au texte de son choix.

Par exemple, le mot « rouge » est présenté avec une notice immédiatement accessible.

Mais il reste à faire pour que le programme soit réellement opérationnel : il manque notamment les procédures d'édition (modification, suppression, ajout, enregistrement) des mémos.

Notez que la suppression d'un lien au niveau de la liste principale devra être suivie par sa suppression du mémo correspondant dans la liste secondaire.

Ces étapes sont plus simples, et nous aurons l'occasion d'y revenir.

Propriété Object

Pour simplifier, nous dirons que cette propriété fonctionne comme la précédente, sous réserve de remplacer l'affectation

listeMots[listeMots.IndexOf('rouge')] := 'rouge=4' ;

par l'instruction

listeMots.Objects[listeMots.IndexOf('rouge')]:= Tobject(4) ;

Dans le premier cas, le lien s'établit sous forme d'une chaîne de caractères qui remplace (complète) la chaîne de caractères existante ; dans le second, le lien est réalisé par un pointeur : la chaîne de caractères reste inchangée mais se trouve liée à un « objet ». Là débute un aspect de l'informatique un peu plus complexe, celui des pointeurs(11). Notre projet a pour ambition de rendre toutes les opérations facilement accessibles, donc l'expérimentation restera succincte.

Rappelons, pour commencer, que le lien peut viser n'importe quel type d'information, que ce soit des images, du son, des fichiers PDF… Ici, nous reprendrons l'adressage de texte.

Saisie des mémos

Sur l'interface graphique, onglet Info, nous ajoutons un bouton, propriété Caption portée à Object.

Un double-clic sur ce composant crée la structure de la procédure :

procedure TForm1.Button4Click(Sender: TObject);
begin
listeMots.Objects[listeMots.IndexOf('couleur')] := TObject(1);
listeMots.Objects[listeMots.IndexOf('teinte')] := TObject(2);
listeMots.Objects[listeMots.IndexOf('vert')] := TObject(3);
listeMots.Objects[listeMots.IndexOf('rouge')] := TObject(4);
end;

En somme, c'est la même procédure que pour le bouton Value, avec les modifications propres aux liens-objets.

Notez encore que l'affectation des objets se fait sans tenir compte de l'ordre alphabétique des mots.

Affichage

Les procédures MAJBalayage et MAJInfo sont modifiées comme suit :

procedure TForm1.MAJBalayage;
var i : integer;
begin
Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
Label3.Caption:= Label2.Caption;
//Label2.Caption:=AnsiToUTF8(listeMots.Names[iMot]);
TrackBar1.Position:= Round(iMot*1000/nMots);
AffListe.Clear;
for i := 0 to 10 do
AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-5 + i + nMots) mod nMots]));
AffListe.Selected[5] := True;
Memo3.Clear;
if (Pos('=', listeMots[iMot])>0) then MAJInfo;
if  listeMots.Objects[iMot]<> nil then MAJInfo;
end;

procedure TForm1.MAJInfo;
begin
Label3.Caption:= listeMots.Names[iMot];
//Edit1.Caption:= listeMots.Values[Label3.Caption];
//Memo2.Clear;
//Memo2.Append(listeInfo[StrToInt(Edit1.Caption)]);
//Label2.Caption:= listeMots.Names[iMot];
//Memo3.Append(listeInfo[StrToInt(Edit1.Caption)]);
Memo3.Append(listeInfo[integer(listeMots.Objects[iMot])]);
end;

Notez la dernière ligne de la première procédure : elle contrôle l'existence d'un objet lié à la chaîne d'index iMot. S'il n'y a pas d'objet, le contrôle rencontre la valeur nil, c'est-à-dire rien. Dans le cas contraire, elle déclenche la procédure d'affichage.

Celle-ci est complétée par une ligne qui calcule la valeur de l'index (cette valeur est le contenu de l'objet) et affiche le texte correspondant à cet index.

Les lignes concernant les couples name-value sont désactivées car les deux méthodes sont - en l'état - incompatibles.

Pour essayer, un clic sur le petit triangle vert dans le menu Lazarus. Un clic sur le bouton Object dans l'onglet Info, et navigation dans l'onglet Balayage. Les mémos s'affichent.

Filtre

L'exécution montre que la recherche et l'affichage des mémos sont aussi fastidieux qu'avec la méthode précédente, d'autant que le filtre se révèle sans effet.

Pour le réactiver, il suffit de rajouter un contrôle dans la procédure UpDown2Click :

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

Si la case Filtre est cochée, le balayage de la liste se poursuit automatiquement jusqu'à ce que le mot soit lié à un objet.

Essayez…

Compatibilité

A priori, rien n'indique qu'une méthode neutralise l'autre. Le mieux est quand même de le vérifier.

Pour cela, nous allons doubler la mise en mémoire de texte et l'affichage :

- dans l'onglet Balayage, nous ajoutons un memo avec ascenseur vertical ;

- nous ajoutons la variable globale qui recevra les textes objets :

listeObj : TstringList ;

- dans la procédure FormCreate nous ajoutons l'instruction :

regObj ;

- la procédure regObj(12) placera en mémoire les textes à lier sous forme d'objets :

procedure TForm1.regObj;
begin
listeObj := TStringList.Create;
listeObj.Add('ResaObj'); //index 0
listeObj.Add('Ceci est un complément d''information pour le mot couleur');
listeObj.Add('Voici une information qui sera liée au mot violet');
end;

- Et nous scindons l'affichage en deux parties dédiées, ce qui fait intervenir trois procédures(13) :

procedure TForm1.MAJBalayage;
var i : integer;
begin
Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
Label3.Caption:= Label2.Caption;
//Label2.Caption:=AnsiToUTF8(listeMots.Names[iMot]);
TrackBar1.Position:= Round(iMot*1000/nMots);
AffListe.Clear;
for i := 0 to 10 do
AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-delta + i
+ nMots) mod nMots]));
AffListe.Selected[delta] := True;
Memo3.Clear;
Memo4.Clear;
if (Pos('=', listeMots[iMot])>0) then MAJInfo;
if  listeMots.Objects[iMot]<> nil then MAJObj;
end;

procedure TForm1.MAJInfo;
begin
Label3.Caption:= listeMots.Names[iMot];
Edit1.Caption:= listeMots.Values[Label3.Caption];
Memo2.Clear;
Memo2.Append(listeInfo[StrToInt(Edit1.Caption)]);
Label2.Caption:= listeMots.Names[iMot];
Memo3.Append(listeInfo[StrToInt(Edit1.Caption)]);
//Memo3.Append(listeInfo[integer(listeMots.Objects[iMot])]);
end;

procedure TForm1.MAJObj;
begin
Memo4.Append(listeObj[integer(listeMots.Objects[iMot])]);
end;

Enfin, les instructions propres au bouton Object doivent être modifiées :

procedure TForm1.Button4Click(Sender: TObject);
begin
listeMots.Objects[listeMots.IndexOf('couleur')] := TObject(1);
listeMots.Objects[listeMots.IndexOf('violet')] := TObject(2);
//listeMots.Objects[listeMots.IndexOf('vert')] := TObject(3);
//listeMots.Objects[listeMots.IndexOf('rouge')] := TObject(4);
end;

Un clic sur le petit triangle vert pour lancer l'exécution. Dans l'onglet Info, cliquez sur le bouton Object pour établir les liens entre les mots et les textes-objets. Dans l'onglet Balayage, actionnez le filtre et balayez : les textes apparaissent dans le nouveau mémo, pour les mots « couleur » et « violet ».

Donc le fonctionnement est correct pour la propriété Object.

Revenez sur l'onglet Info, cliquez sur le bouton Value. Reprenez le balayage : les textes-values s'affichent correctement, accompagnés des textes-objets : les liens sont donc validés sous les deux formes simultanément.

Mais…

Arrêtez le programme, relancez-le et chargez les textes dans l'ordre inverse : Value d'abord, Object ensuite ; cette fois, il y a une erreur :

Pourquoi ?

La réponse est très simple : nous avons vu que le lien Value s'établissait en complétant la chaîne d'origine par un signe « = » suivi d'une autre chaîne. Donc lorsque le lien Object va chercher sa cible, il ne pourra pas la trouver puisqu'elle aura été modifiée.

Ce problème va-t-il compromettre définitivement la compatibilité entre les deux méthodes ?

Nous nous souvenons que la chaîne d'origine se retrouve sous forme de Value. Donc nous allons tout simplement remplacer la fonction

listeMots.IndexOf()

par la fonction plus élaborée

chercheValue()

qui peut s'écrire ainsi(14) :

function TForm1.chercheValue(motAchercher: string): integer;
var i : integer;
begin
i := 0;
chercheValue := listeMots.IndexOf(motAchercher);
if chercheValue<0 then
repeat
inc(i)
until (i = nMots) or (listeMots.Names[i] = motAchercher);
if listeMots.Names[i]=motAchercher then chercheValue := i;
end;

Nous corrigeons la procédure qui établit les liens-objets :

procedure TForm1.Button4Click(Sender: TObject);
begin
listeMots.Objects[chercheValue('couleur')] := TObject(1);
listeMots.Objects[chercheValue('violet')] := TObject(2);
end;

Relancez l'exécution en chargeant (onglet Info) les liens Value, puis les liens Object. Dans l'onglet Balayage, actionnez le filtre et naviguez…

Impeccable !

Nos liens Value et Object cohabitent parfaitement.

Conclusion

Nous disposons maintenant de deux méthodes pour attacher à chaque mot toutes sortes d'informations que nous pourrions désirer.

En gros, on peut dire que les deux méthodes sont équivalentes en termes de mise en œuvre.

- La première surcharge la liste principale avec une chaîne de deux à sept octets (depuis '=1' jusqu'à '=900000') si le nombre de liens reste inférieur à un million(15). Pour déterminer la partie droite de la chaîne, il faut indiquer la partie gauche, qui est une chaîne de caractères.

- La seconde utilise pour chaque lien un pointeur, qui occupe quatre octets. Les affichages sont simplifiés puisque le signe « = » et l'index n'apparaissent pas dans la liste principale. Pour déterminer le pointeur, il faut indiquer la position de la chaîne dans la liste principale, qui est un entier.

Resterait à analyser les performances au niveau des temps d'accès et occupation de la mémoire, sans compter les compléments d'enregistrement et d'édition déjà mentionnés. Mais…

Mais il faut reconnaître que l'avancée est bien mince au regard des performances offertes par les dictionnaires en ligne : chacun de nos mots peut être relié à une information et une seule (ou deux en combinant les deux méthodes), ce qui largement insuffisant.

Il est donc nécessaire de sortir des solutions «  précâblées  », et c'est ce que nous ferons dans le prochain chapitre.

Âge : ne reste pas longtemps ingrat.
Tristan Bernard

Pour l'instant, l'unité uLex5 se présente comme suit :

unit uLex5;

{$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;
CheckBox1: TCheckBox;
Edit1: TEdit;
Edit2: TEdit;
Label3: TLabel;
Memo2: TMemo;
Memo3: TMemo;
Memo4: TMemo;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
TabSheet2: 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 CheckBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Recherche(rechMot: string);
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;
procedure regInfo;
procedure regObj;
procedure MAJObj;
function chercheValue(motAchercher : string) : integer;
private
{ private declarations }
public
{ public declarations }
end;

const delta=5;

var
Form1: TForm1;
listeMots, listeInfo, listeObj : TstringList;
iMot, nMots : integer;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
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(Edit2.Caption);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//MAJInfo;
listeMots[listeMots.IndexOf('couleur')] := 'couleur=1';
listeMots[listeMots.IndexOf('teinte')] := 'teinte=2';
listeMots[listeMots.IndexOf('vert')] := 'vert=3';
listeMots[listeMots.IndexOf('rouge')] := 'rouge=4';
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
listeMots.Objects[chercheValue('couleur')] := TObject(1);
listeMots.Objects[chercheValue('violet')] := TObject(2);
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;
LireFichier(listeMots);
nMots:= listeMots.Count;
Memo1.Append('Premier mot : '+listeMots[0]);
Memo1.Append('Dernier mot : '+listeMots[nMots-1]);
iMot := 0;
regInfo;
regObj;
MAJAffichage;
MAJBalayage;
end;
procedure TForm1.MAJBalayage;
var i : integer;
begin
Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
Label3.Caption:= Label2.Caption;
//Label2.Caption:=AnsiToUTF8(listeMots.Names[iMot]);
TrackBar1.Position:= Round(iMot*1000/nMots);
AffListe.Clear;
for i := 0 to 10 do
AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-delta + i
+ nMots) mod nMots]));
AffListe.Selected[delta] := True;
Memo3.Clear;
Memo4.Clear;
if (Pos('=', listeMots[iMot])>0) then MAJInfo;
if  listeMots.Objects[iMot]<> nil then MAJObj;
end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
if CheckBox1.Checked then
repeat
inc(iMot);
until (iMot=nMots) or (Pos('=', listeMots[iMot])>0)
or (listeMots.Objects[iMot]<> nil)
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
Label3.Caption:= listeMots.Names[iMot];
Edit1.Caption:= listeMots.Values[Label3.Caption];
Memo2.Clear;
Memo2.Append(listeInfo[StrToInt(Edit1.Caption)]);
Label2.Caption:= listeMots.Names[iMot];
Memo3.Append(listeInfo[StrToInt(Edit1.Caption)]);
//Memo3.Append(listeInfo[integer(listeMots.Objects[iMot])]);
end;

procedure TForm1.regInfo;
begin
listeInfo := TStringList.Create;
listeInfo.Add('Resa');
listeInfo.Add('La couleur est la perception subjective qu''a un animal '
+'d''une ou plusieurs fréquences d''ondes lumineuses, '
+'avec une (ou des) amplitude(s) donnée(s), au travers de sa vision oculaire.');
listeInfo.Add('Une teinte est la forme pure d''une couleur, '
+'c''est-à-dire sans adjonction de blanc ou de noir qui permettent d''obtenir '
+'ses nuances. Les teintes sont visualisées sur le pourtour d''une roue chromatique.');
listeInfo.Add('La perception de la couleur verte est évoquée par la lumière d''un'
+' spectre dominé par de l''énergie avec une longueur d''onde d''environ 520-570 nm.');
listeInfo.Add('Le rouge est, sur le cercle chromatique, une des trois couleurs '
+'(avec le jaune et le bleu) primaires. Pour la théorie ondulatoire de la lumière, '
+'son rayonnement se situe entre l''orange et l''infrarouge du spectre électromagnétique.');
end;

procedure TForm1.regObj;
begin
listeObj := TStringList.Create;
listeObj.Add('ResaObj');
listeObj.Add('Ceci est un complément d''information pour le mot couleur');
listeObj.Add('Voici une information qui sera liée au mot violet');
end;

procedure TForm1.MAJObj;
begin
Memo4.Append(listeObj[integer(listeMots.Objects[iMot])]);
end;

function TForm1.chercheValue(motAchercher: string): integer;
var i : integer;
begin
i := 0;
chercheValue := listeMots.IndexOf(motAchercher);
if chercheValue<0 then
repeat
inc(i)
until (i = nMots) or (listeMots.Names[i] = motAChercher);
if listeMots.Names[i]=motAChercher then chercheValue := i;
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 iMot : integer;
begin
iMot := listeMots.IndexOf(rechMot);
if iMot >= 0 then Label1.Caption:= listeMots[iMot]
else Label1.Caption:= 'échec';
Memo1.Append('Index '+IntToStr(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:=listeMots[iMot];
Edit2.Caption:= '';
Memo1.Append('Index '+IntToStr(iMot));
end;

end.

Liens multiples

Introduction

Les chapitres précédents ont donné accès à une liste considérable de mots français et permis de construire avec Lazarus un outil permettant :

- de parcourir la liste à volonté ;

- d'établir avec chaque mot un lien avec une information quelconque : texte, image, son, fichier.

Mais ce potentiel reste modeste. Il est limité en particulier par l'unicité du lien autorisé par les propriétés génériques Value ou Object du composant Liste.

Dans le présent chapitre, nous allons voir comment établir des liens multiples.

Environnement

Chapitre 6…

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

- ouvrir pLex5.lpi dans Lex6 avec Lazarus ;

- enregistrer uLex5.pas sous le nom uLex6.pas ;

- accepter la suppression des références à uLex5.pas ;

- enregistrer pLex5.pas sous le nom pLex6.pas ;

- renommer la fenêtre Form1 : Lex5 devient Lex6 ;

- dans le répertoire Lex6 supprimer les anciens fichiers contenant la mention Lex5.

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

Architecture

Chaque mot de la liste principale est affecté d'un numéro implicite qui correspond à sa place dans la liste. Au niveau du code, rappelons que connaissant le numéro, la fonction liste[numéro] donne accès à la chaîne de caractères, et inversement, la fonction liste.IndexOf(mot) explicite le numéro du mot ou retourne -1 si le mot n'existe pas.

Nous allons exploiter ces fonctions pour accéder à une table auxiliaire. Par exemple, le mot « a » possède le numéro 0 (zéro) en tant que premier de la liste.

Tableaux de liens

Nous créons un tableau de nombres entiers, de longueur variable, dont le premier élément, qui sera son identifiant, sera ce numéro. Si on décide, par exemple, de stocker les quatre valeurs 5555, 101, 100 et 6006 en liaison avec le mot « a », notre tableau aura une capacité (longueur) de cinq cases se présentant ainsi :

Numéro
identifiant

lien1

lien2

lien3

lien4

0

5555

101

100

6006

Le premier entier, nous savons qu'il correspond au premier élément de la liste principale, donc au mot « a ».

Mais les autres, que représentent-ils ? C'est à nous de décider. On peut imaginer une structure dans laquelle le second entier est un index qui pointe dans une liste de textes, le troisième dans une liste de pdf, les trois suivants à des images, etc.

Mais nous arrivons vite à une usine à gaz, ce qui est passionnant assurément, mais d'un usage d'autant plus contestable que des quantités d'applications ont déjà été développées sous forme de bases de données adaptées à toutes sortes de besoins.

Pour rester simple, nous prendrons une option radicale : chaque entier du tableau représentera la position d'un mot de la liste principale. Nous obtenons alors un système qui autorise à la fois :

1. les liens multiples ;

2. la réflexivité.

Nous avons opté pour un identifiant numérique. Pourquoi ne pas avoir conservé le mot comme identifiant ? Essentiellement pour économiser de l'espace de stockage : un entier occupe moins de place qu'un mot complet. Mais gardons en tête cette option : nous aurons l'occasion d'y revenir.

Nettoyage de l'interface et du code

Avant de construire la nouvelle architecture, nous allons élaguer sérieusement notre projet, tout en conservant l'onglet Info pour un usage ultérieur :

1. dans l'onglet Info de l'interface, on supprime les deux boutons ;

2. dans l'éditeur de source, on supprime les deux procédures Button3Click et Button4Click correspondantes ;

3. dans la procédure Balayage, on supprime les quatre dernières lignes ;

4. dans l'onglet Balayage, on supprime les deux Memos ;

5. dans le code, on supprime les procédures MAJObj, MAJInfo, regObj, la fonction chercheValue ;

6. les référencements dans la classe Tform, au-dessus du mot-clé implementation, sont nettoyés.

Un essai d'exécution pour vérification.

Quelques scories subsistent… Nous y reviendrons.

Écriture de liens

Chaque mot de la liste principale est susceptible de posséder son propre tableau de liens.

Appelons Liens le tableau de tableaux d'entiers qui, avec son identifiant, reçoit les index des liens. Combien de tableaux d'entiers faut-il créer ? Pour fixer les idées, disons que 10 % des mots recevront des liens, soit en gros 34 000 tableaux. Cette approche superficielle montre qu'en fait il est illusoire de se fixer une limite, et la solution est d'adopter un tableau de longueur variable.

Méthode

La désignation Liens[0] correspond au premier tableau(16).

La désignation Liens[0, 0] correspond au premier entier du premier tableau(17).

Les tableaux à taille variable ont un inconvénient : avant d'affecter une valeur à un tableau, il est nécessaire de donner au tableau la taille requise. Cette taille est nulle à l'origine.

Donc pour affecter la valeur 0 à la première case du premier tableau, on écrira successivement :

SetLength(Liens, 1) ;
//le tableau de tableaux peut recevoir son premier tableau
SetLength(Liens[0], 1) ;
//le premier tableau a une longueur fixée à 1
Liens[0, 0]:= 0 ;
//la première case du premier tableau reçoit la valeur numérique 0

La procédure est un peu lourde mais autorise une grande souplesse dans l'édition des liens.

Premier essai

Dans l'interface graphique, nous allons ajouter un onglet appelé Édition. Pour cela, clic droit sur la ligne grisée, à droite de l'onglet Info. Dans le menu contextuel, choisissez Ajouter une page. Dans l'Inspecteur d'objets, onglet Propriétés, remplacez TabSheet3 par le mot « Édition » à la ligne Caption.

Dans ce nouvel onglet, nous plaçons un bouton et un label (propriété Font/Size portée à 14).

Double-clic sur le bouton, et dans la procédure ainsi créée dans l'Éditeur de source, nous plaçons le code suivant :

procedure TForm1.Button3Click(Sender: TObject);
begin
SetLength(Liens, 1);
SetLength(Liens[0], 1);
Liens[0, 0] := 0;
Label4.Caption := IntToStr(Liens[0, 0])+ ' -> ' + listeMots[Liens[0, 0]];
end;

Les trois premières instructions ont été commentées plus haut. La dernière a une ambition modeste : elle se contente d'afficher le numéro stocké dans le nouveau tableau, et le mot correspondant.

La variable globale Liens doit être déclarée avant implementation :

var
Form1: TForm1;
listeMots, listeInfo : TStringList;
iMot, nMots : integer;
AffListe : TListBox;
Liens : Array of Array of integer;
implementation
{ TForm1 }

Clic sur le petit triangle vert pour notre premier essai…

Clic sur le nouveau bouton…

Voici le résultat pour l'indice 0 ; essayez avec différentes valeurs : 100, 1000, 100000…

Nous n'avons pas construit de lien, mais seulement initié le tableau susceptible d'en recevoir !

Création d'un lien

Sous le label de l'onglet Édition, nous ajoutons une zone de saisie sous forme d'un TEdit.

Nous ajoutons à droite un TListBox qui recevra les mots éventuellement liés.

Nous remplaçons le titre (caption) du bouton par « Lier ».

La démarche suivante :

1. recopier dans le Label4 le mot-titre affiché dans l'onglet Balayage ; son index est iMot ;

2. dans l'onglet Édition, saisie d'un mot Mot1 dans le TEdit, son index est iLien ;

3. cliquer sur le bouton Lier pour créer le lien ;

4. si Mot1 existe, le lien est créé, il est affiché dans la ListBox et la zone d'édition est nettoyée ; sinon un message d'erreur invite à saisir un autre mot.

La création du lien passe par plusieurs étapes :

1. chercher le tableau de liens correspondant à chacun des mots à lier ;

2. s'il n'existe pas, créer le tableau et inscrire le numéro du mot à lier dans la première case ;

3. ensuite, ajouter le numéro du mot à lier dans une nouvelle case.

Voyons cela pas à pas.

Recherche du tableau de liens

Nous avons deux mots, connus par leurs index iMot et iLien. Pour savoir si un mot possède son propre tableau de liens, nous créons la fonction chercheTab qui renvoie la position du tableau(18). Rappelons que le tableau de liens commence (à la case 0) par un entier qui est précisément l'index du mot. Si le renvoi est négatif, c'est que le mot ne possède pas encore son tableau.

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;

Création du lien

Pour lier le mot titre, d'index iMot, à un autre mot d'index iLien, nous créons la procédure Lier qui comprend deux parties :

1. si iMot ne possède pas son tableau de liens (chercheTab(iMot) négatif), il faut créer ce tableau à la suite des autres. Par exemple, si aucun tableau n'existe (Length(Liens)=0), on augmente la taille de Liens d'une unité ; le tableau secondaire aura une taille égale à 1 et la première case du tableau secondaire sera remplie avec la valeur iMot ;

2. la taille du tableau secondaire est augmentée d'une unité et la nouvelle case reçoit la valeur iLien.

Le code peut s'écrire ainsi :

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;  //indice du nouveau tableau
SetLength(Liens[k], 1);
Liens[k, 0] := iMot; //identifiant
end;
SetLength(Liens[k], Length(Liens[k])+1);  //extension du tableau secondaire
Liens[k, Length(Liens[k])-1] := iLien;  // lien
end;

Comme le lien est réciproque, la procédure sera répétée en inversant les deux paramètres.

Exécution

Double-clic sur le bouton Lier pour retrouver la procédure Button3 qui sera modifiée ainsi :

procedure TForm1.Button3Click(Sender: TObject);
var iLien, k : integer;
begin
iLien := listeMots.IndexOf(UTF8ToAnsi(Edit3.Caption));
if iLien<0 then
ShowMessage('Ce mot n''existe pas, recommencez')
else
begin
Lier(iMot, iLien);
Lier(iLien, iMot);
AffLiens;
end;
Edit3.Clear;
end;

Le mot titre est issu de la liste principale, puisqu'il est obtenu à partir le l'onglet Balayage. Par contre, le mot entré dans la zone d'édition n'existe peut-être pas : un signal d'erreur invite à recommencer la saisie.

Ensuite, la construction du lien se fait dans un sens, puis dans l'autre.

La zone de saisie est effacée, prête à recevoir un nouveau mot à lier.

Mais avant, le ou les liens sont affichés dans le composant ListBox par les soins de la procédure AffLiens :

procedure TForm1.AffLiens;
var i, k : integer;
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]]));
end;

Enfin, nous ajoutons dans la procédure MAJBalayage des instructions nécessaires pour afficher le mot titre dans l'onglet Édition, nettoyer la zone de saisie et afficher les liens éventuels :

procedure TForm1.MAJBalayage;
var i : integer;
begin
Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
Label3.Caption:= Label2.Caption;
Label4.Caption:= Label2.Caption;
Edit3.Clear;
TrackBar1.Position:= Round(iMot*1000/nMots);
AffListe.Clear;
for i := 0 to 10 do
AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-delta + i
+ nMots) mod nMots]));
AffListe.Selected[delta] := True;
AffLiens ;
end;

Un clic sur le petit triangle vert pour nos essais.

Dans l'onglet Balayage, faites défiler les mots pour afficher le mot « couleur ».

Dans l'onglet Édition, écrivez le mot « vert »et cliquez sur le bouton Lier. Immédiatement, le mot « couleur » est lié au mot « vert », qui apparaît maintenant dans la zone des liens à droite.

Recommencez avec « blanc », « rouge »… Les liens s'ajoutent sans problème…

Le mot titre est « couleur ». Il possède trois liens qui sont affichés à droite.

Réciprocité

Le mot « couleur » est lié au mot « vert ». Mais comment vérifier que la réciproque est vraie ?

Il suffirait de cliquer sur le mot « vert » pour le faire basculer en titre, et la zone des liens présenterait alors les liens existants.

Pour coder cet événement, revenez en mode édition, cliquez sur le composant ListBox1, et dans l'onglet Événements, ligne OnClick, cliquez sur les trois points. La procédure s'écrit ainsi :

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

La première ligne vérifie la présence d'un lien (index supérieur ou égal à zéro).

Relancez l'exécution. Onglet Édition, le mot titre est « a ». Créez un lien avec « avoir », avec « voyelle », avec « lettre »… Cliquez sur le mot « avoir », créez un lien avec « bien », avec « verbe »… Cliquez sur le mot « bien », qui passe en titre ; liez avec « mal », etc. C'est simple et… magique !

Enregistrement des liens

Inutile d'ajouter davantage de liens puisque la fonction d'enregistrement n'existe pas encore.

Nous allons créer un fichier de nombres entiers qui recevra un par un les tableaux secondaires.

Dans l'unité uDisque, nous écrivons avant implementation, sous la ligne procedure LireFichier, l'instruction procedure regLiens ;

Après appui sur les touches Ctrl+Maj+C, nous complétons le corps de la procédure par les instructions suivantes :

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

begin
AssignFile(fLiens, 'fichLiens.bin');
ReWrite(fLiens);
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;

Le premier nombre écrit dans le fichier est la taille du premier tableau secondaire : Write(fLiens, j). Ensuite sont écrits tous les nombres situés dans le tableau depuis la case 0 (identifiant du tableau) jusqu'à la dernière case. L'opération est répétée autant de fois qu'il y a de tableaux secondaires.

L'unité utilise la variable Liens créée par l'unité uLex6 ; pour que le compilateur s'y retrouve, dans l'unité uDisque, sous le mot-clé implementation, nous ajoutons l'instruction

uses uLex6 ;

Pour automatiser la sauvegarde de nos liens, nous ajoutons l'instruction regLiens dans la procédure Button1Click qui provoque la fin de l'application :

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

Lecture des liens

Pour récupérer l'ensemble de nos liens au démarrage du programme, nous ajoutons la ligne lireLiens dans la procédure FormCreate.

Dans l'unité uDisque, nous ajoutons la ligne procedure lireLiens ; avant implementation, et après appui sur les touches Ctrl+Maj+C, nous complétons le code comme suit :

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 de tableau secondaire
inc(nLiens);                      //nombre de mots liés
end;
CloseFile(fLiens);
end;

Cette procédure utilise une fenêtre pour signaler l'absence du fichier : il faut déclarer l'unité Dialogs après SysUtils.

Le premier nombre lu, m, est la taille du premier tableau secondaire. Les lectures suivantes permettront de remplir toutes les cases de ce tableau. Puis on passe au tableau suivant avec inc(nLiens) jusqu'à la fin du fichier (détectée par EOF).

Nous avons ici introduit la variable nLiens qui totalise le nombre de mots liés. Mais il faudra la déclarer dans l'unité uLex6, à la suite des autres variables globales. L'affichage du nombre de liens sera intégré dans le titre de la fenêtre (propriété Caption) et actualisé lors de la création de liens.

Dans la procédure MAJBalayage, nous ajoutons l'instruction

Caption := IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens)+' liés';

Pour essayer la nouvelle configuration, clic sur le petit triangle vert.

Balayage jusqu'au mot « couleur » ; dans l'onglet Édition, liez avec « vert », « blanc », « rouge »…

Pour quitter, passez par le bouton Arrêt (onglet Page1), de façon à provoquer l'enregistrement. Au redémarrage, vous retrouverez tous vos liens.

Filtre

La navigation reste laborieuse, et un filtrage permettrait de passer directement d'un mot lié au suivant. Pour cela, il suffit de reprendre la définition du filtrage en introduisant la valeur retournée par la fonction chercheTab : si elle est négative, la recherche continue.

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

Relancez l'exécution ; onglet Balayage, cliquez sur le filtre puis sur les flèches : tous les mots liés défilent instantanément. Un contrôle sur l'onglet Édition permet de vérifier que les liens sont correctement détectés et affichés.

Conclusion

Ouf ! Il a fallu mettre un peu les mains dans le cambouis des indices multiples, mais nous disposons maintenant des moyens nécessaires pour créer et sauvegarder facilement tous les liens que l'on souhaite.

Dans le prochain chapitre, nous verrons comment effectuer le tri des tableaux, la modification ou la suppression de liens, et nous aborderons le concept de mots « proches » du mot titre, fondamental dans la construction des mots croisés.

Mais la création de liens restera limitée aux mots de la liste principale : ce n'est qu'ensuite que nous envisagerons sa modification, problème que nous avons soigneusement éludé jusqu'à présent.

An : un élément du fardeau du vieillard.
Tristan Bernard.

Pour l'instant, les unités uLex6 et uDisque se présentent ainsi :

unit uLex6;

{$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;
CheckBox1: TCheckBox;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Label3: TLabel;
Label4: TLabel;
ListBox1: TListBox;
Memo2: TMemo;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
TabSheet2: TTabSheet;
TabSheet3: 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 CheckBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Recherche(rechMot: string);
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);
function chercheTab(iMot : integer) : integer;
procedure Lier(iMot, iLien: integer);
procedure AffLiens;

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

const delta=5;

var
Form1: TForm1;
listeMots, listeInfo, listeObj : TstringList;
iMot, nMots, nLiens : integer;
Liens : Array of Array of integer;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
regLiens;
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(Edit2.Caption);
end;

procedure TForm1.Button3Click(Sender: TObject);
var iLien, k : integer;
begin
iLien := listeMots.IndexOf(UTF8ToAnsi(Edit3.Caption));
if iLien<0 then
ShowMessage('Ce mot n''existe pas, recommencez')
else
begin
Lier(iMot, iLien);
Lier(iLien, iMot);
AffLiens;
end;
Edit3.Clear;
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;
LireFichier(listeMots);
nMots:= listeMots.Count;
lireLiens;
Memo1.Append('Premier mot : '+listeMots[0]);
Memo1.Append('Dernier mot : '+listeMots[nMots-1]);
iMot := 0;
MAJAffichage;
MAJBalayage;
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.MAJBalayage;
var i : integer;
begin
Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
Label3.Caption:= Label2.Caption;
Label4.Caption:= Label2.Caption;
Edit3.Clear;
TrackBar1.Position:= Round(iMot*1000/nMots);
AffListe.Clear;
for i := 0 to 10 do
AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-delta + i
+ nMots) mod nMots]));
AffListe.Selected[delta] := True;
AffLiens;
Caption := IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens)+' liés';
end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
if CheckBox1.Checked then
repeat
inc(iMot);
until (iMot=nMots) or (chercheTab(iMot)>=0)
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;

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;  //indice du nouveau tableau
SetLength(Liens[k], 1);
Liens[k, 0] := iMot; //identifiant
end;
SetLength(Liens[k], Length(Liens[k])+1);  //extension du tableau secondaire
Liens[k, Length(Liens[k])-1] := iLien;  // lien
end;

procedure TForm1.AffLiens;
var i, k : integer;
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]]));
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 iMot : integer;
begin
iMot := listeMots.IndexOf(rechMot);
if iMot >= 0 then Label1.Caption:= listeMots[iMot]
else Label1.Caption:= 'échec';
Memo1.Append('Index '+IntToStr(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:=listeMots[iMot];
Edit2.Caption:= '';
Memo1.Append('Index '+IntToStr(iMot));
end;

end.

Et pour l'unité uDisque :

unit uDisque;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, Dialogs;

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

implementation

uses uLex6;

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

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

begin
AssignFile(fLiens, 'fichLiens.bin');
ReWrite(fLiens);
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 de tableau secondaire
inc(nLiens);                      //nombre de mots liés
end;
CloseFile(fLiens);
end;

end.

Classements et approximations

Introduction

Nous disposons maintenant d'une solide liste de mots et d'un moteur permettant de les relier autant de fois que l'on souhaite, ce qui ouvre l'horizon vers des recherches de corrélation.

Le moteur est brut de décoffrage, avec des liens qui apparaissent dans l'ordre de leur création : un classement automatique serait plus rationnel.

Par ailleurs, les jeux de mots croisés, qui sont notre cible principale, s'accommodent de lettres non accentuées ; les recherches doivent donc porter non seulement sur l'identité d'un mot avec un autre, mais sur leur ressemblance.

Notion floue… que nous allons éclaircir.

Environnement

Chapitre 7…

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

- ouvrir pLex6.lpi dans Lex7 avec Lazarus ;

- enregistrer uLex6.pas sous le nom de uLex7.pas ;

- accepter la suppression des références à uLex6.pas ;

- enregistrer pLex6.pas sous le nom de pLex7.pas ;

- renommer la fenêtre Form1 : Lex6 devient Lex7 ;

- dans le répertoire Lex7, supprimer les anciens fichiers contenant la mention Lex6.

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

Onglet Balayage

L'onglet Balayage se révèle pratique pour parcourir la liste et, avec son filtre, accéder immédiatement aux mots déjà liés.

L'onglet Édition a l'avantage de faire apparaître la liste des mots liés au mot-titre.

Pour rendre l'interface plus simple, nous remplaçons le Memo de l'onglet Balayage par un ListBox qui affichera les liens.

Dans les propriétés du composant Listbox, nous supprimons les bordures : BorderStyle est basculé sur bsNone.

Nous réduisons la hauteur des deux flèches et plaçons le composant filtre juste au-dessus.

Pour établir un lien visuel entre le mot-titre et ses mots liés, nous allons affecter aux composants Label2 et ListBox2 une même couleur pastel et nous vous proposons la teinte $00C1FFDC (valeur hexa à placer à la ligne Color). Toute autre teinte claire peut convenir.

Pour modifier la teinte de fond d'un composant, cliquez sur la ligne Color dans l'inspecteur d'objets : un premier choix est proposé.
Pour définir d'autres teintes, cliquez sur les trois points pour faire apparaître la palette complète.
Cliquez sur le carré principal pour choisir la couleur, puis ajustez l'intensité avec le curseur situé à sa droite.
Cliquez sur le bouton Ajouter… pour que la valeur numérique soit insérée dans la propriété.

L'ensemble se présente maintenant comme ceci :

La procédure AffLiens, qui prend en charge l'affichage des liens dans l'onglet Édition, est modifiée pour que le nouveau ListBox soit mis à jour systématiquement :

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;

Mais l'onglet Balayage doit à son tour être mis à jour si l'utilisateur a l'idée de cliquer sur le composant ListBox : dans l'onglet Événements de ce composant, ligne OnClick, cliquez sur les trois points pour créer la procédure événementielle correspondante :

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

La première instruction vérifie la présence d'un lien à l'emplacement du clic ; si c'est le cas, la mise à jour de l'onglet Balayage est réalisée.

Lancez l'exécution et essayez… L'ergonomie est déjà plus agréable.

Tri des liens

Les liens sont enregistrés dans le tableau principal Lien et dans les tableaux secondaires Liens[i] dans l'ordre de leur création, ce qui ne présente aucune difficulté théorique ou pratique. Le résultat est toutefois peu satisfaisant pour deux raisons :

- au plan esthétique, l'œil s'accommode mal du désordre qui apparaît dans l'affichage des liens ;

- au plan logique, la recherche dans un tas est plus longue que dans une liste ordonnée.

Pour les tableaux secondaires, la solution « épidermique » est simple : il suffit d'affecter à True la propriété Sorted du composant ListBox. Essayez…

L'affichage se fait maintenant dans le bon ordre. Mais…

Si vous cliquez sur un lien, le résultat obtenu est… imprévu. En effet, la mise à jour de l'affichage se fait non pas selon le mot cliqué dans la liste, mais selon sa position.

Et le tri effectué par le composant a modifié sa position…

Il faut donc envisager le tri systématique des tableaux, et le renouveler à chaque création de lien.

Tri des tableaux secondaires

La première case restera inchangée, puisque c'est l'identifiant du tableau. Les autres cases seront classées par ordre croissant.

La dernière case est celle qui est affectée en dernier : nous allons donc procéder à une simple remontée jusqu'à ce que la case précédente contienne une valeur inférieure, et nous répéterons l'opération jusqu'à ce qu'aucune permutation n'ait été effectuée.

Pour le tableau Liens[k], nous utiliserons la fonction TriSec(k), qui retournera vrai si aucune permutation n'a été effectuée.

Rappelons qu'une nouvelle fonction ou procédure doit faire d'abord l'objet d'une déclaration avant implémentation (ici on écritfunction TriSec(k : integer) : boolean; suivi d'un appui sur les trois touches Ctrl+Maj+C.

Le code est le suivant(19) :

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;

Notons que la première case (k=0) n'est pas modifiée.

Nous répéterons le balayage jusqu'à ce que la fonction retourne vrai.

Pour lancer le tri de tous les tableaux secondaires, nous plaçons un bouton dans l'onglet Info, et nous lui affectons « TriSec » à la propriété Caption.

Un double clic sur ce nouveau bouton pour créer la procédure Button4Click que l'on peut écrire ainsi :

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;

La variable k balaye successivement tous les tableaux secondaires ; si le tableau considéré contient plus de deux liens, un premier tri est lancé, puis un second, jusqu'à ce qu'aucune permutation n'ait été effectuée (okTri est vrai) ; on passe alors au tableau secondaire suivant.

Exécution : cliquez sur le petit triangle vert et vérifiez que, après action sur le bouton TriSec, tous les tableaux secondaires ont bien été triés.

Si vous quittez le programme en cliquant sur le bouton rouge, le tri est perdu. Si vous actionnez le bouton Arrêt du premier onglet, le tri est conservé.

Tri du tableau principal

Nous allons utiliser les mêmes méthodes pour mettre de l'ordre dans le tableau principal, c'est-à-dire ranger les tableaux secondaires dans l'ordre croissant de leur identifiant. La fonction TriPPal peut s'écrire ainsi :

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;

Pour lancer ce tri, nous ajoutons un bouton dans l'onglet Info, baptisé TriPPal, et dans la procédure onClick de ce composant, nous complétons le code :

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;

Les deux premières lignes affichent les mots liés dans l'ordre d'origine ; les deux suivantes font le tri, les deux dernières affichent le résultat.

Pour que le Memo puisse être consulté aisément, n'oubliez pas de porter sa propriété ScrollBar à AutoVertical.

Lancez l'exécution, cliquez sur le bouton TriPPal et appréciez(20)…

Pour la suite du projet, nous supposerons que les tris (secondaire et principal) ont été effectués et mémorisés en quittant le programme par le bouton Arrêt.

Ajout d'un lien

Après ajout d'un lien, l'ordre du tableau de liens est probablement détruit. Doit-on lancer le tri général du tableau permis par la fonction TriSec ? Cette fonction impose au moins deux balayages du tableau : un premier pour effectuer les éventuelles permutations, un second pour contrôler que tout est déjà en place.

Mais si le tableau est déjà trié et que le nouveau lien figure en dernière position, il suffit de faire monter sa position jusqu'à ce que l'index qui le précède soit inférieur. Cela remplace deux balayages par un demi… en moyenne… d'où l'intérêt du tri.

La procédure PlaceLiens(k) peut s'écrire ainsi :

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;

Il faut déclencher ce tri au moment où le nouveau lien est intégré dans le tableau, donc en fin de la procédure Lier, qui devient :

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
Inc(nLiens); //mise à jour du nombre de mots liés
Caption := 'Lex6 '+IntToStr(nMots)+ ' mots dont '
+IntToStr(nLiens) + ' 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;

Essayez : clic sur le triangle vert, naviguez jusqu'au mot « couleur » (onglet Balayage), ajoutez un lien avec « bleu » (onglet Édition)… Celui-ci est immédiatement placé convenablement.

Avant de quitter (bouton Arrêt), cliquez sur le bouton TriPPal pour que le tableau correspondant au mot « bleu » soit positionné à la bonne place : le Memo vous confirmera que, parmi les mots liés, le mot « bleu » a bien quitté la dernière position.

Création d'un tableau secondaire

Lors de la création d'un tableau secondaire (un lien est affecté à un mot qui n'en possédait pas), le nouveau tableau est placé en fin de liste : k:=Length(Liens)-1 (procédure ci-dessus).

Pour donner au nouveau tableau la place qui lui revient, on applique la même méthode que pour le tri des liens, avec une fonction PlaceTab qui retourne la nouvelle position du tableau.

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;

La procédure Lier doit donc être à nouveau modifiée pour que la nouvelle position soit prise en compte :

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
Caption := 'Lex6 '+IntToStr(nMots)+ ' mots dont '
+IntToStr(nLiens) + ' 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;

Essayez à nouveau en ajoutant au mot « couleur » un lien avec « orange »…

Pensez à quitter en utilisant le bouton du premier onglet.

Le tableau de liens est maintenant ordonné systématiquement, de même que chacun des tableaux secondaires.

Les boutons TriSec et TriPPal sont maintenant inutiles, ainsi que les procédures correspondantes. Nous pouvons les conserver provisoirement, pour rétablir le bon ordre de tous les liens en cas d'incident (coupure de courant, plantage…).

Suppression d'un lien

Il peut s'avérer nécessaire de supprimer un lien existant. Cette opération sera traitée dans un onglet dédié, par mesure de prudence.

Dans la fenêtre Lex7, clic droit dans la ligne en grisé, à droite de l'onglet Édition : dans le menu contextuel, choisir Ajouter une page. Dans l'inspecteur d'objets, inscrire « Suppression » dans la propriété Caption.

Dans le nouvel onglet, on ajoute quatre composants :

- un label (propriété Font/Size portée à 14) ;

- un listBox ;

- un second label ;

- et un bouton (propriété Caption portée à « OK »).

Nous désirons que le mot titre et les liens qui apparaissent dans l'onglet Balayage soient répliqués sur notre nouvel onglet ; un clic sur l'un des liens affichera un avertissement dans le second label et activera le bouton.

La procédure MAJSupp peut s'écrire ainsi :

procedure TForm1.MAJSupp;
begin
Label5.Caption := Label2.Caption;
ListBox4.Items := ListBox2.Items;
Label6.Caption:= '';
Button6.Enabled:= False;
end;

La procédure MAJBalayage est complétée par l'instruction MAJSupp ;

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 := 'Lex7 '+IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens) + ' liés';
MAJSupp;
end;

Pour sélectionner un lien dans l'onglet Suppression, nous utilisons l'événement OnClick :

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;

La procédure affecte à la variable iLien l'index du lien à supprimer : il faut déclarer cette variable avant implémentation.

var
Form1: TForm1;
listeMots, listeInfo : TstringList;
iMot, nMots, nLiens, iLien : integer;
AffListe : TListBox;
Liens : Array of Array of integer;

La suppression d'un lien s'accompagne de la réduction de la taille du tableau secondaire, et même de celle du tableau principal si ce lien était le dernier :

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);//tableau secondaire
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);       //tableau principal
nLiens := Length(Liens);
end;
MAJBalayage;
end;

Le clic sur le bouton OK lance la suppression dans un sens, puis dans l'autre :

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

Un clic sur le petit triangle vert pour essayer les nouvelles fonctions : il est possible maintenant d'ajouter et de retirer à volonté tous les liens que l'on souhaite.

Le bouton Arrêt du premier onglet assure la sauvegarde du résultat.

Mots approchés

La pratique un peu laborieuse des tableaux dynamiques nous a éloignés - provisoirement - du sujet principal que constituent les mots croisés. Oublions les majuscules et intéressons-nous aux lettres ou caractères particuliers.

Principes

Voici un tableau de 18 caractères, se terminant avec le tiret, l'apostrophe et l'espace :

|à|â|ä|é|è|ê|ë|î|ï|ô|ù|û|ü|ÿ|ç|-|'| |

Dans une grille de mots croisés(21), par convention non écrite, tous sont remplacés par leur homologue dans le tableau suivant(22) :

|a|a|a|e|e|e|e|i|i|o|u|u|u|y|c||||

les trois derniers étant… l'absence de caractère.

Inconsciemment, le joueur remplace tous les caractères du premier tableau par les caractères correspondants du second.

La fonction de recherche que nous avons utilisée précédemment ne s'accommode pas d'un tel laxisme : elle exige l'identité de deux chaînes, caractère par caractère. Il nous faut donc l'enrichir en complétant le signal d'erreur « échec » par l'affichage de mots « approchés » au sens des mots croisés.

Méthode

Nous avons déjà vu que la liste de mots était stockée selon le format simplifié à la norme ANSI alors que les affichages sur notre interface graphique exigeaient le format UTF8. Nous avons réglé le problème en adoptant les fonctions de conversion AnsiToUTF8 dans un sens et UTF8ToAnsi de l'autre.

Pour les recherches de mots approchés, il nous faudra comparer des chaînes de caractères débarrassées des lettres accentuées et des majuscules. Le tableau suivant résume les propriétés de nos chaînes selon la phase de leur utilisation :

Propriétés de la chaîne

Stockage

Identité

Approx

Type

ANSI

ANSI

ANSI

Présence de majuscules

Oui

Oui

Non

Affichage interface graphique

UTF8

UTF8

UTF8

Lettres accentuées

Oui

Oui

Non

Majuscules accentuées

Non

Non

Non

Pour des raisons de simplification, nous considérons que les majuscules accentuées ne présentent pas d'intérêt… mais il sera toujours temps d'y revenir si nécessaire.

Les traitements sont au format ANSI et les affichages au format UTF8 : commençons par corriger la procédure onClick qui déclenche la recherche :

procedure TForm1.Button2Click(Sender: TObject);
begin
Recherche(UTF8ToAnsi(Edit2.Caption));
end;

Interface graphique

Reprenons l'onglet 1 de l'interface, que nous rebaptisons en « Recherche » (propriété Caption).

Nous ajoutons un composant TListBox, avec la propriété Color égale à $00C4F3FF (autre couleur pastel, mais vous pouvez en adopter d'autres). Nous fixons la même couleur au composant Edit2 pour que la liaison entre les deux soit visuellement établie. Après quelques déplacements des composants, nous obtenons une interface qui peut ressembler à ceci :

L'objectif est de permettre la saisie d'un mot dans le composant Edit2, et d'afficher, après consultation de la liste principale :

1. le mot identique dans le Label ;

2. les mots approchés dans le ListBox.

Élimination des accents

La chaîne à rechercher, rMot, est débarrassée de ses majuscules puis balayée du premier caractère au dernier. Si l'un d'entre eux se trouve dans le tableau des lettres accentuées, il est remplacé par le caractère homologue du tableau des lettres non accentuées. La fonction SansAccent peut s'écrire ainsi :

function TForm1.SansAccent(rMot: string): string;
var i, j : integer;
cAcc, sAcc : string;
begin
cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
//regroupe tous les caractères à remplacer
sAcc := 'aaaeeeeiiouuuyc';
//regroupe tous les caractères de substitution
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 ;

Le recours à cette procédure sera fréquent. Il sera donc judicieux d'envisager la création de constantes globales pour les deux chaînes cAcc et sAcc, ce qui évitera des affectations à répétition.

Balayage de la liste principale

La recherche de mots approchés va débuter à partir du premier mot qui commence avec la même première lettre et se terminera lorsque l'on atteindra la première lettre suivante. La comparaison porte sur deux chaînes débarrassées de leurs accents.

Les résultats positifs sont affichés dans le ListBox et les indices stockés dans un tableau d'entiers tabApprox, pour réemploi éventuel. Nous commençons par déclarer cette variable globale avant implémentation :

tabApprox : Array of integer ;

Il s'agit bien d'un tableau dynamique, et il va falloir ajuster sa longueur avant chaque utilisation, mais maintenant nous avons l'habitude…

procedure TForm1.listeApprox(rechMot: string);
var i, k : integer;
referMot, testMot : string;
begin
SetLength(tabApprox, 0);   //mise à zéro du tableau
referMot := SansAccent(rechMot); //gabarit de référence
//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  //pseudo-identité
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;

Quant à la procédure Recherche, il faut la compléter pour provoquer une recherche complémentaire :

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;

Essai d'exécution avec un clic sur le petit triangle vert.

Dans la zone de saisie, on entre par exemple « macon » et on clique sur le bouton Chercher.

Le résultat « échec » indique qu'aucune correspondance n'a été trouvée.

Par contre, le ListBox affiche les mots approchants : « maçon » et « mâcon ».

Objectif atteint.

Que se passe-t-il si l'on clique sur le mot « maçon » par exemple ? Pour l'instant, rien. Il faut exploiter l'événement onClick du composant(23), et la procédure peut s'écrire comme suit :

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;

Clic sur le triangle vert pour lancer l'exécution.

Et là l'existence de la variable tabApprox montre son intérêt.

Conclusion

Nous savons maintenant ranger les listes de liens dans un ordre qui accélère les accès.

Par ailleurs, l'entrée d'un mot nouveau provoque, dans l'onglet Recherche, l'apparition d'une liste de mots approchants. Cette liste constituera un élément décisif lors de l'introduction d'un mot nouveau : c'est ce que nous verrons au prochain chapitre.

Une petite fantaisie pour terminer : voici un dessin exécuté sur smartphone mais pouvant servir d'icône originale à notre logiciel :

Ce n'est pas une œuvre d'art, plutôt un appel aux bonnes volontés !

Il vaut mieux ne pas réfléchir du tout que de ne pas réfléchir assez.
Tristan Bernard.

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

unit uLex7;

{$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;
CheckBox1: TCheckBox;
Edit1: TEdit;
Edit2: TEdit;
Edit3: 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;
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 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 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);
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
implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
regLiens;
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.Button3Click(Sender: TObject);
var iLien, k : integer;
begin
iLien := listeMots.IndexOf(UTF8ToAnsi(Edit3.Caption));
if iLien<0 then
ShowMessage('Ce mot n''existe pas, recommencez')
else
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.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;
LireFichier(listeMots);
nMots := listeMots.Count;
Memo1.Append('Premier mot : '+listeMots[0]);
Memo1.Append('Dernier mot : '+listeMots[nMots-1]);
lireLiens;
iMot := 0;
SetLength(tabApprox, 0);
Edit3.Clear;
MAJAffichage;
MAJBalayage;
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 := 'Lex7 '+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
Caption := 'Lex6 '+IntToStr(nMots)+ ' mots dont '
+IntToStr(nLiens) + ' 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;
cAcc, sAcc : string;
begin
cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
//regroupe tous les caractères à remplacer
sAcc := 'aaaeeeeiiouuuyc';
//regroupe tous les caractères de substitution
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 := Label2.Caption;
ListBox4.Items := ListBox2.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.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.

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 :

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 :

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;

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 :

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 :

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 :

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 :

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 :

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 :

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 :

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 :

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.

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 :

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 :

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.

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 ?

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 :

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) :

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 :

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é :

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 :

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 :

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 :

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 :

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.

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-joints 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 »…

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 :

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&lt;>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.

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…

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 :

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 :

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 :

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) +' ? ';
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 :

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 :

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 :

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 :

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 :

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é :

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) :

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.

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 :

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 :

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 code… L'unité uLex9 se présente maintenant comme suit :

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) +' ? ';
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 :

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.

Recherche logique

Introduction

L'outil Masque développé dans le chapitre précédent présente une utilité certaine pour le joueur de mots croisés qui connaît une ou des lettres du mot à trouver.

Dans le cas contraire, le joueur ne dispose que de la définition de ce mot, définition souvent piégée par les ambiguïtés de la langue.

Dans ce chapitre, nous allons aborder cet aspect culturel ou humoristique du vocabulaire en utilisant les liens déjà disponibles.

Et nous pourrons vérifier que… ça marche !

Environnement

Chapitre 10…

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

- ouvrir pLex9.lpi dans Lex10 avec Lazarus ;

- enregistrer uLex9.pas sous le nom de uLex10.pas ;

- accepter la suppression des références à uLex9.pas ;

- enregistrer pLex9.pas sous le nom de pLex10.pas ;

- renommer la fenêtre Lex9 en Lex10 ;

- dans le répertoire Lex10, supprimer les anciens fichiers contenant la mention Lex9 ;

- dans la procédure MAJBalayage, remplacer Lex9 par Lex10.

Les fichiers de données (mots et liens) peuvent être téléchargés à l'aide du lien inclus dans le chapitre 9.

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

Humour

La recherche d'un mot peut s'effectuer dans l'onglet Balayage : le curseur permet de parcourir aisément notre liste de mots par un simple déplacement de la souris ; les flèches droite et gauche autorisent un déplacement d'une unité, ou davantage en jouant avec le zoom.

La zone de saisie - dans le même onglet - et un clic sur le bouton  (flèche vers le haut) permettent de découvrir si le mot saisi existe ou non, avec affichage de mots proches éventuels.

La recherche peut aussi s'effectuer à partir de l'onglet Masque, qui permet de préciser la longueur du mot et la position des lettres connues.

Recherches élémentaires, mon cher Watson…

En effet, les jeux de mots croisés apportent des informations plus complexes dans le cadre de « définitions » souvent ambiguës où l'humour sous-jacent révèle le talent de l'auteur… mais seulement quand la solution apparaît !

C'est là que les liens dont nous avons entamé la construction vont montrer leur intérêt.

Interface graphique

L'onglet Logique est encore vide.

Pour faciliter la compréhension du code, nous allons prendre la peine, dans ce chapitre, de renommer l'onglet, ainsi que les composants que nous y insérerons. Chacun pourra apprécier ainsi l'intérêt de cette méthode qui reste facultative.

Pour Lazarus, l'onglet Logique apparaît sous le nom générique de TabSheet7(36). Dans sa propriété Name, nous remplaçons ce nom par tabLogique.

Ensuite, nous insérons cinq composants que nous renommons et définissons ainsi :

- un label, renommé en labReq, caption porté à « Requête », Font/Size portée à 14 ;

- un bouton, renommé en boutFH, caption porté(37) à « ⇪ » qui correspond au code utf8 $E2$87$AA ; taille fixée à 14 ; largeur (Width) ramenée à 25 ;

- un edit, renommé edReq, code couleur $00BBFFFD ;

- un second bouton, renommé boutReq ; caption porté à « Chercher », largeur 100 ;

- un ListBox, renommé lisReq, même couleur de fond que edReq.

L'ensemble est remanié à l'aide de la souris pour obtenir sensiblement ceci :

Le choix des teintes est éminemment subjectif, et chacun peut évidemment apporter sa touche personnelle.
En ce qui concerne l'espace vide à droite de l'onglet, nous le réservons pour un usage ultérieur.

Méthode

Notre idée est d'afficher tous les mots liés aux mots saisis.

Deux aspects sont à prendre en compte : la fréquence des occurrences et la profondeur de la recherche.

Fréquence

La première fois qu'un mot apparaît dans les liens, nous notons sa référence (indice du mot ou position dans la liste principale) et complétons mentalement cette note par le chiffre 1 qui indique que c'est la première fois qu'il est enregistré.

La seconde fois, la fréquence sera incrémentée de une unité, ainsi de suite.

Ainsi, les liens obtenus peuvent être affichés par ordre de fréquence décroissante, de façon à orienter en priorité l'utilisateur vers la ou les réponses les plus pertinentes. C'est cette méthode qu'ont retenue les moteurs de recherche habituels.

En ce qui nous concerne, l'intérêt de la fréquence est limité dans la mesure où une définition de mot croisé fait appel à une notion accessoire, un sens secondaire : c'est précisément ce côté subalterne, minoritaire, que nous devons saisir. Nous ne tiendrons donc pas compte ici du paramètre fréquence.

Les plus courageux pourront néanmoins créer la variable globale
tabOccur : Array of Array[0..1] of integer;
La première partie de chaque élément (tabOccur[i,0]) recevra l'indice du mot, et la seconde partie (tabOccur[i,1]) recevra la fréquence.
La variable est un tableau dynamique… qu'il faudra initialiser.

Profondeur

Le niveau 1 de la recherche consiste à établir la liste des mots directement liés aux mots-clés de départ : cette liste contient normalement des mots nouveaux qui orientent l'utilisateur vers des horizons différents.

Que se passe-t-il si la recherche est relancée à partir de ce stade ? Les horizons nouveaux ouvrent de nouvelles perspectives, etc.

Mais il est évident qu'un nombre trop élevé de recherches successives aboutirait à un brouillage contre-productif.

Avec une entrée de deux mots-clés, nous obtenons, par exemple, les nombres d'occurrences suivants(38) :

Profondeur

0

1

2

3

N. occurrences

2

4

33

119

Nous nous limiterons ici à un niveau 2, c'est-à-dire que nous réutiliserons une fois les résultats obtenus après la première recherche.

Comme la notion de fréquence n'a pas été retenue, nous disposerons ainsi d'une liste totalement indifférenciée(39) dans laquelle l'utilisateur pourra faire son choix.

Variables

Chaque mot saisi est versé, après un clic sur le bouton , dans la ligne de requête. Nous stockerons les indices (places de chaque mot dans la liste principale) dans une variable constituée par un tableau dynamique d'entiers.

Parmi les variables globales disponibles, nous trouvons déjà la variable tabApprox, qui correspond à un tableau dynamique d'entiers. Nous ajoutons la variable tabReq qui recevra les indices de nos requêtes.

Pour les réponses, nous avons besoin d'un autre tableau dynamique qui stockera l'indice de ces mots. Nous ajoutons dans la liste des variables globales la variable tabOccur :

var
Form1: TForm1;
listeMots, listeInfo : TstringList;
iMot, nMots, nLiens, iLien : integer;
AffListe : TListBox;
Liens : Array of Array of integer;
tabApprox, tabReq, tabOccur : Array of integer;
sAcc, cAcc : string;

Nous avons déjà rencontré les tableaux dynamiques : ils doivent faire l'objet d'une initialisation.

Initialisation

L'onglet Logique doit être préparé pour la première saisie dès que l'utilisateur aura décidé de l'afficher.

Nous utiliserons donc la procédure OnShow de l'onglet.

Pour cela, nous sélectionnons l'onglet dans l'inspecteur d'objets (ici la ligne TabSheet7) et au-dessous, dans l'onglet Événements, nous cliquons sur les trois points qui terminent la ligne OnShow.

Le curseur clignote dans l'éditeur de source entre les mots begin et end de la procédure TabSheet7Show que nous complétons ainsi :

procedure TForm1.tabLogiqueShow(Sender: TObject);
begin
Edit1.Clear;
ListBox5.Clear;
Label3.Caption:= 'Requête ';
SetLength(tabReq, 0);
SetLength(tabOccur, 0);
end;

Les composants sont nettoyés, les deux tableaux dynamiques initialisés.

Logiquement, nous procédons de même pour l'événement OnExit :

procedure TForm1.tabLogiqueExit(Sender: TObject);
begin
SetLength(tabReq, 0);
SetLength(tabOccur, 0);
end;

De cette façon, nos deux variables globales auront entièrement libéré l'espace mémoire lorsque l'utilisateur quittera l'onglet.

Requête

L'entrée d'un mot se fait naturellement par la zone de saisie et le clic sur le bouton . Si le mot existe, il bascule dans la ligne de requête et son indice est stocké dans la table tabReq :

procedure TForm1.boutFHClick(Sender: TObject);
var i, j, k : integer;
begin
//ajoute un mot à la liste de base tabReq
i := listeMots.IndexOf(UTF8ToAnsi(Edit1.Caption));
if i>=0 then //le mot existe dans la liste principale
begin
j:=0;
k := Length(tabReq);
while (j<k) and (i<>tabReq[j]) do inc(j);
if j=k then      //le mot peut être ajouté
begin
SetLength(tabReq, k+1); //ajoute une unité au tableau
tabReq[k] := i;
//affichage de la requête dans la ligne titre
if labReq.Caption = 'Requête ' then
labReq.Caption:= edReq.Caption //premier mot-clé
else
labReq.Caption:= labReq.Caption +' + '+edReq.Caption;
end;
end;
edReq.Clear;
end;

Un premier contrôle vérifie que le mot existe déjà dans la liste principale ; le second évite de saisir un doublon qui alourdirait inutilement la requête.

Au premier affichage, le mot saisi remplace le mot « Requête ».

La requête peut être complétée à volonté : chaque nouveau mot est ajouté au précédent, séparé par le signe +.

Recherche

Nous avons fixé la profondeur de recherche à 2 : ce sera la valeur de la constante profRech déclarée en premier.

La variable j balaye le tableau des liens jusqu'à l'indice du mot-clé : si celui-ci dispose de liens, ils sont stockés dans la variable tabOccur par l'intermédiaire de la procédure(40) AjoutOccur, qui s'assure de ne pas enregistrer de doublons :

procedure TForm1.AjoutOccur(iOccur: integer);
var i : integer;
begin
//vérifier que cette occurrence n'a pas encore été rencontrée
i:=0;
while (i<Length(tabOccur)) and (iOccur<> tabOccur[i])  do inc(i);
if i= Length(tabOccur) then   //première occurrence du mot
begin
SetLength(tabOccur, i+1);
tabOccur[i] := iOccur;
end;
end;

Un clic sur le bouton Chercher déclenche pour commencer une vérification sur la longueur de la requête, qui ne doit pas être vide.

À la fin de la première recherche, les occurrences obtenues sont basculées dans la variable tabReq, qui constituera la nouvelle base de la recherche ; le tableau tabOccur est remis à zéro au début de la seconde recherche(41).

procedure TForm1.boutReqClick(Sender: TObject);
const profRech = 2;      //fixe la profondeur de la recherche
var i, j, k, n : integer;
begin
if Length(tabReq)>0 then //la requête ne doit pas être vide
begin
for n := 1 to profRech do
begin
SetLength(tabOccur, 0);
for i:=0 to Length(tabReq)-1 do
begin
j := 0;
while (j<Length(Liens)) and (Liens[j, 0]<>tabReq[i])do inc(j);
if j<Length(Liens) then
for k:=1 to Length(Liens[j])-1 do AjoutOccur(Liens[j, k]);
end;
tabReq := tabOccur;
end;
j := Length(tabOccur);
//afficher les occurrences et leur nombre
lisReq.Items.Append(IntToStr(j)+' occurrences : ');
TriOccur; //trier avant affichage
for i:=0 to j-1 do
lisReq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
end;
end;

En fin de recherche, les mots trouvés sont affichés avec, en tête, l'indication de leur nombre. Pour apporter un peu de clarté, les mots sont triés par la procédure TriOccur. Nous avons déjà vu comment déclarer et créer une nouvelle procédure.

procedure TForm1.TriOccur;
var i, j, occTampon : integer ;
triOK : boolean;
begin
i := 0;
j := Length(tabOccur)-2;
triOK := True;
repeat
if (tabOccur[i] >  tabOccur[i+1])  then
begin
occTampon := tabOccur[i];
tabOccur[i] := tabOccur[i+1];
tabOccur[i+1] := occTampon;T
triOK := False;
end;
inc(i);
if not triOK and (i>j) then
begin
i:=0; //nouvelle passe de permutations
triOK:= True;
end;
until triOK and (i>j);
end;

Application

Nous allons utiliser nos nouveaux outils.

Dans le premier chapitre, nous avions évoqué l'énigme présentée par Tristan Bernard : « vide les baignoires et remplit les lavabos ». Les deux mots-clés sont à l'évidence « baignoire » et « lavabo » : nous les entrons l'un après l'autre à l'aide du bouton .

Un clic sur le bouton Chercher nous donne ceci :

À ce stade, il est bien difficile de conclure à la réussite ou à l'échec de notre requête…

Complément d'information

Le cruciverbiste dispose, en plus de la définition d'un mot, d'une grille qui indique le nombre de lettres de ce mot, et précise, s'il a de la chance, quelques lettres déjà obtenues par croisement.

Nous revenons ici au principe de l'outil Masque, qui est déjà disponible dans l'onglet précédent. Nous pourrions dupliquer la liste des réponses dans cet onglet, et laisser l'initiative à l'utilisateur.

Il nous a semblé plus ergonomique de dupliquer l'onglet Masque dans notre onglet Logique.

Nous ajoutons donc quatre composants supplémentaires que nous renommons et arrangeons ainsi :

1. Le Label7, renommé labMasq, rappelle qu'il faut saisir les lettres connues séparées par le signe « $ » ;

2. un Edit, renommé edMasq, qui recevra les indications de l'utilisateur, couleur $00F4ECFF ;

3. un bouton renommé boutMasq, Caption « Masque », qui déclenche une procédure directement inspirée de celle qui a été mise en œuvre dans l'onglet précédent, la différence portant sur le champ de recherche : ici, la liste de mots est limitée aux occurrences déjà affichées ;

4. un listBox, renommé lisMasq, couleur $00F4ECFF.

Le code peut s'écrire ainsi :

procedure TForm1.boutMasqClick(Sender: TObject);
var i, j, k : integer;
motCour, sMasque : string;
begin
i := 0;
sMasque := edMasq.Caption;
k := Length(sMasque);
lisMasq.Clear;
repeat
motCour := SansAccent(listeMots[tabOccur[i]]);
if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
begin
j := 1;
while (j<=k) and ((sMasque[j]='$') or (sMasque[j] = motCour[j])) do inc(j);
if j>k  then                             lisMasq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
end;
inc(i);
until (i=Length(tabOccur));
end;

Pour en simplifier l'utilisation, nous cachons les outils de masque tant que la requête n'est pas effectuée. La procédure onShow de l'onglet doit donc faire l'objet d'un complément :

procedure TForm1.tabLogiqueShow(Sender: TObject);
begin
edReq.Clear;
lisReq.Clear;
labReq.Caption:= 'Requête ';
labMasq.Caption := 'saisir les lettres séparées'+#13+' par le signe $';
boutMasq.Enabled:=False;
edMasq.Clear;
edMasq.Visible:=False;
labMasq.Visible:=False;
lisMasq.Visible:=False;
SetLength(tabReq, 0);
SetLength(tabOccur, 0);
end;

Mais en fin de requête, les outils doivent apparaître : la procédure Button5Click est modifiée ainsi :

procedure TForm1.boutReqClick(Sender: TObject);
const profRech = 2;      //fixe la profondeur de la recherche
var i, j, k, n : integer;
begin
if Length(tabReq)>0 then //la requête ne doit pas être vide
begin
for n := 1 to profRech do
begin
SetLength(tabOccur, 0);
for i:=0 to Length(tabReq)-1 do
begin
j := 0;
while (j<Length(Liens)) and (Liens[j, 0]<>tabReq[i])do inc(j);
if j<Length(Liens) then
for k:=1 to Length(Liens[j])-1 do AjoutOccur(Liens[j, k]);
end;
tabReq := tabOccur;
end;
j := Length(tabOccur);
//afficher les occurrences et leur nombre
lisReq.Items.Append(IntToStr(j)+' occurrences : ');
TriOccur; //trier avant affichage
for i:=0 to j-1 do
lisReq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
end;
edMasq.Clear;
edMasq.Visible:=True;
labMasq.Visible:=True;
lisMasq.Visible:=True;
boutMasq.Enabled:=True;
end;

Pour notre énigme, nous connaissons au minimum la longueur de la réponse, soit huit lettres.

Nous rédigeons à nouveau la requête « baignoire + lavabo », précisons la longueur du mot, soit 8 fois le signe « $ » dans le TEdit, et nous obtenons ceci après un clic sur le bouton Masque :

La bonne réponse est bien sûr l'entracte, qui vide les baignoires et remplit les lavabos !

Interprétation

Une telle requête présentée sur les moteurs de recherche habituels aboutit à des résultats… décourageants.

Par exemple, avec Google, nous obtenons 3 700 000 réponses en 0,27 seconde, mais ce sont des informations essentiellement commerciales, donc sans intérêt dans les circonstances qui nous intéressent.

Or nous venons d'obtenir deux réponses(42), dont une correcte, ce qui constitue, a priori, une performance hautement improbable. Notre application mérite donc une petite analyse critique.

Le mécanisme des sélections et des tris que nous avons mis en œuvre est incontestable : il peut être réutilisé et donnera toujours les mêmes résultats.

Voyons alors comment s'est opérée la saisie des liens.

Liens du premier niveau

Un mot-clé est « baignoire » : si ce mot est entré dans l'onglet Liens, notre logiciel affiche les résultats suivants :

L'autre mot-clé est « lavabo ». L'affichage donne ceci :

Au total, le premier niveau de recherche propose quatre mots, ce qui est bien maigre. La répétition du mot « toilette » n'apporte aucune information supplémentaire, puisque le paramètre fréquence n'entre pas en jeu.

Deuxième niveau

Que se passe-t-il lors de la recherche du second niveau ? Nous voyons déjà que le mot « baignoire » est associé au mot « théâtre » (une baignoire est une sorte de loge). Les liens disponibles sur ce mot sont nombreux(43) :

Et là, nous voyons apparaître, comme par magie, le mot « entracte » qui est précisément le mot cherché !

Deux recherches successives ont suffi, mais il n'est pas exclu qu'il faille aller plus loin dans certains cas.

Les indices manquants sont fournis sur la grille (longueur du mot) et, éventuellement par les lettres déjà identifiées sur la grille.

Conclusion

Avec seulement 5 000 mots liés, notre base de données est déjà capable de fournir des résultats intéressants. Et au fur et à mesure que ce nombre augmentera, les résultats seront de plus en plus pertinents : ainsi, chacun pourra se constituer sa base personnelle… et en faire profiter ses amis !

Notre projet est maintenant terminé, l'objectif est atteint.

Nous verrons, dans le prochain chapitre, quelques améliorations techniques telles que la fusion des fichiers de mots et de liens et la création d'une fenêtre de sélection. Ensuite pourront être abordés les sujets les plus fréquemment évoqués par les amateurs de mots croisés et… de Lazarus.

Amour : Mot en cinq lettres, trois voyelles, deux consonnes et deux idiots .
Ambrose Bierce

Le code de l'unité uDisque n'a pas changé.

Celui de l'unité uLex10 se présente maintenant ainsi :

unit ulex10;

{$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;
boutFH: TButton;
boutReq: TButton;
boutMasq: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
CheckBox1: TCheckBox;
edMasq: TEdit;
edReq: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
labMasq: TLabel;
labReq: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
ListBox4: TListBox;
lisReq: TListBox;
lisMasq: TListBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
TabSheet6: TTabSheet;
tabLogique: TTabSheet;
Zoom: TGroupBox;
Label1: TLabel;
Label2: TLabel;
AffListe: TListBox;
PageControl1: TPageControl;
Page1: TTabSheet;
TabSheet1: TTabSheet;
TrackBar1: TTrackBar;
UpDown2: TUpDown;
procedure AffListeClick(Sender: TObject);
procedure boutFHClick(Sender: TObject);
procedure boutMasqClick(Sender: TObject);
procedure boutReqClick(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 tabLogiqueExit(Sender: TObject);
procedure tabLogiqueShow(Sender: TObject);
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 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;
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);
procedure AjoutOccur(iOccur : integer);
procedure TriOccur;

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, tabReq, tabOccur : Array of integer;  //index des mots approchants  &#8682;   utf8 $E2$87$AA flèche haut
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.boutFHClick(Sender: TObject);
var i, j, k : integer;
begin
//ajoute un mot à la liste de base tabReq
i := listeMots.IndexOf(UTF8ToAnsi(edReq.Caption));
if i>=0 then //le mot existe dans la liste principale
begin
j:=0;
k := Length(tabReq);
while (j<k) and (i<>tabReq[j]) do inc(j);
if j=k then      //le mot peut être ajouté
begin
SetLength(tabReq, k+1); //ajoute une unité au tableau
tabReq[k] := i;
//affichage de la requête dans la ligne titre
if labReq.Caption = 'Requête ' then
labReq.Caption:= edReq.Caption //premier mot-clé
else
labReq.Caption:= labReq.Caption +' + '+edReq.Caption;
end;
end;
edReq.Clear;
end;

procedure TForm1.boutMasqClick(Sender: TObject);
var i, j, k : integer;
motCour, sMasque : string;
begin
i := 0;
sMasque := edMasq.Caption;
k := Length(sMasque);
lisMasq.Clear;
repeat
motCour := SansAccent(listeMots[tabOccur[i]]);
if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
begin
j := 1;
while (j<=k) and ((sMasque[j]='$') or (sMasque[j] = motCour[j])) do inc(j);
if j>k  then lisMasq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
end;
inc(i);
until (i=Length(tabOccur));
end;

procedure TForm1.boutReqClick(Sender: TObject);
const profRech = 2;      //fixe la profondeur de la recherche
var i, j, k, n : integer;
begin
if Length(tabReq)>0 then //la requête ne doit pas être vide
begin
for n := 1 to profRech do
begin
SetLength(tabOccur, 0);
for i:=0 to Length(tabReq)-1 do
begin
j := 0;
while (j<Length(Liens)) and (Liens[j, 0]<>tabReq[i])do inc(j);
if j<Length(Liens) then
for k:=1 to Length(Liens[j])-1 do AjoutOccur(Liens[j, k]);
end;
tabReq := tabOccur;
end;
j := Length(tabOccur);
//afficher les occurrences et leur nombre
lisReq.Items.Append(IntToStr(j)+' occurrences : ');
TriOccur; //trier avant affichage
for i:=0 to j-1 do
lisReq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
end;
edMasq.Clear;
edMasq.Visible:=True;
labMasq.Visible:=True;
lisMasq.Visible:=True;
boutMasq.Enabled:=True;
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) +' ? ';
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.AjoutOccur(iOccur: integer);
var i : integer;
begin
//vérifier que cette occurrence n'a pas encore été rencontrée
i:=0;
while (i<Length(tabOccur)) and (iOccur<> tabOccur[i])  do inc(i);
if i= Length(tabOccur) then   //première occurrence du mot
begin
SetLength(tabOccur, i+1);
tabOccur[i] := iOccur;
end;
end;

procedure TForm1.TriOccur;
var i, j, occTampon : integer ;
triOK : boolean;
begin
i := 0;
j := Length(tabOccur)-2;
triOK := True;
repeat
if (tabOccur[i] >  tabOccur[i+1])  then
begin
occTampon := tabOccur[i];
tabOccur[i] := tabOccur[i+1];
tabOccur[i+1] := occTampon;
triOK := False;
end;
inc(i);
if not triOK and (i>j) then
begin
i:=0; //nouvelle passe de permutations
triOK:= True;
end;
until triOK and (i>j);
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
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 : 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 := 'Lex10 '+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 : integer;
referMot : 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.tabLogiqueExit(Sender: TObject);
begin
SetLength(tabReq, 0);
SetLength(tabOccur, 0);
end;

procedure TForm1.tabLogiqueShow(Sender: TObject);
begin
edReq.Clear;
lisReq.Clear;
labReq.Caption:= 'Requête ';
labMasq.Caption := 'saisir les lettres séparées'+#13+' par le signe $';
boutMasq.Enabled:=False;
edMasq.Clear;
edMasq.Visible:=False;
labMasq.Visible:=False;
lisMasq.Visible:=False;
SetLength(tabReq, 0);
SetLength(tabOccur, 0);
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.

Compression

Introduction

L'utilisation de Lazarus nous a permis d'accéder à une importante base de vocabulaire disponible sur Internet, de l'enrichir, d'établir des liens logiques, et de réaliser des recherches fructueuses dans l'optique de mots croisés.

Aux plans techniques ou ergonomiques, rien n'est parfait évidemment.

Nous allons ici examiner le cas des deux fichiers de données, l'un en mode texte qui regroupe tous les mots, l'autre en mode binaire qui reçoit les liens sous forme de tableaux de nombres. Ne serait-il pas plus simple - et plus sûr - de rassembler ces données dans un seul fichier ?

Par ailleurs, nous allons créer une boîte de dialogue autorisant une sélection : son intérêt immédiat est évident, et la méthode proposée, particulièrement simple, pourra recevoir de nombreuses applications.

Environnement

Chapitre 11…

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

- ouvrir pLex10.lpi dans Lex11 avec Lazarus ;

- enregistrer uLex10.pas sous le nom de uLex11.pas ;

- accepter la suppression des références à uLex10.pas ;

- enregistrer pLex10.pas sous le nom de pLex11.pas ;

- renommer la fenêtre Lex10 en Lex11 ;

- dans le répertoire Lex11 supprimer les anciens fichiers contenant la mention Lex10 ;

- dans la procédure MAJBalayage, remplacer Lex10 par Lex11.

Les fichiers de données (mots et liens) peuvent être téléchargés à l'aide du lien inclus dans le chapitre 9.

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

Modification du stockage

L'ensemble de nos données est stocké sur disque sous forme de deux fichiers :

Nom

Taille (kOctets)

LiMots.txt

3 981

FichLiens.bin

95

total

4 076

Pour leur exploitation, les informations sont mises en mémoire dans les composants listeMots et Liens, qui sont respectivement une StringList et un tableau d'entiers (array of integer) dont les accès sont extrêmement rapides. Le point faible est évidemment le transfert du disque vers la mémoire et inversement.

Dans le deuxième chapitre, nous avons mesuré les vitesses d'accès au disque dans différents cas de figure : nous allons reprendre les outils et mesurer cette fois la durée de l'ensemble de la lecture et de l'enregistrement des fichiers.

Temps d'accès aux deux fichiers

Dans la liste des unités, nous ajoutons à nouveau un élément de la bibliothèque LCL, LclIntf, qui donne accès au compteur du processeur :

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

Dans les variables globales, nous ajoutons TopChro qui recevra la valeur du compteur au départ du chronomètre :

var
Form1: TForm1;
listeMots, listeInfo : TstringList;
iMot, nMots, nLiens, iLien, TopChro : integer;
AffListe : TListBox;

Et nous recopions la procédure(44) TopChrono :

procedure TForm1.TopChrono(Message: string);
begin
if TopChro = 0 then
begin
TopChro := GetTickCount;
Form1.Memo1.Append(Message);
end
else
Form1.Memo1.Append(Message + ' Durée '
+ IntToStr(GetTickCount-TopChro)+' ms');
end;

Notre interface graphique comprend de nombreux onglets, dont le dernier, Fichier, qui est pratiquement vide. Nous y ajoutons un bouton (Caption modifié en « Chrono1 ») et un Memo :

Nous voulons provoquer la lecture et l'enregistrement des fichiers depuis un clic sur le bouton.

La procédure onClick de ce bouton peut s'écrire ainsi :

procedure TForm1.Button4Click(Sender: TObject);
begin
TopChro := 0;
TopChrono('Début processus');
LireFichier(ListeMots);
lireLiens;
regFichier(listeMots);
regLiens;
TopChrono('Fin processus');
end;

Lançons l'exécution (petit triangle vert) ; clic sur le bouton Chrono1 : le mémo affiche le résultat de la mesure, soit 500 ms pour l'ensemble des processus de lecture et d'enregistrement des données.

Nous remarquons que le chargement de l'application et sa fermeture - enregistrement des données inclus - prennent au total un délai tout à fait acceptable compte tenu de la masse des informations traitées.

Les résultats peuvent varier sensiblement d'un ordinateur à un autre.

La valeur - purement indicative - sera réutilisée ultérieurement.

Fichier unique

Nous savons enregistrer du texte et, séparément, des tableaux de nombres de taille variable. L'emploi de l'instruction BlockWrite permet d'enregistrer toute donnée, en prenant soin de préciser au préalable sa taille : une chaîne de caractères de 7 signes sera enregistrée avec l'inscription de sa longueur -7- immédiatement avant. Un nombre quelconque sera enregistré selon la longueur qui doit être précisée : un octet sur une longueur de 1, un entier sera enregistré sur 4 octets, etc. Nous pouvons donc engager la séquence suivante :

1. ouverture d'un fichier qui sera nommé Lex1.bin ;

2. ouverture d'une boucle qui balaiera toute la liste de mots :

1. pour chaque mot, enregistrement :

1. de sa longueur,

2. du mot proprement dit,

3. de la taille du tableau de liens qui lui est associé,

1. des liens éventuels.

3. fermeture du fichier.

Le code de la procédure ecrireBase peut s'écrire ainsi :

procedure ecrireBase;
var
i, j, k, m, nbOct, SLong: integer;
Erreur: integer;
Moti :      string;
begin
AssignFile(fLex, 'Lex1.bin'); //==========nouveau fichier==============================
{$I-}
Reset(fLex, 1);
{$I+}
Erreur := IOResult;
if Erreur <> 0 then
ReWrite(fLex, 1);
for i := 0 to listeMots.Count - 1 do
//champ par champ à coder (longueur)
begin
Moti := listeMots[i];
ecrireMot(Moti);
m := Form1.chercheTab(i); //présence de liens
if m<0 then j:=0
else j:= Length(Liens[m]);
ecrireNombre(j, 4);
if j>0 then
for k:= 0 to j-1 do
ecrireNombre(Liens[m, k], 4);
end;
CloseFile(fLex);
end;

À noter la variable globale fLex : file à créer en tête, juste après l'instruction uses :

implementation
uses ulex11;
var fLex : file;

Deux procédures, ecrireMot et ecrireNombre, sont spécialisées dans les accès au disque :

procedure ecrireMot(Moti : string);
var
longMot : byte;
nbOct: integer;
begin
longMot := Length(Moti);
BlockWrite(fLex, longMot, SizeOf(longMot), nbOct);
BlockWrite(fLex, Moti[1], longMot, nbOct);
end;

procedure ecrireNombre(var k; longK: byte);
var nbOct : integer;
begin
BlockWrite(fLex, k, longK, nbOct);
end;

Un lecteur attentif aura remarqué que le nombre peut être enregistré sur une longueur qui sera fixée par paramètre (longK).

Par ailleurs, la variable nbOct reste inutilisée ici : elle serait utile pour analyser un éventuel problème lors des accès au disque.

Pour la lecture, nous reprenons la même méthode ; ne connaissant pas le nombre de mots, le programme va incrémenter une variable jusqu'à rencontrer la fin du fichier. Le code peut s'écrire ainsi :

procedure lireBase;
var
i, j, k, iTab, nbOct, SLong: integer;
Erreur: integer;

begin
SetLength(Liens, 0);
AssignFile(fLex, 'Lex1.bin'); //=nouveau fichier==================
{$I-}
Reset(fLex, 1);
{$I+}
Erreur := IOResult;
if Erreur <> 0 then
ReWrite(fLex, 1);
i:=0;//indice du mot
iTab :=0;//indice du tableau de liens
listeMots.Clear;
while not EOF(fLex) do
begin
listeMots.Append(Lire);
j := lireNombre(4);
if j>0 then
begin
SetLength(Liens, Length(Liens)+1);
SetLength(Liens[iTab], j);
for k:=0 to j-1 do
Liens[iTab, k] :=  lireNombre(4);
inc(iTab);
end;
inc(i);
end;

CloseFile(fLex);
end;

Les accès disque sont réservés aux fonctions Lire et lireNombre :

function lire: string;
var
longMot : byte;
nbOct: integer;
S: string;

begin
BlockRead(fLex, longMot, 1, nbOct);
SetLength(S, longMot);
BlockRead(fLex, S[1], longMot, nbOct);
lire := S;
end;

function lireNombre(i: byte): integer;
var
nbOct: integer;
begin
BlockRead(fLex, Result, i, nbOct);

end;

Il nous reste maintenant à évaluer le résultat.

Nous introduisons un nouveau bouton, propriété Caption « Chrono2 », et dans la procédure onClick de ce bouton nous déclenchons le chrono pour encadrer les tâches d'enregistrement et de lecture :

procedure TForm1.Button5Click(Sender: TObject);
begin
TopChro := 0;
TopChrono('Début processus');
ecrireBase;
lireBase;
TopChrono('Fin processus');
end;

Un clic sur le petit triangle vert… un clic sur le bouton Chrono2… un peu de patience… et le résultat désastreux s'affiche :

La réunion des deux fichiers a multiplié le temps de chargement/déchargement par un facteur de 46 !

Voyons si ce délai peut être raccourci.

Compression des mots

Le nouveau fichier de données s'appelle Lex1.bin. Si l'on examine son contenu à l'aide d'un éditeur, Notepad++ par exemple, on constate une répétition systématique de portions de chaînes :

Après tout, pour stocker un mot, il suffit d'enregistrer la différence qu'il présente avec le mot précédent…

Nous créons donc la fonction compteLet, qui fixe le nombre de lettres à reprendre du mot précédent pour le début du mot d'indice i.

function compteLet(MotPrec, Moti: string): byte;
var i : byte;
begin
i:= 1;
while (i<Length(MotPrec)) and (i<Length(Moti))
and (MotPrec[i] = Moti[i]) do inc(i);
compteLet := i-1;
end;

Connaissant ce paramètre, nous pouvons remanier l'organigramme précédent pour l'intégrer lors de l'enregistrement :

1. ouverture d'un fichier, qui sera nommé Lex2.bin ;

2. ouverture d'une boucle qui balaiera toute la liste de mots :

1. pour chaque mot, enregistrement :

1. de sa longueur réduite à la partie droite différente par rapport au mot précédent,

2. de cette partie proprement dite,

3. du nombre de lettres à reprendre du mot précédent,

4. de la taille du tableau de liens qui lui est associé,

1. des liens éventuels.

3. Fermeture du fichier.

La procédure ecrireMot devient ecrireZip :

procedure ecrireZip;
var
i, j, k, m, nbOct : integer;
nLiens, nLet : byte;
Erreur: integer;
S, MotPrec, Moti :      string;
begin

//nTotLiens := 0;
AssignFile(fLex, 'Lex2.bin'); //==========nouveau fichier dico==============================
{$I-}
Reset(fLex, 1);
{$I+}
Erreur := IOResult;
if Erreur <> 0 then
ReWrite(fLex, 1);
Truncate(fLex);
Seek(fLex, 0);
MotPrec := '';
for i := 0 to listeMots.Count - 1 do
//champ par champ à coder (longueur)
begin
Moti := listeMots[i];
nLet := compteLet(MotPrec, Moti);
S := RightStr(Moti, Length(Moti)-nLet);
EcrireMot(S);
EcrireNombre(nLet, 1); //nombre de lettres communes avec le préc
m := Form1.chercheTab(i); //présence de liens
if m<0 then nLiens:=0
else nLiens:= Length(Liens[m]);
ecrireNombre(nLiens, 1);
if nLiens>0 then
for k:= 0 to nLiens-1 do
ecrireNombre(Liens[m, k], 4);
MotPrec := Moti;
end;
CloseFile(fLex);
end;

Pour lire les données ainsi enregistrées, nous créons la procédure lireZip, qui accèdera aux données dans le même ordre :

procedure lireZip;
var   longLiens, nLet : byte;
i, j, k, iTab : integer;
MotPrec, Moti : string;
begin
AssignFile(fLex, 'LexLiens.bin');
{$I-}
Reset(fLex, 1);
{$I+}
if IOResult = 0 then
begin
Seek(fLex, 0);
i := 0;
listeMots.Clear;
SetLength(Liens, 0);
iTab := 0;
MotPrec := '';
while not EOF(fLex) do
begin
Moti   := Lire;
nLet := LireNombre(1); //nombre de lettres à reprendre du précédent
Moti := LeftStr(MotPrec, nLet) + Moti;
listeMots.Append(Moti);
MotPrec := Moti; //
longLiens := lireNombre(1);
if longLiens>0 then
begin
SetLength(Liens, Length(Liens)+1);
SetLength(Liens[iTab], longLiens);
for k:=0 to longLiens-1 do
Liens[iTab, k] :=  lireNombre(4);
inc(iTab);
end;
Inc(i);
end;
nLiens := iTab;
CloseFile(fLex);
end;
end;

Pour évaluer l'efficacité de la méthode, nous mesurons la durée de l'enregistrement et de la lecture des données.

Dans l'onglet Fichier, nous ajoutons un bouton, Caption « Chrono3 », et dans la procédure onClick de ce bouton, nous complétons le code comme précédemment :

procedure TForm1.Button11Click(Sender: TObject);
begin
TopChro := 0;
TopChrono('Début processus');
ecrireZip;
lireZip;
TopChrono('Fin processus');
end;

Un clic sur le petit triangle vert pour lancer l'exécution, un clic sur le nouveau bouton, et le verdict apparaît :

Mode retenu

Sans appel : nos manœuvres aboutissent à des résultats rédhibitoires, et la solution antérieure se révèle nettement supérieure aux variantes envisagées. Nous avions déjà eu l'occasion de signaler la puissance de la fonction précâblée autorisant la lecture d'un texte en une seule fois, et nous constatons encore son efficacité.

Fichiers de données

Volume (KO)

Durée Entrée/Sortie (ms)

LiMots.txt + fichLiens.bin

4 076

500

Lex1.bin

5 043

23 125

Lex2.bin

1 888

28 156

Pourtant, la compacité du fichier zip obtenu (1,9 Mo) présente un certain intérêt : pourquoi ne pas adopter ce format pour sauvegarder les données et les restaurer en cas de problème ?

Le lecteur avisé remplacera les boutons Chrono par un bouton de sauvegarde, et un second destiné à la restauration. Le format de fichier sera évidemment celui qui donne le volume le plus réduit.

Ainsi, il sera armé en cas de problème sur l'un ou l'autre des fichiers de données.

Le troisième bouton pourra être supprimé de l'onglet ainsi que le composant Memo.

Pour revenir aux accès-fichiers antérieurs, nous réactivons les instructions LireFichier et LireLiens dans la procédure FormCreate, et regLiens, regFichier dans la procédure Button1Click.

Fenêtre de choix

Les boîtes de dialogue offertes par Lazarus sont pratiques, mais leurs performances souvent limitées.

Par exemple, si un utilisateur frappe le mot « macon », notre logiciel fait apparaître une fenêtre de confirmation qui présente bien les mots proches existants, et le choix Yes/No. Le signe point d'interrogation ne présente aucun intérêt, de même que la croix de fermeture.

Nous nous proposons ici de créer une boîte de dialogue dans laquelle l'utilisateur pourra cliquer sur un des mots présentés en alternative, pour le sélectionner, et avec un libellé des boutons plus précis.

Principe de fonctionnement

Pour créer une fenêtre de dialogue, nous disposons des fonctions Hide, Show, Activate, Visible, etc. qui permettent d'afficher et de cacher une fenêtre. L'ensemble devient rapidement lourd et complexe.

Pourtant, la tâche devient très simple en utilisant la variable ModalResult liée à chaque fenêtre.

La procédure est la suivante :

- ajouter au projet une nouvelle fiche ;

- la nouvelle fiche est affectée automatiquement d'une variable cachée, ModalResult(45), dont la valeur initiale est fixée à zéro ;

- aussitôt que, dans le cadre d'un événement quelconque, cette variable reçoit une nouvelle valeur (donc différente de zéro), la nouvelle fiche est cachée ;

- la valeur de la variable est récupérable dans la fenêtre principale (ou toute autre fenêtre du projet) sous le nom de ShowModal.

Par exemple, dans la nouvelle fenêtre Form2, nous introduisons un bouton, et dans la procédure onClick de ce bouton, nous écrivons l'instruction unique :

ModalResult:= 333 ;

Aussitôt que l'on aura cliqué sur le bouton, la nouvelle fenêtre disparaîtra. Pour récupérer la valeur de ModalResult dans la variable i, il suffira d'écrire l'instruction :

I := Form2.ShowModal ;

Fenêtre modale

Dans le menu de Lazarus, nous cliquons sur le mot Fichier et choisissons Nouvelle Fiche. L'objet apparaît sur le bureau, complété dans l'éditeur de source par une nouvelle unité que nous enregistrons sous le nom de uDialog.

Déclarations

Cette unité est déclarée à la suite des autres dans la ligne Uses de uLex11 :

interface

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

Par ailleurs, dans l'unité uDialog, nous déclarons l'unité principale uLex11, sous le mot-clé implementation :

implementation

uses uLex11;

{ TForm2 }

Interface graphique

Nous titrons la fenêtre (propriété Caption) en « Choix du mot » et nous lui ajoutons quatre composants :

- un ListBox, qui recevra le mot nouveau et les mots approchants éventuels ;

- un Label qui affichera le mot sélectionné ;

- un bouton (Caption porté à « Confirmer ») ;

- un second bouton, « Abandon ».

Les dispositions sont ajustées à la souris pour obtenir sensiblement ceci :

Pour supprimer les icônes techniques, nous portons à False toutes les valeurs des lignes de BorderIcons dans l'inspecteur d'objets. Au sujet de l'encadrement de la fenêtre, nous choisissons bsDialog dans la ligne BorderStyle.

Code

La procédure Choix affichera dans le ListBox le mot nouveau, transmis en paramètre, suivi de tous les mots approchants. Sa déclaration se fait à la suite des composants. Un appui sur les touches Ctrl + Maj + C créent la nouvelle structure, que nous complétons ainsi :

procedure TForm2.Choix(motNouv: string);
var i : integer;
begin
Label1.Caption:=AnsiToUTF8(motNouv);
ListBox1.Clear;
ListBox1.Items.Append(Label1.Caption);
ListBox1.Selected[0] := True;
iProv := -1;
if Length(tabApprox) > 0 then
for i:= 0 to Length(tabApprox)-1 do
ListBox1.Items.Append(AnsiToUTF8(listeMots[tabApprox[i]]));
end;

La variable provisoire iProv recevra les indices des mots choisis ; au départ, elle vaut -1, ce qui exprime que le mot sélectionné est le mot nouveau. Cette variable sera modifiée dans d'autres procédures : il faut donc la déclarer en variable globale.

var
Form2: TForm2;
iProv : integer;

implementation

uses uLex11;

{ TForm2 }

Pour modifier la sélection, nous utilisons l'événement onClick du listBox :

procedure TForm2.ListBox1Click(Sender: TObject);
begin
Label1.Caption:= ListBox1.GetSelectedText;
if ListBox1.ItemIndex>0 then iProv := tabApprox[ListBox1.ItemIndex-1]
else  iProv := -1;
end;

Pour confirmer le choix, nous cliquons sur le premier bouton ; la procédure onClick s'écrit simplement ainsi :

procedure TForm2.Button1Click(Sender: TObject);
begin
ModalResult := iProv;
end;

Et pour abandonner, un clic sur le 2e bouton déclenchera la procédure suivante :

procedure TForm2.Button2Click(Sender: TObject);
begin
ModalResult := -2;
end;

Ouverture du dialogue

Jusqu'à présent, la boîte de dialogue s'ouvrait dans le cours de la fonction fAnnonceMotNouveau : nous la remanions pour lancer la procédure Choix et récupérer la valeur de ShowModal.

function TForm1.fAnnonceMotNouveau(motNouv: string): integer;
var i, indexMotNouv  : integer;

begin
Form2.Choix(motNouv);
i := Form2.ShowModal;
Case i of
-2 : ShowMessage('Abandon');
-1 : begin
indexMotNouv := fMotNouv(motNouv);
AjoutMot(motNouv, indexMotNouv);
fAnnonceMotNouveau := indexMotNouv;
end ;
else begin
fAnnonceMotNouveau := i;
Edit3.Caption := AnsiToUTF8(listeMots[i]);
end;
end;
end;

Application

Nous allons tester notre nouvelle boîte de dialogue en entrant le nom de Pâris, qui est le fils de Priam, roi de Troie. Dans l'onglet Liens, nous écrivons « Pâris » et cliquons sur la flèche vers le haut : notre nouvelle fenêtre de dialogue apparaît.

À cet instant, l'utilisateur aura la possibilité de sélectionner un des deux autres mots, de changer d'avis, et enfin de confirmer son choix ou d'abandonner. Dès qu'il aura pris sa décision (un clic sur un bouton est nécessaire), la fenêtre de dialogue disparaîtra et la gestion habituelle de notre dictionnaire pourra reprendre.

Il semble que l'ergonomie de notre projet se soit nettement améliorée… mais incontestablement, il reste encore à faire pour le mettre à l'abri de toute critique !

Conclusion

Ce chapitre nous a montré comment stocker et sauvegarder nos données de façon efficace : rapide pour un accès courant, compacte pour des sauvegardes de sécurité. Nous avons laissé au lecteur le soin de nettoyer le dernier onglet pour ne laisser, outre le bouton Arrêt, que les boutons Sauvegarde et Récupération.

Par ailleurs, nous avons réalisé une boîte de dialogue personnalisée qui améliore l'assistance de l'utilisateur lorsqu'il entre un mot nouveau. La programmation se révèle particulièrement simple et le résultat convaincant.

Notre projet tient maintenant la route et nous espérons qu'il sera utile à de nombreux cruciverbistes et… aux apprentis programmeurs, qui peuvent constater ici que l'informatique peut - aussi - aborder des domaines aussi complexes que le vocabulaire, l'orthographe, et… l'association d'idées.

Cédille

Signe typographique inventé par un certain M. Duçon.

Code

Unité uLex11

unit ulex11;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button10: TButton;
Button11: TButton;
Button12: TButton;
Button2: TButton;
Button3: TButton;
boutFH: TButton;
boutReq: TButton;
boutMasq: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
CheckBox1: TCheckBox;
edMasq: TEdit;
edReq: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
labMasq: TLabel;
labReq: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
ListBox4: TListBox;
lisReq: TListBox;
lisMasq: TListBox;
Memo1: TMemo;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
TabSheet6: TTabSheet;
tabLogique: TTabSheet;
Zoom: TGroupBox;
Label1: TLabel;
Label2: TLabel;
AffListe: TListBox;
PageControl1: TPageControl;
Page1: TTabSheet;
TabSheet1: TTabSheet;
TrackBar1: TTrackBar;
UpDown2: TUpDown;
procedure AffListeClick(Sender: TObject);
procedure boutFHClick(Sender: TObject);
procedure boutMasqClick(Sender: TObject);
procedure boutReqClick(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button12Click(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 tabLogiqueExit(Sender: TObject);
procedure tabLogiqueShow(Sender: TObject);
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 MAJBalayage;
procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
procedure ZoomMouseLeave(Sender: TObject);
function chercheTab(iMot : integer) : integer;
procedure Lier(iMot, iLien : integer);
procedure AffLiens;
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);
procedure AjoutOccur(iOccur : integer);
procedure TriOccur;

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, tabReq, tabOccur : Array of integer;  //index des mots approchants
sAcc, cAcc : string;

implementation

{$R *.lfm}

{ TForm1 }

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

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

procedure TForm1.boutFHClick(Sender: TObject);
var i, j, k : integer;
begin
//ajoute un mot à la liste de base tabReq
i := listeMots.IndexOf(UTF8ToAnsi(edReq.Caption));
if i>=0 then //le mot existe dans la liste principale
begin
j:=0;
k := Length(tabReq);
while (j<k) and (i<>tabReq[j]) do inc(j);
if j=k then      //le mot peut être ajouté
begin
SetLength(tabReq, k+1); //ajoute une unité au tableau
tabReq[k] := i;
//affichage de la requête dans la ligne titre
if labReq.Caption = 'Requête ' then
labReq.Caption:= edReq.Caption //premier mot-clé
else
labReq.Caption:= labReq.Caption +' + '+edReq.Caption;
end;
end;
edReq.Clear;
end;

procedure TForm1.boutMasqClick(Sender: TObject);
var i, j, k : integer;
motCour, sMasque : string;
begin
i := 0;
sMasque := edMasq.Caption;
k := Length(sMasque);
lisMasq.Clear;
repeat
motCour := SansAccent(listeMots[tabOccur[i]]);
if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
begin
j := 1;
while (j<=k) and ((sMasque[j]='$') or (sMasque[j] = motCour[j])) do inc(j);
if j>k  then lisMasq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
end;
inc(i);
until (i=Length(tabOccur));
end;

procedure TForm1.boutReqClick(Sender: TObject);
const profRech = 2;      //fixe la profondeur de la recherche
var i, j, k, n : integer;
begin
if Length(tabReq)>0 then //la requête ne doit pas être vide
begin
for n := 1 to profRech do
begin
SetLength(tabOccur, 0);
for i:=0 to Length(tabReq)-1 do
begin
j := 0;
while (j<Length(Liens)) and (Liens[j, 0]<>tabReq[i])do inc(j);
if j<Length(Liens) then
for k:=1 to Length(Liens[j])-1 do AjoutOccur(Liens[j, k]);
end;
tabReq := tabOccur;
end;
j := Length(tabOccur);
//afficher les occurrences et leur nombre
lisReq.Items.Append(IntToStr(j)+' occurrences : ');
TriOccur; //trier avant affichage
for i:=0 to j-1 do
lisReq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
end;
edMasq.Clear;
edMasq.Visible:=True;
labMasq.Visible:=True;
lisMasq.Visible:=True;
boutMasq.Enabled:=True;
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);
//iLien vaut maintenant l'index du mot nouveau ou approché
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.Button11Click(Sender: TObject);
begin
//regMotCourtsLiens;
ecrirebase;
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
//LireMotCourtsLiens;
lirebase;
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;

begin
Form2.Choix(motNouv);
i := Form2.ShowModal;
Case i of
-2 : ShowMessage('Abandon');
-1 : begin
indexMotNouv := fMotNouv(motNouv);
AjoutMot(motNouv, indexMotNouv);
fAnnonceMotNouveau := indexMotNouv;
end ;
else begin
fAnnonceMotNouveau := i;
Edit3.Caption := AnsiToUTF8(listeMots[i]);
end;
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érfie 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.AjoutOccur(iOccur: integer);
var i : integer;
begin
//vérifier que cette occurrence n'a pas encore été rencontrée
i:=0;
while (i<Length(tabOccur)) and (iOccur<> tabOccur[i])  do inc(i);
if i= Length(tabOccur) then   //première occurrence du mot
begin
SetLength(tabOccur, i+1);
tabOccur[i] := iOccur;
end;
end;

procedure TForm1.TriOccur;
var i, j, occTampon : integer ;
triOK : boolean;
begin
i := 0;
j := Length(tabOccur)-2;
triOK := True;
repeat
if (tabOccur[i] >  tabOccur[i+1])  then
begin
occTampon := tabOccur[i];
tabOccur[i] := tabOccur[i+1];
tabOccur[i+1] := occTampon;
triOK := False;
end;
inc(i);
if not triOK and (i>j) then
begin
i:=0; //nouvelle passe de permutations
triOK:= True;
end;
until triOK and (i>j);
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
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 : 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.Button4Click(Sender: TObject);
begin
uDisque.regMotsLiens;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
lireMotsLiens;
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);
//lireLiens;
lireMotsLiens;
//lirebase;
nMots := listeMots.Count;

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 := 'Lex11 '+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;

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 : integer;
referMot : 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.tabLogiqueExit(Sender: TObject);
begin
SetLength(tabReq, 0);
SetLength(tabOccur, 0);
end;

procedure TForm1.tabLogiqueShow(Sender: TObject);
begin
edReq.Clear;
lisReq.Clear;
labReq.Caption:= 'Requête ';
labMasq.Caption := 'saisir les lettres séparées'+#13+' par le signe $';
boutMasq.Enabled:=False;
edMasq.Clear;
edMasq.Visible:=False;
labMasq.Visible:=False;
lisMasq.Visible:=False;
SetLength(tabReq, 0);
SetLength(tabOccur, 0);
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.

Unité uDisque

unit uDisque;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, Dialogs;

procedure LireFichier(listeMots : TStringList);
procedure regLiens;
procedure lireLiens;
procedure regFichier(listeMots : TStringList);
procedure regMotsLiens;
//function compteLet(Moti, MotSuiv : string) : byte;
function compteLet(MotPrec, Moti: string): byte;
procedure ecrireMot(Moti : string);
procedure ecrireNombre(var k; longK : byte);
procedure lireMotsLiens;
function lireNombre(i : byte) : integer;
function lire : string;
procedure ecrireBase;
procedure lireBase;

implementation

uses ulex11;

var fLex : file;

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;
//====&#8658;&#8658;

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;

procedure regMotsLiens;
var
i, j, k, m, nbOct, SLong: integer;
nLiens, nLet : byte;
Erreur: integer;
S, MotPrec, Moti :      string;
begin

//nTotLiens := 0;
AssignFile(fLex, 'LexLiens.bin'); //==========nouveau fichier dico==============================
{$I-}
Reset(fLex, 1);
{$I+}
Erreur := IOResult;
if Erreur <> 0 then
ReWrite(fLex, 1);
Truncate(fLex);
Seek(fLex, 0);
MotPrec := '';
for i := 0 to listeMots.Count - 1 do
//champ par champ à coder (longueur)
begin
Moti := listeMots[i];
nLet := compteLet(MotPrec, Moti);
S := RightStr(Moti, Length(Moti)-nLet);
EcrireMot(S);
EcrireNombre(nLet, 1); //nombre de lettres communes avec le préc
m := Form1.chercheTab(i); //présence de liens
//ShowMessage(IntToStr(j)+' liens');
if m<0 then nLiens:=0
else nLiens:= Length(Liens[m]);
ecrireNombre(nLiens, 1);
if nLiens>0 then
for k:= 0 to nLiens-1 do
ecrireNombre(Liens[m, k], 4);
MotPrec := Moti;
end;
CloseFile(fLex);
end;

function compteLet(MotPrec, Moti: string): byte;
var i : byte;
begin
i:= 1;
while (i<Length(MotPrec)) and (i<Length(Moti))
and (MotPrec[i] = Moti[i]) do inc(i);
compteLet := i-1;
end;

procedure ecrireNombre(var k; longK: byte);
var nbOct : integer;
begin
BlockWrite(fLex, k, longK, nbOct);
end;

procedure lireMotsLiens;
var   longLiens, nLet : byte;
i, j, k, iTab : integer;
MotPrec, Moti : string;
begin
AssignFile(fLex, 'LexLiens.bin');
{$I-}
Reset(fLex, 1);
{$I+}
if IOResult = 0 then
begin
Seek(fLex, 0);
i := 0;
listeMots.Clear;
SetLength(Liens, 0);
iTab := 0;
MotPrec := '';
while not EOF(fLex) do
begin
Moti   := Lire;
nLet := LireNombre(1); //nombre de lettres à reprendre du précédent
Moti := LeftStr(MotPrec, nLet) + Moti;
listeMots.Append(Moti);
MotPrec := Moti; //
longLiens := lireNombre(1);
if longLiens>0 then
begin
SetLength(Liens, Length(Liens)+1);
SetLength(Liens[iTab], longLiens);
for k:=0 to longLiens-1 do
Liens[iTab, k] :=  lireNombre(4);
inc(iTab);
end;
Inc(i);
end;
nLiens := iTab;
CloseFile(fLex);
end;
end;

function lireNombre(i: byte): integer;
var
nbOct: integer;
begin
BlockRead(fLex, Result, i, nbOct);
end;

function lire: string;
var
longMot : byte;
nbOct: integer;
S: string;

begin
BlockRead(fLex, longMot, 1, nbOct);
SetLength(S, longMot);
BlockRead(fLex, S[1], longMot, nbOct);
lire := S;
end;

procedure ecrireBase;
var
i, j, k, m, nbOct, SLong: integer;
nLiens, nLet : byte;
Erreur: integer;
Moti :      string;
begin
AssignFile(fLex, 'Lex1.bin'); //==========nouveau fichier==============================
{$I-}
Reset(fLex, 1);
{$I+}
Erreur := IOResult;
if Erreur <> 0 then
ReWrite(fLex, 1);
for i := 0 to listeMots.Count - 1 do
//champ par champ à coder (longueur)
begin
Moti := listeMots[i];
ecrireMot(Moti);
m := Form1.chercheTab(i); //présence de liens
if m<0 then j:=0
else j:= Length(Liens[m]);
ecrireNombre(j, 4);
if j>0 then
for k:= 0 to j-1 do
ecrireNombre(Liens[m, k], 4);
end;
CloseFile(fLex);
end;

procedure lireBase;
var
i, j, k, iTab, nbOct, SLong: integer;
Erreur: integer;

begin
SetLength(Liens, 0);
AssignFile(fLex, 'Lex1.bin'); //==========nouveau fichier==============================
{$I-}
Reset(fLex, 1);
{$I+}
Erreur := IOResult;
if Erreur <> 0 then
ReWrite(fLex, 1);
i:=0;
iTab :=0;
listeMots.Clear;
while not EOF(flex) do
begin
listeMots.Append(Lire);
j := lireNombre(4);
if j>0 then
begin
SetLength(Liens, Length(Liens)+1);
SetLength(Liens[iTab], j);
for k:=0 to j-1 do
Liens[iTab, k] :=  lireNombre(4);
inc(iTab);
end;
inc(i);
end;

CloseFile(fLex);
end;

procedure ecrireMot(Moti : string);
var
longMot : byte;
nbOct: integer;
begin
longMot := Length(Moti);
BlockWrite(fLex, longMot, SizeOf(longMot), nbOct);
BlockWrite(fLex, Moti[1], longMot, nbOct);
end;

end.

Unité uDialog

unit uDialog;

{$mode objfpc}{$H+}

interface

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

type

{ TForm2 }

TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Choix(motNouv : string);
procedure ListBox1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
Form2: TForm2;
iProv : integer;

implementation

uses uLex11;

{ TForm2 }

procedure TForm2.Choix(motNouv: string);
var i : integer;
begin
Label1.Caption:=AnsiToUTF8(motNouv);
ListBox1.Clear;
ListBox1.Items.Append(Label1.Caption);
ListBox1.Selected[0] := True;
iProv := -1;
if Length(tabApprox) > 0 then
for i:= 0 to Length(tabApprox)-1 do
ListBox1.Items.Append(AnsiToUTF8(listeMots[tabApprox[i]]));
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
ModalResult := iProv;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
ModalResult := -2;
end;

procedure TForm2.ListBox1Click(Sender: TObject);
begin
Label1.Caption:= ListBox1.GetSelectedText;
if ListBox1.ItemIndex>0 then iProv := tabApprox[ListBox1.ItemIndex-1]
else  iProv := -1;
end;

{$R *.lfm}

end.

Projet complet

Pour charger les fichiers de données et l'ensemble des sources du projet, cliquez ici.

Synthèse

Introduction

La graphie d'un mot constitue une source inépuisable d'inspiration pour les auteurs de mots croisés. Un bonheur pour les cruciverbistes.

Pour les écoliers, il s'agit plutôt d'un problème… ou d'un cauchemar !

Et pour les informaticiens ?

Il faut dire que l'informatique a pris son temps pour passer du langage binaire au langage décimal, puis pour intégrer le jeu de caractères employé sur le plan international pour les télégrammes et les télex, avec l'adoption du standard américain ASCII.

Un standard qui a figé pour longtemps le code affecté à chaque caractère.

Mais pas tous les caractères…

En France, en 2014, nous constatons encore, jour après jour, que des problèmes d'affichage ou d'écriture affectent les mots ou noms qui contiennent des accents…

La maîtrise de l'orthographe n'est pas seule en cause : les fichiers de données peuvent être corrects, alors que les machines chargées de les exploiter n'ont pas systématiquement été configurées pour traiter ces mots particuliers avec le soin nécessaire.

Est-ce si difficile ?

Environnement

Les onze premiers chapitres ont permis de construire un logiciel qui offre la possibilité de consulter une base de vocabulaire consistante, et de l'enrichir par des mots nouveaux et des liens  logiques.

En d'autres termes, le moteur mémorise à volonté les associations d'idées plus ou moins humoristiques qui constituent les définitions des mots croisés.

La méthode de développement du logiciel s'est voulue résolument didactique : elle s'adresse à un programmeur débutant et le guide, par des réflexions de bon sens et des informations pratiques, à construire pas à pas un logiciel efficace.

Le présent chapitre va reconstruire la machine en supprimant toutes les digressions qui se sont révélées parfois stériles ou laborieuses.

Le résultat se révèle plus compact et plus indigeste, mais les plus pressés y trouveront leur compte.

Le code s'est allégé, mais les principes adoptés n'ont pas changé : les explications fournies dans les chapitres précédents restent entièrement valables.

Du passé faisons table rase.

Chapitre 12…

Créons un répertoire Lex12 et recopions dans ce nouveau répertoire :

- le fichier LexLiens.bin(46), de 1,9 Mo ;

- le fichier icône Lex12.ico(47) (facultatif), de 48 ko.

À partir de ces deux fichiers, nous allons construire une base de données consultable et modifiable avec pour objectif une pratique des mots croisés de plus en plus aisée grâce à l'enrichissement de la base en mots et en liens.

Nous allons utiliser Lazarus : tout autre langage ferait l'affaire. Mais dans le domaine de l'Open Source, il faut reconnaître que cet outil -entièrement gratuit- propose des éléments graphiques particulièrement simples à utiliser.

Ce chapitre constituera ainsi un hommage à l'équipe bénévole qui a su bâtir ce brillant utilitaire, le perfectionner d'année en année, et le maintenir à la disposition de tous.

Nous utilisons ici la version 1.0.14, qui date de novembre 2013.

Conventions

Nous disposons d'une liste de mots au format ANSI(48). Les affichages se font au format UTF8(49), qui fait intervenir des chaînes de caractères plus internationales, mais plus longues, plus complexes à trier et à gérer.

Pour afficher les chaînes en mémoire, nous utiliserons la fonction ANSIToUTF8, et inversement, la fonction UTF8ToANSI pour mémoriser les chaînes saisies par l'utilisateur.

Les affichages respectent le code UTF8. Les traitements (comptage des caractères en particulier) se font en code ANSI.

Par ailleurs, notre objectif est le jeu de mots croisés. Dans ce cadre, nous notons que :

1. les majuscules ne comptent pas ;

2. les nombres entrent dans les définitions ;

3. les espaces, apostrophes ou traits d'union sont supprimés ;

4. les accents et la cédille sont également supprimés.

Au niveau du tri, cela modifie beaucoup de choses.

Pourtant, nous décidons de conserver l'orthographe d'origine des mots (casse, accents, signes typographiques…) et de les classer dans la logique des mots croisés.

Pour cela, nous créons un filtre qui débarrassera chaque mot de ses majuscules, espaces, apostrophes, traits d'union, accents ou cédilles, et lançons le classement sur les mots filtrés, tout en maintenant l'orthographe d'origine dans la liste triée.

Le fonctionnement est simple.

Soient A et B deux mots « bruts », c'est-à-dire qu'ils sont susceptibles de contenir des accents ou signes spéciaux ; soient Af et Bf les mêmes mots mais passés par la moulinette du filtre :

si Af>Bf, nous décidons de placer A après B.

Le classement général est réalisé à l'origine par nos soins. Par la suite, le classement interviendra uniquement pour l'introduction d'un mot nouveau.

Le classement adopté ne correspond pas systématiquement au classement de nos dictionnaires habituels : c'est volontaire.

L'ossature de notre base de données est virtuelle : elle est constituée par la position de chaque mot dans la liste.

Les liens sont des nombres entiers qui font référence à la position de chaque mot : le premier mot de la liste est placé à la position 0 et tout lien portant ce numéro fera référence à ce premier mot.

Pour stocker les liens, nous avons choisi un tableau de tableaux d'entiers appelé Liens.

Supposons que le premier mot possède des liens : nous aurons Liens[0,0]:=0 pour identifier le tableau secondaire qui stockera ses liens. Le premier lien i avec ce mot sera stocké à la place suivante : Liens[0,1]:=i.

Le tableau principal est trié par ordre croissant des premières cases (identifiants).

Les tableaux secondaires sont triés par ordre croissant des valeurs qui occupent les cases suivantes.

Grâce à ces classements systématiques, les temps d'accès au tableau principal et à la valeur d'un lien se trouvent nettement réduits : le parcours est ramené, en moyenne, de la totalité d'une liste à sa moitié.

Interface graphique

Nous lançons Lazarus, fermons tous les fichiers ouverts et sélectionnons Nouveau projet : nous ajoutons une nouvelle fiche, puis une nouvelle unité.

Nous enregistrons l'ensemble dans le répertoire Lex12 en adoptant la nomenclature habituelle :

- projet renommé en pLex12 ;

- unité de la première fiche uLex12 ;

- unité de la seconde fiche uDialog ;

- troisième unité uDisque.

Chacune des unités inclut une ligne uses ; dans la ligne uses de uLex12, nous ajoutons uDialog et uDisque. Dans uDialog, sous le mot-clé implementation, nous ajoutons uses uLex12 ; de même pour uDisque.

Dans la première fenêtre, nous introduisons un composant PageControl et nous modifions sa taille pour qu'il occupe la totalité de la fenêtre. Dans ce composant, nous ajoutons cinq pages que nous renommons respectivement Recherche, Lecture, Ajout, Suppression et Fichier.

Page Fichier

Un clic sur la dernière page, et nous ajoutons trois boutons qui porteront les libellés Sauvegarder, Restaurer et Quitter. Nous arrangeons l'ensemble avec la souris pour obtenir sensiblement ceci :

Le premier bouton est destiné à enregistrer les données (vocabulaire et liens) en un fichier unique, de type compact. Le suivant fera exactement l'inverse. Le troisième bouton fermera l'application et assurera au préalable l'enregistrement des fichiers de mots et de liens dans des formats autorisant l'ouverture et la fermeture de l'application dans le délai le plus court.

Lors du premier accès, l'utilisateur cliquera sur le bouton Quitter de façon que le logiciel construise les fichiers de travail au format le plus performant et en permette les accès automatiques ultérieurs.

L'unité uDisque est complétée comme suit :

Notez dans la ligne Uses l'ajout de l'unité Dialogs, nécessaire pour l'instruction ShowMessage. Nous verrons comment créer notre boîte de dialogue personnalisée, ce qui rendra cet ajout inutile.

unit uDisque;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, Dialogs;

procedure lireMotsLiens;
function lire: string;
function lireNombre(i : byte) : integer;
procedure regFichier;
procedure regLiens;
procedure lireFichier;
procedure lireLiens;
procedure regMotsLiens;
function compteLet(MotPrec, Moti: string): byte;
procedure ecrireMot(Moti : string);
procedure ecrireNombre(var k; longK : byte);

var listeMots : TStringList;
Liens : array of array of integer;
nLiens, nMots : integer;
fLex : file;

implementation
uses uLex12;

procedure lireMotsLiens;
var   longLiens, nLet : byte;
i, k, iTab : integer;
MotPrec, Moti : string;
begin
AssignFile(fLex, 'LexLiens.bin');
{$I-}
Reset(fLex, 1);
{$I+}
if IOResult = 0 then
begin
Seek(fLex, 0);
i := 0;
listeMots := TStringList.Create;
SetLength(Liens, 0);
iTab := 0;
MotPrec := '';
while not EOF(fLex) do
begin
Moti   := Lire;
nLet := LireNombre(1); //nombre de lettres à reprendre du précédent
Moti := LeftStr(MotPrec, nLet) + Moti;
listeMots.Append(Moti);
MotPrec := Moti; //
longLiens := lireNombre(1);
if longLiens>0 then
begin
SetLength(Liens, Length(Liens)+1);
SetLength(Liens[iTab], longLiens);
for k:=0 to longLiens-1 do
Liens[iTab, k] :=  lireNombre(4);
inc(iTab);
end;
Inc(i);
end;
nLiens := iTab;
CloseFile(fLex);
end;
end;

function lire: string;
var
longMot : byte;
nbOct: integer;
S: string;

begin
BlockRead(fLex, longMot, 1, nbOct);
SetLength(S, longMot);
BlockRead(fLex, S[1], longMot, nbOct);
lire := S;
end;

function lireNombre(i: byte): integer;
var
nbOct: integer;
begin
BlockRead(fLex, Result, i, nbOct);
end;

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

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

begin
AssignFile(fLiens, 'fichLiens.bin');
{$I-}
Reset(fLiens, 1);
{$I+}
if IOResult <> 0 then
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 lireFichier;
begin
try
listeMots.LoadFromFile('liMots.txt');
except ShowMessage('fichier de mots inexistant');
end;
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
lireMotsLiens
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 regMotsLiens;
var
i, k, m, nbOct, SLong: integer;
nLiens, nLet : byte;
Erreur: integer;
S, MotPrec, Moti : string;
begin
AssignFile(fLex, 'LexLiens.bin'); //==========nouveau fichier dico==============================
{$I-}
Reset(fLex, 1);
{$I+}
Erreur := IOResult;
if Erreur <> 0 then
ReWrite(fLex, 1);
Truncate(fLex);
Seek(fLex, 0);
MotPrec := '';
for i := 0 to listeMots.Count - 1 do
//champ par champ à coder (longueur)
begin
Moti := listeMots[i];
nLet := compteLet(MotPrec, Moti);
S := RightStr(Moti, Length(Moti)-nLet);
EcrireMot(S);
EcrireNombre(nLet, 1); //nombre de lettres communes avec le préc
m := Form1.ChercheTabLiens(i); //présence de liens
if m<0 then nLiens:=0
else nLiens:= Length(Liens[m]);
ecrireNombre(nLiens, 1);
if nLiens>0 then
for k:= 0 to nLiens-1 do
ecrireNombre(Liens[m, k], 4);
MotPrec := Moti;
end;
CloseFile(fLex);
end;

function compteLet(MotPrec, Moti: string): byte;
var i : byte;
begin
i:= 1;
while (i<Length(MotPrec)) and (i<Length(Moti))
and (MotPrec[i] = Moti[i]) do inc(i);
compteLet := i-1;
end;

procedure ecrireMot(Moti: string);
var
longMot : byte;
nbOct: integer;
begin
longMot := Length(Moti);
BlockWrite(fLex, longMot, SizeOf(longMot), nbOct);
BlockWrite(fLex, Moti[1], longMot, nbOct);
end;

procedure ecrireNombre(var k; longK: byte);
var nbOct : integer;
begin
BlockWrite(fLex, k, longK, nbOct);
end;

end.

Le code est expliqué en détail dans les chapitres précédents.

Pour la transmission des commandes, nous créons dans l'unité uLex12 les procédures onClick de chacun des boutons.

Cette unité se présente comme suit :

unit uLex12;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button2Click(Sender: TObject);
//restauration depuis le fichier de sauvegarde
begin
LireMotsLiens;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
listeMots := TStringList.Create;
listeMots.CaseSensitive:=True;
lireFichier;
lireLiens;
nMots := listeMots.Count;
Caption := 'Lexique de '+IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens)+' liés';
end;

end.

Lançons le logiciel. Un premier message nous informe que le fichier de mots n'existe pas. Le logiciel détecte ensuite une erreur dans la lecture du fichier de liens et lance la lecture du fichier compact. Et là apparaissent, en titre, le nombre de mots disponibles, ainsi que le nombre de mots disposant de liens :

Pour créer le fichier de mots au format texte et le fichier de liens au format numérique, il suffira de cliquer sur le bouton Quitter.

Le bouton Sauvegarder ne dispose pas encore de procédure associée : l'enregistrement au format compact nécessite quelques développements préalables, et nous y reviendrons.

L'ensemble des trois fichiers constitue une base robuste, apte à faire face à toutes sortes de difficultés ultérieures.

Par la suite, pour accéder au fichier de récupération, il sera nécessaire de supprimer au préalable les fichiers séparés mots/liens qui auraient été corrompus accidentellement.

Page Lecture

Dans l'onglet Lecture, nous introduisons sept composants :

- un TrackBar ;

- deux Label ;

- deux ListBox ;

- deux UpDown.

et nous les agençons sensiblement comme ceci :

Pour naviguer dans notre vaste base de vocabulaire, nous disposons ainsi de deux outils principaux, l'index du TrackBar, et les flèches Droite/Gauche. Pour compléter ces flèches, nous ajoutons un zoom pour que le balayage puisse se faire mot à mot, ou par sauts de 10, 100 unités, ou davantage.

Le mot-titre sera affiché dans le Label1 ; les mots voisins dans le premier ListBox et les mots liés dans le second.

Mais nos listes seront dynamiques : un clic de la souris sur l'un ou l'autre des mots basculera le mot sélectionné en titre, avec mise à jour de l'ensemble.

Un tableau résumera mieux les événements que nous désirons gérer pour chaque composant :

Composant

Événement

Procédure

Action

TrackBar

Lâcher de la souris sur le curseur

TrackBar1MouseUp

Modifie l'index principal iMot

Label1

-

-

Mot titre correspondant à iMot

Label2

-

-

Indique la puissance du zoom

ListBox1

Sélectionne un mot de la liste

ListBox1Click

Modifie l'index principal

ListBox2

Sélectionne un mot de la liste

ListBox2Click

Modifie l'index principal

UpDown1

Clic sur une flèche

UpDown1Click

Incrémente/décrémente l'index principal de la valeur iZoom

UpDown2

Clic sur une flèche

UpDown2Click

Multiplie/divise l'incrément iZoom par un facteur de 10
et met à jour le label2

L'utilisateur doit trouver un affichage correct lorsqu'il ouvrira l'onglet Lecture : nous gérerons également l'événement TabSheet2Show.

Chaque événement sera suivi par la mise à jour de l'affichage par l'intermédiaire des procédures AfficheLecture et AfficheLiens. Le tableau de liens commence, s'il existe, par un entier égal à l'index principal : la position est déterminée par la fonction ChercheTabLiens et stockée dans la variable globale iTabLiens.

procedure TForm1.AfficheLecture;
var i : integer;
begin
Label2.Caption:='Zoom x '+ IntToStr(iZoom);
TrackBar1.Position:= Round(iMot*1000/nMots);
Label1.Caption:= AnsiToUTF8(ListeMots[iMot]);
ListBox1.Clear;
for i := 0 to 10  do
ListBox1.Items.Add(AnsiToUTF8(ListeMots[(iMot-5 + i + nMots) mod nMots]));
ListBox1.Selected[5] := True;
AfficheLiens;
end;

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

procedure TForm1.AfficheLiens;
var i : integer;
begin
if Length(Liens)>0 then
begin
ListBox2.Clear;
iTabLiens := chercheTabLiens(iMot);
if iTabLiens>=0 then
for i :=1 to Length(Liens[iTabLiens]) -1 do
if TabSheet2.TabVisible then
ListBox2.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]))
else if TabSheet2.TabVisible then
ListBox5.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]));
end;
end;

Navigation par le curseur

Au démarrage, l'utilisateur constate sur l'onglet Lecture que le premier mot du dictionnaire est affiché en titre : iMot = 0.

Pour se déplacer au sein de la base, le plus simple est de déplacer le curseur du composant TrackBar : la mise à jour sera effectuée par l'intermédiaire de la procédure TrackBar1MouseUp :

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

La position du curseur varie entre 0 et 1000 : pour cela, il faut modifier dans l'inspecteur d'objets la propriété Max du TrackBar et la porter évidemment à 1000.

Lancez l'exécution pour vérifier que la navigation se fait correctement sur toute la plage.

Navigation par les flèches

L'utilisation des flèches est plus précise. Nous fixons au départ à 1 la valeur de iZoom.

La variable globale iZoom doit être déclarée en tête et sa valeur initiée dans la procédure FormCreate.

Un clic sur la flèche permet d'incrémenter/décrémenter la valeur courante de iMot :

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then Inc(iMot, iZoom)
else  Dec(iMot, iZoom);
iMot := (iMot + nMots) mod nMots;
AfficheLecture;
end;

Dans certaines circonstances, la navigation peut se révéler trop lente, d'où l'introduction du second UpDown, qui ajustera cette fois la puissance du zoom :

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then iZoom := iZoom*10
else iZoom := iZoom div 10;
Case iZoom of
0       : iZoom := 1;
1000000 : iZoom := 100000;
end;
Label2.Caption:= 'Zoom x '+IntToStr(iZoom);
end;

Nous avons encadré le paramètre dans l'intervalle 1-100000.

Lançons l'exécution et modifions le zoom : la navigation est maintenant rapide et précise.

Sélection d'un mot voisin

Le premier ListBox affiche les cinq mots précédant le mot titre et les cinq suivants. L'utilisateur doit pouvoir ajuster son choix en sélectionnant l'un de ces mots :

procedure TForm1.ListBox1Click(Sender: TObject);
begin
iMot := (iMot-5+ListBox1.ItemIndex + nMots) mod nMots;
AfficheLecture;
end;

Un clic sur un mot de la liste provoque la mise à jour de l'affichage.

Sélection d'un lien

De même, l'utilisateur doit pouvoir cliquer sur l'un des mots liés pour le faire passer en titre :

procedure TForm1.ListBox2Click(Sender: TObject);
begin
if iTabLiens >= 0 then
begin
iMot := Liens[iTabLiens, ListBox2.ItemIndex+1];
AfficheLecture;
end;
end;

Rappelons que iTabLiens est négatif si le mot titre n'a pas de lien, et, dans le cas contraire, il indique la position du tableau d'entiers Liens[iTabLiens].

Lancez l'exécution pour vérifier que tous les événements sont gérés correctement :

La navigation se révèle facile et rapide.

L'efficacité d'un filtre limitant l'affichage aux mots disposant de liens a été démontrée dans les chapitres précédents… mais la question de son utilité est posée.

Page Recherche

Le cruciverbiste n'a pas -ou exceptionnellement- de réponse immédiate à la définition qu'il découvre. Notre logiciel va pouvoir l'aider sur deux aspects :

- la logique, en exploitant les mots clés de la définition ;

- le filtrage les mots selon leur longueur du mot, complétée, s'il y a lieu, par les lettres déjà déterminées (ou probables) dans certaines positions.

Dans notre page Recherche, nous introduisons neuf composants :

- deux labels ;

- trois boutons ;

- deux Edit ;

- deux ListBox.

et agençons l'ensemble pour obtenir ceci :

Nous attribuons à chaque composant les missions suivantes :

Composant

Tâche

Événement

Propriétés

Label3

Reçoit le complément de requête

-

Taille des caractères : 14

Button4

Fait basculer le mot saisi dans Edit1 en Label3

onClick

Caption : flèche haut
Efface Edit1

Edit1

Reçoit un à un les mots clés

Saisie au clavier

Button5

Lance la requête

onClick

Caption : Logique
Efface Edit1

ListBox3

Reçoit les réponses à la requête

-

-

Label4

information

-

Caption : saisir les lettres connues séparées par le signe $

Edit2

Reçoit les détails du masque

Saisie au clavier

Button6

Lance la recherche

onClick

Caption : Chercher

ListBox4

Reçoit les réponses à la recherche

La partie gauche de la fenêtre est spécialisée dans la logique, la partie droite dans le masque ; mais les deux parties peuvent se compléter en fonction des besoins.

Logique

Le principe de la recherche logique est de rassembler tous les mots liés aux mots clés introduits par l'utilisateur. L'opération est répétée une fois : la première liste sert de base, à son tour, pour déterminer tous les mots associés qui seront affichés dans le premier ListBox.

Une seule occurrence suffit, la fréquence n'est pas prise en compte.

La saisie se fait dans le cadre Edit1 et le bouton Flèche vers le haut fait basculer le mot dans la ligne-titre, qui constituera la requête. Un contrôle préalable vérifie que le mot saisi figure bien dans la base de données : à défaut, il sera ignoré. L'indice du mot est stocké dans le tableau tabReq.

L'utilisateur complète sa requête selon ses désirs, et, lorsqu'elle est achevée, il clique sur le bouton Logique pour obtenir tous les mots liés dont les indices sont stockés dans le tableau tabOccur.

Pour éviter les interférences, l'onglet est nettoyé dès qu'il est affiché.

//préparation de l'onglet
procedure TForm1.TabSheet1Show(Sender: TObject);
begin
Label3.Caption := 'Saisir la requête';
Label4.Caption := 'Saisir les lettres' + #13 +'séparées par le signe $' ;
Edit1.Clear;
Edit2.Clear;
ListBox3.Clear;
ListBox4.Clear;
SetLength(tabReq, 0);
SetLength(tabOccur, 0);
end;

//saisie de la requête
procedure TForm1.Button4Click(Sender: TObject);
var i, j, k : integer;
begin
//ajoute un mot à la liste de base tabReq
i := ListeMots.IndexOf(UTF8toAnsi(Edit1.Caption));
if i>=0 then //le mot existe dans la liste principale
begin
j:=0;
k := Length(tabReq);
while (j<k) and (i<>tabReq[j]) do inc(j);
if j=k then      //le mot peut être ajouté
begin
SetLength(tabReq, k+1); //ajoute une unité au tableau
tabReq[k] := i;
//affichage de la requête dans la ligne titre
if Label3.Caption = 'Saisir la requête' then
Label3.Caption:= Edit1.Caption //premier mot clé
else
Label3.Caption:= Label3.Caption +' + '+Edit1.Caption;
end;
end;
Edit1.Clear;
end;

//recherche logique
procedure TForm1.Button5Click(Sender: TObject);
const profRech = 2;      //fixe la profondeur de la recherche
var i, j, k, n : integer;
begin
if Length(tabReq)>0 then //la requête ne doit pas être vide
begin
for n := 1 to profRech do
begin
SetLength(tabOccur, 0);
for i:=0 to Length(tabReq)-1 do
begin
j := 0;
while (j<Length(Liens)) and (Liens[j, 0]<>tabReq[i])do inc(j);
if j<Length(Liens) then
for k:=1 to Length(Liens[j])-1 do AjoutOccur(Liens[j, k]);
end;
tabReq := tabOccur;
end;
j := Length(tabOccur);
//afficher les occurrences et leur nombre
ListBox3.Items.Append(IntToStr(j)+' occurrences : ');
TriOccur; //trier avant affichage
for i:=0 to j-1 do
ListBox3.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
end;
end;

//ajout d'une occurrence
procedure TForm1.AjoutOccur(iOccur: integer);
var i : integer;
begin
//vérifier que cette occurrence n'a pas encore été rencontrée
i:=0;
while (i<Length(tabOccur)) and (iOccur<> tabOccur[i])  do inc(i);
if i= Length(tabOccur) then   //première occurrence du mot
begin
SetLength(tabOccur, i+1);
tabOccur[i] := iOccur;
end;
end;

//tri des occurrences avant affichage
procedure TForm1.TriOccur;
var i, j, occTampon : integer ;
triOK : boolean;
begin
i := 0;
j := Length(tabOccur)-2;
triOK := True;
repeat
if (tabOccur[i] >  tabOccur[i+1])  then
begin
occTampon := tabOccur[i];
tabOccur[i] := tabOccur[i+1];
tabOccur[i+1] := occTampon;
triOK := False;
end;
inc(i);
if not triOK and (i>j) then
begin
i:=0; //nouvelle passe de permutations
triOK:= True;
end;
until (i>j);
end;

La propriété Font/Size du Label3 est portée à 14.

Nous pouvons essayer le dispositif en entrant successivement les mots « baignoire » et « lavabo » :

Un clic sur le bouton Logique apporte la réponse, pour l'instant… énigmatique.

Masque

La partie droite de l'onglet Recherche est consacrée à l'exploitation du masque : le cruciverbiste connaît la longueur du mot, et pourra indiquer dans la zone de saisie autant de signe « $ » que de lettres. Éventuellement, le signe « $ » pourra être remplacé par une lettre connue ou supposée.

Avant de lancer la recherche, il faut se rappeler que la graphie des mots croisés est particulière : toutes les lettres sont en majuscules, les espaces, tirets, apostrophes, accents ou cédilles ont disparu…

Au préalable, il est donc nécessaire de filtrer, « d'épurer » le vocabulaire :

- à commencer par le mot saisi en masque ;

- ensuite pour chacun des mots de la base auxquels il sera comparé.

Pour cela, nous créons la fonction SansAccent(50) :

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;

Dans laquelle les chaînes de caractères sont respectivement :

- cAcc := UTF8ToAnsi('àâäéèêëïîôùûüÿç-'' '), qui regroupe tous les caractères à remplacer ;

- sAcc := 'aaaeeeeiiouuuyc', pour les caractères de substitution.

Les deux variables sont déclarées en variables globales et définies lors du lancement du programme :

procedure TForm1.FormCreate(Sender: TObject);
begin
listeMots := TStringList.Create;
listeMots.CaseSensitive:=True;
lireFichier;
lireLiens;
nMots := listeMots.Count;
Caption := 'Lexique de '+IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens)+' liés';
iZoom := 1;
iMot := 0;
cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
//regroupe tous les caractères à remplacer
sAcc := 'aaaeeeeiiouuuyc';
//regroupe tous les caractères de substitution
end;

Le bouton Chercher provoque la comparaison du masque avec la liste des occurrences, et si elle n'existe pas (longueur nulle pour le tableau), avec la totalité des mots.

procedure TForm1.Button6Click(Sender: TObject);
var i, j, k, iMax, p : integer;
motCour, sMasque : string;
exOccur : boolean;
begin
i := 0;
sMasque := SansAccent(Edit2.Caption);  //épuration de la saisie
k := Length(sMasque);
ListBox4.Clear;
//vérifier que des occurrences existent
exOccur := Length(tabOccur) > 0;
if  exOccur then iMax :=  Length(tabOccur)
else iMax := nMots;
repeat
if exOccur   then p :=  tabOccur[i] else p := i;
motCour := SansAccent(listeMots[p]);  //épuration du mot consulté
//recherche des mots de même longueur
if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
begin
j := 1;
while (j<=k) and ((sMasque[j]='$') or (sMasque[j] = motCour[j])) do inc(j);
if j>k  then ListBox4.Items.Append(AnsiToUTF8(listeMots[p]));
end;
inc(i);
until (i=iMax);
end;

Pour tester l'efficacité du masque, nous relançons le programme et saisissons « $$$$$c$$ », qui indique un mot de huit lettres, dont un « c » en 5e position. Le résultat s'affiche :

Nous introduisons à nouveau notre requête « baignoire + lavabo », cliquons sur le bouton Logique, puis sur le bouton Chercher. Le champ de recherche se limite cette fois aux occurrences déjà affichées. Le résultat apparaît :

Nous trouvons maintenant la réponse à la définition présentée par un humoriste fameux, Tristan Bernard : c'est l'entracte qui vide les baignoires et remplit les lavabos.

Page Ajout

Dans la page Ajout, nous plaçons cinq composants :

1. un label, qui recevra le mot-titre ;

2. un Edit autorisant la saisie d'un mot ;

3. un bouton Flèche vers le haut pour faire passer ce mot en titre ;

4. un ListBox recevant les mots liés au titre ;

5. un bouton Flèche vers la droite pour faire passer le mot saisi en lien.

Avec la souris, nous agençons l'ensemble pour obtenir sensiblement ceci :

À l'ouverture de l'onglet, titre et liens sont affichés selon la valeur du paramètre courant iMot. Si le mot saisi existe dans la base, le paramètre est modifié, et le nouveau mot-titre est affiché avec ses liens.

Si le mot n'existe pas encore, l'utilisateur est invité à confirmer l'entrée du mot ; mais il doit être informé de l'existence éventuelle de mots proches, de façon à éviter les doublons.

Voyons comment rechercher les mots proches et les soumettre à l'utilisateur.

Mots proches

Nous appellerons mots proches(51) tous les mots qui ont la même orthographe après passage par la fonction SansAccent, c'est-à-dire après suppression des majuscules, accents ou caractères spéciaux. Nous avons déjà utilisé cette fonction dans le cadre des masques. Nous la reprenons ainsi :

procedure TForm1.MotsProches(NouvMot: string);
var i,j : integer;
motRef : string;
begin
SetLength(tabOccur, 0); //vide la table existante
motRef := SansAccent(NouvMot);
i:=0;
j:=0;
while motRef[1]> SansAccent(ListeMots[i])[1] do inc(i);
repeat
if (motRef = SansAccent(ListeMots[i])) and (NouvMot <>ListeMots[i])then
begin
SetLength(tabOccur, Length(tabOccur)+1);
tabOccur[j] := i;
inc(j);
end;
inc(i);
until ((motRef[1] < SansAccent(ListeMots[i])[1]) or (i>nMots-2));
end;

Fenêtre modale

Nous avons saisi un mot nouveau et connaissons les mots proches : l'ensemble doit être soumis à l'utilisateur pour décision.

Nous allons à cet effet créer notre boîte de dialogues personnalisée.

L'unité uDialog est associée à la fenêtre Form2 : nous l'ouvrons et glissons dedans deux labels, deux boutons et un ListBox. L'ensemble est remanié pour obtenir ceci :

Le ListBox reçoit le nouveau mot -qui sera présélectionné- et les mots proches. L'utilisateur accepte le mot sélectionné, ou abandonne. Il peut aussi sélectionner un autre mot de la liste. La fenêtre est fermée dès qu'un bouton est cliqué.

Pour supprimer les icônes système de la fenêtre, nous portons à False les propriétés BorderIcons.

L'unité uDialog se présente maintenant ainsi :

unit uDialog;

{$mode objfpc}{$H+}

interface

uses
Forms, StdCtrls;

type

{ TForm2 }

TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ChoixMot(motNouv : string);
procedure FormShow(Sender: TObject);
procedure ListBox1Click(Sender: TObject);

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

var
Form2: TForm2;

implementation
uses uLex12, uDisque;

{ TForm2 }

procedure TForm2.ChoixMot(motNouv: string);
var i, j : integer;
begin
Label2.Caption:= AnsiToUTF8(motNouv);
ListBox1.Clear;
ListBox1.Items.Append(AnsiToUTF8(motNouv));
ListBox1.Selected[0] := True;
j := Length(tabOccur);
if j > 0 then
begin
for i:=0 to j-1 do
ListBox1.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));

end;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
ModalResult := -2;//abandon
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
if ListBox1.Selected[0]
then ModalResult := -1
else ModalResult := tabOccur[ListBox1.ItemIndex-1];
end;

procedure TForm2.FormShow(Sender: TObject);
begin
Caption := 'Confirmer';
Label1.Caption:='Mot sélectionné :';
Button1.Caption:='Continuer';
Button2.Caption:='Abandonner';
end;

procedure TForm2.ListBox1Click(Sender: TObject);
begin
Label2.Caption:= ListBox1.GetSelectedText;
end;

{$R *.lfm}

end.

Nous constatons que la fermeture de la fenêtre renvoie l'indice du mot existant, et -1 si le mot nouveau est confirmé. En cas d'abandon, la valeur -2 est retournée.

Ajout d'un mot

Revenons à notre onglet Ajout. Entrons un mot nouveau et cliquons sur la flèche vers le haut : après confirmation, le logiciel doit introduire le mot nouveau à la bonne place. Cette place est déterminée par la fonction indexMotNouv. La procédure AjoutMot réalise l'opération, mais modifie dans la foulée tous les liens pointant sur des mots situés après le nouveau mot.

function TForm1.indexMotNouv(motNouv: string): integer;
var i : integer;
begin
i := 0;
motNouv := SansAccent(motNouv);
while motNouv[1]>SansAccent(ListeMots[i][1]) do inc(i);
while (motNouv > SansAccent(ListeMots[i])) and (i<nMots-1) do inc(i);
indexMotNouv := i;
if (motNouv > SansAccent(ListeMots[i])) then indexMotNouv := nMots;
end;

procedure TForm1.AjoutMot(motNouv: string; indexMN: integer);
var i, j : integer;
begin
if indexMN<nMots-1 then
listeMots.Insert(indexMN, motNouv)
else listeMots.Append(motNouv);
inc(nMots);
//mise à jour de tous les liens
for i:= 0 to Length(Liens)-1 do
for j:=0 to Length(Liens[i])-1 do
if Liens[i,j]>= indexMN then inc(Liens[i,j]);
Caption := 'Lexique de '+IntToStr(nMots) + ' dont ' + IntToStr(nLiens) + ' liés';
end;

procedure TForm1.Button7Click(Sender: TObject);
var motNouv : string;
k : integer;
begin
if Edit3.Caption > '' then
begin
motNouv := UTF8ToAnsi(Edit3.Caption);
k := ListeMots.IndexOf(motNouv);
if k >= 0 then iMot := k
else
begin
MotsProches(motNouv);   //dresse la table des mots proches
Form2.ChoixMot(motNouv);
k := Form2.ShowModal;  //réponse de la boîte de dialogue
Case  k of
-2 : ShowMessage('Abandon');
-1 : begin
iMot := indexMotNouv(motNouv);
AjoutMot(motNouv, iMot);
end;
else iMot := k;
end;
end;
AfficheAjout;
end;
end;

Si le mot introduit existe dans la liste, l'affichage est immédiatement mis à jour. Dans le cas contraire, la procédure complète d'introduction d'un mot nouveau est lancée.

Ajout d'un lien

Un clic sur la flèche droite provoque la création d'un lien avec le mot-titre. Si le mot à lier n'existe pas, il faudra reprendre la création d'un mot nouveau vue précédemment, et ajouter un tableau de liens au tableau de tableaux ; si ce mot existe, il suffira d'ajouter un lien au tableau existant. Dans les deux cas, il faudra placer le tableau à la bonne place, et le lien nouveau également : ces tâches sont confiées aux procédures PlaceTab et PlaceLien.

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

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

Un clic sur le bouton flèche droite déclenche la procédure événementielle onClick puis la procédure AfficheAjout. La fonction fDoublon élimine les saisies inutiles :

function TForm1.fDoublon(iTab, iLien: integer): boolean;
var i, k : integer;
begin
fDoublon := False;
if (iTabLiens>=0) then
begin
i := Length(Liens[iTab]);
k := i-1;
while (k>0) and (iLien < Liens[iTab, k]) do dec(k);
if   (iLien = Liens[iTab, k]) then fDoublon := True;
end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var motNouv : string;
k : integer;
begin
if (Edit3.Caption > '') and  (Edit3.Caption <> ListeMots[iMot])then
begin
motNouv := UTF8ToAnsi(Edit3.Caption);
k := ListeMots.IndexOf(motNouv);
if k >= 0 then iLien := k
else
begin
MotsProches(motNouv);   //dresse la table des mots proches
Form2.ChoixMot(motNouv);
k := Form2.ShowModal;  //réponse de la boîte de dialogue
Case  k of
-2 : ShowMessage('Abandon');
-1 : begin
iLien := indexMotNouv(motNouv);
AjoutMot(motNouv, iLien);
if iLien<=iMot then inc(iMot);
end;
else iLien := k;
end;
end;
if ((k >=0) and not fDoublon(iTabLiens, iLien))
or (k = -1) then
begin
LieMots(iMot, iLien);
LieMots(iLien, iMot);
AfficheAjout;
end;
end;
Edit3.Clear;
end;

La création du lien est confiée à la procédure LieMots :

procedure TForm1.LieMots(iMot1, iMot2: integer);
var i, j : integer;
begin
//pose premier lien
i := chercheTabLiens(iMot1);
if i<0 then
begin
inc(nLiens); //un mot lié supplémentaire
SetLength(Liens, nLiens);
SetLength(Liens[nLiens-1], 2);
Liens[nLiens-1, 0] := iMot1; //identité du tableau secondaire
Liens[nLiens-1, 1] := iMot2;  //premier lien
PlaceTab(nLiens-1); //met le nouveau tableau à sa place
end
else //pose d'un lien supplémentaire
begin
j := Length(Liens[i]);
SetLength(Liens[i], j + 1);
Liens[i, j] := iMot2;
PlaceLien(i);
end;
end;

Si le mot ne dispose pas de lien, un tableau dédié est créé ; si le tableau secondaire existe, le lien nouveau est ajouté en fin de tableau, puis un tri rétablit l'ordre des tableaux par identité croissante (première case) et des liens par valeurs croissantes (cases suivant la case 0).

Exécution

Pour vérifier rapidement la bonne exécution des procédures et fonctions, nous pouvons tester le logiciel en introduisant par exemple :

n°

mot

flèche

résultat

observation

1

Vide (absence de mot)

haut

néant

Absence d'erreur

2

Vide (absence de mot)

droite

néant

Absence d'erreur

3

Seine

haut

Mot nouveau

Absence d'erreur

4

fleuve

droite

Lien nouveau

Absence d'erreur

5

fleuve

droite

Lien existant

Absence d'erreur

Page Suppression

Si l'utilisateur a la possibilité d'ajouter un mot ou un lien, il doit également être en mesure de les supprimer pour réaliser la correction qu'il jugerait nécessaire. Nous ouvrons donc la page Suppression, ajoutons cinq composants et les arrangeons comme ceci :

Le Label6 reçoit le mot-titre, le ListBox les mots correspondant aux liens dont le premier est sélectionné au départ.

L'affichage se met à jour dès la sélection de l'onglet :

procedure TForm1.TabSheet4Show(Sender: TObject);
begin
Button9.Caption:= 'OK';
Button10.Caption:= 'Abandon';
Button9.Enabled:=True;
Button10.Enabled:=True;
AfficheSup;
end;

procedure TForm1.AfficheSup;
var i : integer;
begin
Label6.Caption:= AnsiToUTF8(ListeMots[iMot]);
ListBox6.Clear;
iTabLiens := ChercheTabLiens(iMot);
if iTabLiens>=0 then
begin
for i :=1 to Length(Liens[iTabLiens]) -1 do
ListBox6.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]));
iLien := Liens[iTabLiens, 1];
ListBox6.Selected[0] := True;
Label7.Caption:='Supprimer le lien entre '+ Label6.Caption+
#13+' et '+AnsiToUTF8(ListeMots[iLien]);
end
else
Label7.Caption:='Supprimer le mot '+ Label6.Caption;
end;

Si le mot ne dispose pas de liens, l'utilisateur se voit proposer la suppression directe du mot. Dans le cas contraire, il peut choisir d'un clic un autre mot lié :

procedure TForm1.ListBox6Click(Sender: TObject);
begin
iLien := Liens[iTabLiens, ListBox6.ItemIndex+1];
Label7.Caption:='Supprimer le lien entre '+ Label6.Caption+
#13+' et '+AnsiToUTF8(ListeMots[iLien]);
end;

La commande se fait par un clic sur l'un ou l'autre des boutons :

procedure TForm1.Button9Click(Sender: TObject);
begin
if iTabLiens<0 then
begin
//le mot est seul, il peut être supprimé
SupMot;
end
else
begin
SupprimeLien(iMot, iTabLiens, iLien);
SupprimeLien(iLien, ChercheTabLiens(iLien), iMot);
AfficheSup;
end;
end;

procedure TForm1.Button10Click(Sender: Tobject);
//abandon, fermeture de l'onglet
begin
TabSheet2.Show;
end;

La suppression du mot ou du lien est confiée aux procédures dédiées :

procedure TForm1.SupMot;
var i, j : integer;
begin
ListeMots.Delete(iMot);
dec(nMots);
//mise à jour de tous les liens
for i:= 0 to Length(Liens)-1 do
for j:=0 to Length(Liens[i])-1 do
if Liens[i,j]>= iMot then dec(Liens[i,j]);
Caption := 'Lexique de '+IntToStr(nMots) + ' dont ' + IntToStr(nLiens) + ' liés';
Label6.Caption:= 'Mot supprimé';
Label7.Caption:='';
Button9.Enabled:=False;
Button10.Enabled:=False;
if iMot>0 then dec(iMot);
end;

procedure TForm1.SupprimeLien(iMot1, iTab, iMot2: integer);
var i : integer;
begin
//recherche du tableau de liens
if Length(Liens[iTab]) > 2 then
begin
for i:=1 to Length(Liens[iTab]) - 2 do
if Liens[iTab, i] >= iMot2 then
Liens[iTab, i] := Liens[iTab, i+1];
//réduire la taille du tableau secondaire
SetLength(Liens[iTab], Length(Liens[iTab]) - 1);
end
else
begin
//réduire la taille du tableau principal
for i:= iTab to Length(Liens) - 2 do
Liens[i] := Liens[i+1];
SetLength(Liens, Length(Liens) - 1);
dec(nLiens); //un mot lié en moins
end;
end;

Pour tester l'ensemble, on peut ajouter le mot « Seine », le lier à « département », à « fleuve », puis supprimer successivement chacun des liens, puis le mot lui-même.

Sauvegarde

L'enregistrement du vocabulaire et des liens est assuré à chaque fois que le bouton Quitter est actionné. Par prudence, nous avons prévu la possibilité d'une sauvegarde périodique au format compact :

procedure TForm1.Button1Click(Sender: TObject);
begin
regMotsLiens;
end;

L'utilitaire est précieux, mais son application est un peu longue : il faudra de la patience et espacer l'opération dans le temps.

Conclusion

Nous souhaitions montrer que l'informatique pouvait gérer parfaitement l'orthographe des mots… c'est fait.

Nous désirions construire un logiciel susceptible de mémoriser la pratique des mots croisés… c'est fait.

Pourtant, la tâche est loin d'être achevée :

- sur le plan informatique, des modules peuvent être accélérés, l'ergonomie améliorée, le portage sur Android ou IOS réalisé, etc. ;

- sur le plan des données, le nombre de liens est encore au stade du balbutiement, et de nombreuses saisies sont nécessaires pour que le résultat devienne réellement intéressant.

Ce n'est qu'une amorce : elle va peut-être susciter des vocations pour la suite…

Caramel : fréquente le palais et menace la couronne.

Tristan Bernard

Code

Notre projet comprend maintenant trois unités :

Unité uLex12

unit uLex12;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, Forms, Controls, Dialogs,
ComCtrls, StdCtrls, uDisque, uDialog;

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button10: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
ListBox4: TListBox;
ListBox5: TListBox;
ListBox6: TListBox;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
TrackBar1: TTrackBar;
UpDown1: TUpDown;
UpDown2: TUpDown;
procedure Button10Click(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 FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure ListBox2Click(Sender: TObject);
procedure ListBox5Click(Sender: TObject);
procedure ListBox6Click(Sender: TObject);
procedure TabSheet1Show(Sender: TObject);
procedure TabSheet2Show(Sender: TObject);
procedure AfficheLecture;
function ChercheTabLiens(iMot : integer) : integer;
procedure AfficheLiens;
procedure TabSheet3Show(Sender: TObject);
procedure TabSheet4Show(Sender: TObject);
procedure TrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
procedure AjoutOccur(iOccur : integer);
procedure TriOccur;
function SansAccent(rMot : string) : string;
procedure MotsProches(NouvMot : string);
function indexMotNouv(motNouv : string) : integer;
procedure AjoutMot(motNouv : string; indexMN : integer);
function fDoublon(iTab, iLien : integer) : boolean;
procedure LieMots(iMot1, iMot2 : integer);
procedure PlaceTab(k : integer);
procedure PlaceLien(k : integer);
procedure AfficheAjout;
procedure AfficheSup;
procedure SupMot;
procedure SupprimeLien(iMot1, iTab, iMot2 : integer);

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

var
Form1: TForm1;
iZoom, iMot, iLien, iTabLiens : integer;
tabReq, tabOccur : array of integer;
cAcc, sAcc : string;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button2Click(Sender: TObject);
//restauration depuis le fichier de sauvegarde
begin
LireMotsLiens;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
regMotsLiens;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
TabSheet2.Show;
end;

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

procedure TForm1.Button4Click(Sender: TObject);
var i, j, k : integer;
begin
//ajoute un mot à la liste de base tabreq
i := ListeMots.IndexOf(UTF8toAnsi(Edit1.caption));
if i>=0 then //le mot existe dans la liste principale
begin
j:=0;
k := Length(tabReq);
while (j<k) and (i<>tabReq[j]) do inc(j);
if j=k then      //le mot peut être ajouté
begin
SetLength(tabReq, k+1); //ajoute une unité au tableau
tabReq[k] := i;
//affichage de la requête dans la ligne titre
if Label3.caption = 'Saisir la requête' then
Label3.caption:= Edit1.caption //premier mot clé
else
Label3.caption:= Label3.caption +' + '+Edit1.caption;
end;
end;
Edit1.clear;
end;

procedure TForm1.Button5Click(Sender: TObject);
const profRech = 2;      //fixe la profondeur de la recherche
var i, j, k, n : integer;
begin
if Length(tabReq)>0 then //la requête ne doit pas être vide
begin
for n := 1 to profRech do
begin
SetLength(tabOccur, 0);
for i:=0 to Length(tabReq)-1 do
begin
j := 0;
while (j<Length(Liens)) and (Liens[j, 0]<>tabReq[i])do inc(j);
if j<Length(Liens) then
for k:=1 to Length(Liens[j])-1 do AjoutOccur(Liens[j, k]);
end;
tabReq := tabOccur;
end;
j := Length(tabOccur);
//afficher les occurrences et leur nombre
ListBox3.Items.Append(IntToStr(j)+' occurrences : ');
TriOccur; //trier avant affichage
for i:=0 to j-1 do
ListBox3.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
end;
end;

procedure TForm1.Button6Click(Sender: TObject);
var i, j, k, iMax, p : integer;
motCour, sMasque : string;
exOccur : boolean;
begin
i := 0;
sMasque := SansAccent(Edit2.Caption);  //épuration de la saisie
k := Length(sMasque);
ListBox4.Clear;
//vérifier que des occurrences existent
exOccur := Length(tabOccur) > 0;
if  exOccur then iMax :=  Length(tabOccur)
else iMax := nMots;
repeat
if exOccur   then p :=  tabOccur[i] else p := i;
motCour := SansAccent(listeMots[p]);  //épuration du mot consulté
//recherche des mots de même longueur
if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
begin
j := 1;
while (j<=k) and ((sMasque[j]='$') or (sMasque[j] = motCour[j])) do inc(j);
if j>k  then ListBox4.Items.Append(AnsiToUTF8(listeMots[p]));
end;
inc(i);
until (i=iMax);
end;

procedure TForm1.Button7Click(Sender: TObject);
var motNouv : string;
k : integer;
begin
if Edit3.Caption > '' then
begin
motNouv := UTF8ToAnsi(Edit3.Caption);
k := ListeMots.IndexOf(motNouv);
if k >= 0 then iMot := k
else
begin
MotsProches(motNouv);   //dresse la table des mots proches
Form2.ChoixMot(motNouv);
k := Form2.ShowModal;  //réponse de la boîte de dialogue
Case  k of
-2 : ShowMessage('Abandon');
-1 : begin
iMot := indexMotNouv(motNouv);
AjoutMot(motNouv, iMot);
end;
else iMot := k;
end;
end;
AfficheAjout;
end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var motNouv : string;
k : integer;
begin
if (Edit3.Caption > '') and  (Edit3.Caption <> ListeMots[iMot])then
begin
motNouv := UTF8ToAnsi(Edit3.Caption);
k := ListeMots.IndexOf(motNouv);
if k >= 0 then iLien := k
else
begin
MotsProches(motNouv);   //dresse la table des mots proches
Form2.ChoixMot(motNouv);
k := Form2.ShowModal;  //réponse de la boîte de dialogue
Case  k of
-2 : ShowMessage('Abandon');
-1 : begin
iLien := indexMotNouv(motNouv);
AjoutMot(motNouv, iLien);
if iLien<=iMot then inc(iMot);
end;
else iLien := k;
end;
end;
if ((k >=0) and not fDoublon(iTabLiens, iLien))
or (k = -1) then
begin
LieMots(iMot, iLien);
LieMots(iLien, iMot);
AfficheAjout;
end;
end;
Edit3.Clear;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
if iTabLiens<0 then
begin
//le mot est seul, il peut être supprimé
SupMot;
end
else
begin
SupprimeLien(iMot, iTabLiens, iLien);
SupprimeLien(iLien, ChercheTabLiens(iLien), iMot);
AfficheSup;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
listeMots := TStringList.Create;
listeMots.CaseSensitive:=True;
lireFichier;
lireLiens;
nMots := listeMots.Count;
Caption := 'Lexique de '+IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens)+' liés';
iZoom := 1;
iMot := 0;
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
iMot := (iMot-5+ListBox1.ItemIndex + nMots) mod nMots;
AfficheLecture;
end;

procedure TForm1.ListBox2Click(Sender: TObject);
begin
if iTabLiens >= 0 then
begin
iMot := Liens[iTabLiens, ListBox2.ItemIndex+1];
AfficheLecture;
end;
end;

procedure TForm1.ListBox5Click(Sender: TObject);
var k : integer;
begin
k := ListBox5.ItemIndex;
if k>=0 then
begin
iMot := Liens[iTabLiens, k +1 ];
AfficheAjout;
end;
end;

procedure TForm1.ListBox6Click(Sender: TObject);
begin
iLien := Liens[iTabLiens, ListBox6.ItemIndex+1];
Label7.Caption:='Supprimer le lien entre '+ Label6.Caption+
#13+' et '+AnsiToUTF8(ListeMots[iLien]);
end;

procedure TForm1.TabSheet1Show(Sender: TObject);
begin
Label3.Caption := 'Saisir la requête';
Label4.Caption := 'Saisir les lettres' + #13 +'séparées par le signe $' ;
Edit1.Clear;
Edit2.Clear;
ListBox3.Clear;
ListBox4.Clear;
SetLength(tabReq, 0);
SetLength(tabOccur, 0);
end;

procedure TForm1.TabSheet2Show(Sender: TObject);
begin
AfficheLecture;
end;

procedure TForm1.AfficheLecture;
var i : integer;
begin
Label2.Caption:='Zoom x '+ IntToStr(iZoom);
TrackBar1.Position:= Round(iMot*1000/nMots);
Label1.Caption:= AnsiToUTF8(ListeMots[iMot]);
ListBox1.Clear;
for i := 0 to 10  do
ListBox1.Items.Add(AnsiToUTF8(ListeMots[(iMot-5 + i + nMots) mod nMots]));
ListBox1.Selected[5] := True;
AfficheLiens;
end;

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

procedure TForm1.AfficheLiens;
var i : integer;
begin
if Length(Liens)>0 then
begin
ListBox2.Clear;
iTabLiens := chercheTabLiens(iMot);
if iTabLiens>=0 then
for i :=1 to Length(Liens[iTabLiens]) -1 do
if TabSheet2.TabVisible then
ListBox2.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]))
else if TabSheet2.TabVisible then
ListBox5.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]));
end;
end;

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

procedure TForm1.TabSheet4Show(Sender: TObject);
begin
Button9.Caption:= 'OK';
Button10.Caption:= 'Abandon';
Button9.Enabled:=True;
Button10.Enabled:=True;
AfficheSup;
end;

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

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then Inc(iMot, iZoom)
else  Dec(iMot, iZoom);
iMot := (iMot + nMots) mod nMots;
AfficheLecture;
end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then iZoom := iZoom * 10
else iZoom := iZoom div 10;
Case iZoom of
0 : iZoom := 1;
1000000 : iZoom := 100000;
end;
Label2.Caption:= 'Zoom x '+IntToStr(iZoom);
end;

procedure TForm1.AjoutOccur(iOccur: integer);
var i : integer;
begin
//vérifier que cette occurrence n'a pas encore été rencontrée
i:=0;
while (i<Length(tabOccur)) and (iOccur<> tabOccur[i])  do inc(i);
if i= Length(tabOccur) then   //première occurrence du mot
begin
SetLength(tabOccur, i+1);
tabOccur[i] := iOccur;
end;
end;

procedure TForm1.TriOccur;
var i, j, occTampon : integer ;
triOK : boolean;
begin

j := Length(tabOccur)-2;
if j>0 then
begin
triOK := True;
i := 0;
repeat
if (tabOccur[i] >  tabOccur[i+1])  then
begin
occTampon := tabOccur[i];
tabOccur[i] := tabOccur[i+1];
tabOccur[i+1] := occTampon;
triOK := False;
end;
inc(i);
if not triOK and (i>j) then
begin
i:=0; //nouvelle passe de permutations
triOK:= True;
end;
until (i>j);

end;
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.MotsProches(NouvMot: string);
var i,j : integer;
motRef : string;
begin
SetLength(tabOccur, 0); //vide la table existante
motRef := SansAccent(NouvMot);
i:=0;
j:=0;
while motRef[1]> SansAccent(ListeMots[i])[1] do inc(i);
repeat
if (motRef = SansAccent(ListeMots[i])) and (NouvMot <>ListeMots[i])then
begin
SetLength(tabOccur, Length(tabOccur)+1);
tabOccur[j] := i;
inc(j);
end;
inc(i);
until ((motRef[1] < SansAccent(ListeMots[i])[1]) or (i>nMots-2));
end;

function TForm1.indexMotNouv(motNouv: string): integer;
var i : integer;
begin
i := 0;
motNouv := SansAccent(motNouv);
while motNouv[1]>SansAccent(ListeMots[i][1]) do inc(i);
while (motNouv > SansAccent(ListeMots[i])) and (i<nMots-1) do inc(i);
indexMotNouv := i;
if (motNouv > SansAccent(ListeMots[i])) then indexMotNouv := nMots;
end;

procedure TForm1.AjoutMot(motNouv: string; indexMN: integer);
var i, j : integer;
begin
if indexMN<nMots-1 then
listeMots.Insert(indexMN, motNouv)
else listeMots.Append(motNouv);
inc(nMots);
//mise à jour de tous les liens
for i:= 0 to Length(Liens)-1 do
for j:=0 to Length(Liens[i])-1 do
if Liens[i,j]>= indexMN then inc(Liens[i,j]);
Caption := 'Lexique de '+IntToStr(nMots) + ' dont ' + IntToStr(nLiens) + ' liés';
end;

function TForm1.fDoublon(iTab, iLien: integer): boolean;
var i, k : integer;
begin
fDoublon := False;
if (iTabLiens>=0) then
begin
i := Length(Liens[iTab]);
k := i-1;
while (k>0) and (iLien < Liens[iTab, k]) do dec(k);
if   (iLien = Liens[iTab, k]) then fDoublon := True;
end;
end;

procedure TForm1.LieMots(iMot1, iMot2: integer);
var i, j : integer;
begin
//pose premier lien
i := chercheTabLiens(iMot1);
if i<0 then
begin
inc(nLiens); //un mot lié supplémentaire
SetLength(Liens, nLiens);
SetLength(Liens[nLiens-1], 2);
Liens[nLiens-1, 0] := iMot1; //identité du tableau secondaire
Liens[nLiens-1, 1] := iMot2;  //premier lien
PlaceTab(nLiens-1); //met le nouveau tableau à sa place
end
else //pose d'un lien supplémentaire
begin
j := Length(Liens[i]);
SetLength(Liens[i], j + 1);
Liens[i, j] := iMot2;
PlaceLien(i);
end;
end;

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

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

procedure TForm1.AfficheAjout;
var i : integer;
begin
ListBox5.Clear;
Edit3.Clear;
Label5.Caption:= AnsiToUTF8(ListeMots[iMot]);
iTabLiens := ChercheTabLiens(iMot);
if iTabLiens>=0 then
for i :=1 to Length(Liens[iTabLiens]) -1 do
ListBox5.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]));
Caption := 'Lexique de '+IntToStr(nMots) + ' dont ' + IntToStr(nLiens) + ' liés';

end;

procedure TForm1.AfficheSup;
var i : integer;
begin
Label6.Caption:= AnsiToUTF8(ListeMots[iMot]);
ListBox6.Clear;
iTabLiens := ChercheTabLiens(iMot);
if iTabLiens>=0 then
begin
for i :=1 to Length(Liens[iTabLiens]) -1 do
ListBox6.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]));
iLien := Liens[iTabLiens, 1];
ListBox6.Selected[0] := True;
Label7.Caption:='Supprimer le lien entre '+ Label6.Caption+
#13+' et '+AnsiToUTF8(ListeMots[iLien]);
end
else
Label7.Caption:='Supprimer le mot '+ Label6.Caption;
end;

procedure TForm1.SupMot;
var i, j : integer;
begin
ListeMots.Delete(iMot);
dec(nMots);
//mise à jour de tous les liens
for i:= 0 to Length(Liens)-1 do
for j:=0 to Length(Liens[i])-1 do
if Liens[i,j]>= iMot then dec(Liens[i,j]);
Caption := 'Lexique de '+IntToStr(nMots) + ' dont ' + IntToStr(nLiens) + ' liés';
Label6.Caption:= 'Mot supprimé';
Label7.Caption:='';
Button9.Enabled:=False;
Button10.Enabled:=False;
if iMot>0 then dec(iMot);
end;

procedure TForm1.SupprimeLien(iMot1, iTab, iMot2: integer);
var i : integer;
begin
//recherche du tableau de liens
if Length(Liens[iTab]) > 2 then
begin
for i:=1 to Length(Liens[iTab]) - 2 do
if Liens[iTab, i]>= iMot2 then
Liens[iTab, i] :=  Liens[iTab, i+1];
//réduire la taille du tableau secondaire
SetLength(Liens[iTab], Length(Liens[iTab]) - 1);
end
else
begin
//réduire la taille du tableau principal
for i:= iTab to Length(Liens) - 2 do
Liens[i] := Liens[i+1];
SetLength(Liens, Length(Liens) - 1);
dec(nLiens); //un mot lié en moins
end;
end;

end.

Unité uDisque

unit uDisque;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, Dialogs;

procedure lireMotsLiens;
function lire: string;
function lireNombre(i : byte) : integer;
procedure regFichier;
procedure regLiens;
procedure lireFichier;
procedure lireLiens;
procedure regMotsLiens;
function compteLet(MotPrec, Moti: string): byte;
procedure ecrireMot(Moti : string);
procedure ecrireNombre(var k; longK : byte);

var listeMots : TStringList;
Liens : array of array of integer;
nLiens, nMots : integer;
fLex : file;

implementation
uses uLex12;

procedure lireMotsLiens;
var   longLiens, nLet : byte;
i, k, iTab : integer;
MotPrec, Moti : string;
begin
AssignFile(fLex, 'LexLiens.bin');
{$I-}
Reset(fLex, 1);
{$I+}
if IOResult = 0 then
begin
Seek(fLex, 0);
i := 0;
listeMots := TStringList.Create;
SetLength(Liens, 0);
iTab := 0;
MotPrec := '';
while not EOF(fLex) do
begin
Moti   := Lire;
nLet := LireNombre(1); //nombre de lettres à reprendre du précédent
Moti := LeftStr(MotPrec, nLet) + Moti;
listeMots.Append(Moti);
MotPrec := Moti; //
longLiens := lireNombre(1);
if longLiens>0 then
begin
SetLength(Liens, Length(Liens)+1);
SetLength(Liens[iTab], longLiens);
for k:=0 to longLiens-1 do
Liens[iTab, k] :=  lireNombre(4);
inc(iTab);
end;
Inc(i);
end;
nLiens := iTab;
CloseFile(fLex);
end;
end;

function lire: string;
var
longMot : byte;
nbOct: integer;
S: string;

begin
BlockRead(fLex, longMot, 1, nbOct);
SetLength(S, longMot);
BlockRead(fLex, S[1], longMot, nbOct);
lire := S;
end;

function lireNombre(i: byte): integer;
var
nbOct: integer;
begin
BlockRead(fLex, Result, i, nbOct);
end;

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

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

begin
AssignFile(fLiens, 'fichLiens.bin');
{$I-}
Reset(fLiens, 1);
{$I+}
if IOResult <> 0 then
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 lireFichier;
begin
try
listeMots.LoadFromFile('liMots.txt');
except ShowMessage('fichier de mots inexistant');
end;
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
lireMotsLiens
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 regMotsLiens;
var
i, k, m, nbOct, SLong: integer;
nLiens, nLet : byte;
Erreur: integer;
S, MotPrec, Moti : string;
begin
AssignFile(fLex, 'LexLiens.bin'); //==========nouveau fichier dico==============================
{$I-}
Reset(fLex, 1);
{$I+}
Erreur := IOResult;
if Erreur <> 0 then
ReWrite(fLex, 1);
Truncate(fLex);
Seek(fLex, 0);
MotPrec := '';
for i := 0 to listeMots.Count - 1 do
//champ par champ à coder (longueur)
begin
Moti := listeMots[i];
nLet := compteLet(MotPrec, Moti);
S := RightStr(Moti, Length(Moti)-nLet);
EcrireMot(S);
EcrireNombre(nLet, 1); //nombre de lettres communes avec le préc
m := Form1.ChercheTabLiens(i); //présence de liens
if m<0 then nLiens:=0
else nLiens:= Length(Liens[m]);
ecrireNombre(nLiens, 1);
if nLiens>0 then
for k:= 0 to nLiens-1 do
ecrireNombre(Liens[m, k], 4);
MotPrec := Moti;
end;
CloseFile(fLex);
end;

function compteLet(MotPrec, Moti: string): byte;
var i : byte;
begin
i:= 1;
while (i<Length(MotPrec)) and (i<Length(Moti))
and (MotPrec[i] = Moti[i]) do inc(i);
compteLet := i-1;
end;

procedure ecrireMot(Moti: string);
var
longMot : byte;
nbOct: integer;
begin
longMot := Length(Moti);
BlockWrite(fLex, longMot, SizeOf(longMot), nbOct);
BlockWrite(fLex, Moti[1], longMot, nbOct);
end;

procedure ecrireNombre(var k; longK: byte);
var nbOct : integer;
begin
BlockWrite(fLex, k, longK, nbOct);
end;

end.

Unité uDialog

unit uDialog;

{$mode objfpc}{$H+}

interface

uses
Forms, StdCtrls;

type

{ TForm2 }

TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ChoixMot(motNouv : string);
procedure FormShow(Sender: TObject);
procedure ListBox1Click(Sender: TObject);

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

var
Form2: TForm2;

implementation
uses uLex12, uDisque;

{ TForm2 }

procedure TForm2.ChoixMot(motNouv: string);
var i, j : integer;
begin
Label2.Caption:= AnsiToUTF8(motNouv);
ListBox1.Clear;
ListBox1.Items.Append(AnsiToUTF8(motNouv));
ListBox1.Selected[0] := True;
j := Length(tabOccur);
if j > 0 then
begin
for i:=0 to j-1 do
ListBox1.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));

end;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
ModalResult := -2;//abandon
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
if ListBox1.Selected[0]
then ModalResult := -1
else ModalResult := tabOccur[ListBox1.ItemIndex-1];
end;

procedure TForm2.FormShow(Sender: TObject);
begin
Caption := 'Confirmer';
Label1.Caption:='Mot sélectionné :';
Button1.Caption:='Continuer';
Button2.Caption:='Abandonner';
end;

procedure TForm2.ListBox1Click(Sender: TObject);
begin
Label2.Caption:= ListBox1.GetSelectedText;
end;

{$R *.lfm}

end.

Téléchargements

Téléchargez :

- le projet complet ;

- le fichier LexLiens.bin.

(1)Il a exploité, souligne-t-il, les travaux de Christophe Pythoud  et de l'association Gutenberg

(2)Bière de l'Égypte ancienne

(3)La version 1.0.2 présente le composant ExtendedNoteBook en remplacement du composant NoteBook disponible auparavant. Le code pourra donc changer légèrement selon la version utilisée.

(4)Attention au nom de ce composant, ici Edit2, que l'on peut renommer sans problème.

(5)C'est la position du mot bonjour dans la liste, le premier mot a se trouvant en tête de liste, qui commence par convention à la position 0.

(6)Même observation pour la lettre ç.

(7)Il semble plus rationnel de repartir à zéro, mais l'exercice qui suit n'est pas sans intérêt.

(8)On peut également utiliser, dans les éditions plus anciennes de Lazarus, le composant TNoteBook se trouvant dans l'onglet Additional, entre TPaintBox et TLabeledEdit).

(9)Le composant TRadioGroup apporte une solution encore plus simple.

(10)Cette méthode évite une saisie fastidieuse.

(11)Les index utilisés jusqu'à présent donnent accès à un objet stocké dans une liste ; les pointeurs donnent accès à un objet situé à une position donnée de la mémoire vive.

(12)À déclarer avant implementation : voir regInfo.

(13)La nouvelle procédure MAJObj doit faire l'objet d'une déclaration avant implementation.

(14)Ne pas oublier la déclaration avant implementation.

(15)C'est là où la numération hexadécimale montre sa supériorité, mais nous resterons dans la simplicité.

(16)Le premier élément de la liste possède l'index 0.

(17)On peut faire plus compliqué en écrivant Liens[0][0] : les deux notations sont acceptées par le compilateur. Notez que la désignation indique une case dont le contenu est un entier encore inconnu.

(18)N'oubliez pas de commencer par la déclaration de la fonction avant implémentation et de poursuivre dans le code après appui des touches Ctrl+Maj+C en recopiant les instructions

(19)Le processus utilisé est le plus simple, mais pas le plus rapide.

(20)Les mots qui apparaissent dans le Memo peuvent comporter des caractères insolites en remplacement de caractères accentués : il suffit de rajouter la fonction AnsiToUTF8 dans la procédure d'affichage pour que tout rentre dans l'ordre.

(21)Et la plupart des jeux de lettres.

(22)En lettres majuscules dans les jeux.

(23)Voir la création de la procédure ListBox2Click ci-dessus

(24)Voir ci-dessus comment introduire une nouvelle fonction ou procédure.

(25)La création de la procédure a été détaillée précédemment.

(26)L'ergonomie laisse encore à désirer.

(27)Voir précédemment pour la façon de créer une nouvelle procédure.

(28)Nous supposons ici que la lettre « a » est déjà liée au mot « voyelle ». Établissez ce lien si nécessaire.

(29)Le passage à la version 1.0.12 se signale ici par quelques modifications dans l'aspect des fenêtres.

(30)Ces chiffres sont susceptibles de varier selon les saisies effectuées par chacun.

(31)Un filtrage plus strict pourra être envisagé.

(32)La création de fonction a déjà fait l'objet de plusieurs présentations.

(33)Dans l'éditeur de source, effacer le texte de la procédure et supprimer sa déclaration.

(34)Code et déclaration.

(35)Le filtre transforme la saisie en éliminant majuscules, accents et caractères spéciaux tels que espace, apostrophe ou tiret.

(36)Ce nom peut varier selon les manipulations antérieures.

(37)Nous avons vu précédemment comment insérer un caractère spécial dans un bouton.

(38)Les résultats peuvent varier fortement selon les mots-clés choisis.

(39)Un tri par ordre alphabétique facilitera sa lecture.

(40)La méthode de création de procédure a fait l'objet de nombreuses descriptions dans les chapitres précédents.

(41)Les variables sont automatiquement réinitialisées, ce qui permet de répéter les recherches.

(42)Rappelons quand même que le logiciel dispose déjà d'une palette de plus de 337 000 réponses possibles !

(43)La plupart des liens sont tirés de définitions rencontrées dans des mots croisés, notamment de problèmes présentés par Laclos.

(44)La procédure doit être déclarée à la suite des déclarations existantes ; un appui sur les touches Ctrl + Maj + C crée la structure adéquate à compléter par vos soins.

(45)Variable de type Entier

(46)Qui regroupe, de façon compacte, plus de 330 000 mots dont plus de 5 000 disposent de liens.

(47)Avis aux bonnes volontés pour une icône plus présentable !

(48)Une évolution du standard ASCII.

(49)Norme contemporaine.

(50)Pierre angulaire de notre projet, convient au format ANSI.

(51)Nous avions utilisé la notion de mots voisins, pour désigner ceux qui précèdent ou suivent le mot sélectionné dans une liste