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('à âäéèêëïîôùûüÿç-'' ');
//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('à âäéèêëïîôùûüÿç-'' ');
//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.