Extension et recherches élémentaires▲
Introduction▲
Les précédents chapitres nous ont permis de découvrir une base de vocabulaire consistante, et de créer avec Lazarus(29) les outils permettant de la parcourir et de l'enrichir.
Cet enrichissement est possible soit en ajoutant des mots, soit en établissant des liens entre eux, de façon à permettre de chercher des associations d'idées potentielles.
Dans le présent chapitre, nous allons introduire un complément substantiel à notre vocabulaire, clarifier l'interface graphique, et aborder le domaine des recherches en créant un masque de saisie.
Environnement▲
Chapitre 9…
Créons un répertoire Lex9 et recopions dans ce nouveau répertoire tous les fichiers du répertoire Lex8 utilisé précédemment. Pour éviter toute difficulté ultérieure, suivez la check-list :
- ouvrir pLex8.lpi dans Lex9 avec Lazarus ;
- enregistrer uLex8.pas sous le nom de uLex9.pas ;
- accepter la suppression des références à uLex8.pas ;
- enregistrer pLex8.pas sous le nom de pLex9.pas ;
- renommer la fenêtre Lex8 en Lex9 ;
- dans le répertoire Lex9, supprimer les anciens fichiers contenant la mention Lex8 ainsi que le fichier fondamental liste.de.mots.francais.frgut.txt désormais inutile ;
- dans la procédure MAJBalayage, remplacer Lex8 par Lex9.
Nous retrouvons le projet dans l'état où nous l'avions laissé, et les modifications que nous allons effectuer n'affecteront pas l'étape précédente consultable dans le répertoire Lex8.
Extension du vocabulaire▲
Nous savons maintenant créer des liens (fichier fichLiens.bin, au format binaire) entre les différentes entrées de la liste principale (fichier liMots.txt, au format texte), et le précédent chapitre nous a montré comment modifier cette liste.
L'objectif est évidemment d'étendre les listes de mots et de liens de façon à constituer une base consistante pour nos recherches à venir.
Ce travail a déjà commencé, et les fichiers ci-jointsTéléchargez les deux fichiers vous éviteront une saisie fastidieuse : il a été réalisé à partir de définitions de mots croisés.
Pour les utiliser, il suffit de les enregistrer et de les placer dans le répertoire Lex9 que vous venez de créer, en remplacement des deux fichiers existants.
Un clic sur le petit triangle vert pour lancer l'exécution.
L'existence de deux fichiers distincts pour stocker nos données peut sembler inutilement compliquée. Nous verrons ultérieurement comment les fusionner.
Nombre de mots▲
Le nombre de mots passe de 336Â 531 Ã 337Â 254(30)Â : la variation est donc modeste, ce qui est naturel compte tenu de la taille impressionnante de la liste d'origine.
Attention à l'ordre des mots : ce n'est pas celui du dictionnaire, en raison des options adoptées, notamment au sujet des majuscules, des lettres accentuées et des caractères spéciaux.
Les apports proviennent essentiellement de noms propres, mais il y a également quelques mots courants qui, étonnamment, sont absents de la liste d'origine, comme « tansad », « addendum », « ilet », « dyne », « lieder », « cousinage », « athénien », « mât », « pet », « abracadabra », « crédit », « aquifère »…
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<>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 :
- Dans l'éditeur de source, placer le curseur en fin de ligne (n'importe laquelle) ;
- 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) ;
- Dans l'onglet Unicode, sélectionner la police Arrows ;
- 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 ;
- Ce caractère est inséré dans l'éditeur de source : le couper puis le coller dans la propriété Caption du bouton…
- 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)<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<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.
- 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.
- 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.
- 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).
- 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.
- 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('à âäéèêëïîôùûüÿç-'' ');
//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 codeTéléchargez le code complet… 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('à âäéèêëïîôùûüÿç-'' ');
//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.