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 :
- les majuscules ne comptent pas ;
- les nombres entrent dans les définitions ;
- les espaces, apostrophes ou traits d'union sont supprimés ;
- 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('à âäéèêëïîôùûüÿç-'' ');
//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 :
- un label, qui recevra le mot-titre ;
- un Edit autorisant la saisie d'un mot ;
- un bouton Flèche vers le haut pour faire passer ce mot en titre ;
- un ListBox recevant les mots liés au titre ;
- 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('à âäéèêëïîôùûüÿç-'' ');
//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 :