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

GENÈSE D'UN DICTIONNAIRE

Construction d'un lexique interactif avec Lazarus


précédentsommaire

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 :

À partir de ces deux fichiers, nous allons construire une base de données consultable et modifiable avec pour objectif une pratique des mots croisés de plus en plus aisée grâce à l'enrichissement de la base en mots et en liens.

Nous allons utiliser Lazarus : tout autre langage ferait l'affaire. Mais dans le domaine de l'Open Source, il faut reconnaître que cet outil -entièrement gratuit- propose des éléments graphiques particulièrement simples à utiliser.

Ce chapitre constituera ainsi un hommage à l'équipe bénévole qui a su bâtir ce brillant utilitaire, le perfectionner d'année en année, et le maintenir à la disposition de tous.

Nous utilisons ici la version 1.0.14, qui date de novembre 2013.

Conventions

Nous disposons d'une liste de mots au format ANSI(48). Les affichages se font au format UTF8(49), qui fait intervenir des chaînes de caractères plus internationales, mais plus longues, plus complexes à trier et à gérer.

Pour afficher les chaînes en mémoire, nous utiliserons la fonction ANSIToUTF8, et inversement, la fonction UTF8ToANSI pour mémoriser les chaînes saisies par l'utilisateur.

Les affichages respectent le code UTF8. Les traitements (comptage des caractères en particulier) se font en code ANSI.

Par ailleurs, notre objectif est le jeu de mots croisés. Dans ce cadre, nous notons que :

  1. les majuscules ne comptent pas ;
  2. les nombres entrent dans les définitions ;
  3. les espaces, apostrophes ou traits d'union sont supprimés ;
  4. les accents et la cédille sont également supprimés.

Au niveau du tri, cela modifie beaucoup de choses.

Pourtant, nous décidons de conserver l'orthographe d'origine des mots (casse, accents, signes typographiques…) et de les classer dans la logique des mots croisés.

Pour cela, nous créons un filtre qui débarrassera chaque mot de ses majuscules, espaces, apostrophes, traits d'union, accents ou cédilles, et lançons le classement sur les mots filtrés, tout en maintenant l'orthographe d'origine dans la liste triée.

Le fonctionnement est simple.

Soient A et B deux mots « bruts », c'est-à-dire qu'ils sont susceptibles de contenir des accents ou signes spéciaux ; soient Af et Bf les mêmes mots mais passés par la moulinette du filtre :

si Af>Bf, nous décidons de placer A après B.

Le classement général est réalisé à l'origine par nos soins. Par la suite, le classement interviendra uniquement pour l'introduction d'un mot nouveau.

Le classement adopté ne correspond pas systématiquement au classement de nos dictionnaires habituels : c'est volontaire.

L'ossature de notre base de données est virtuelle : elle est constituée par la position de chaque mot dans la liste.

Les liens sont des nombres entiers qui font référence à la position de chaque mot : le premier mot de la liste est placé à la position 0 et tout lien portant ce numéro fera référence à ce premier mot.

Pour stocker les liens, nous avons choisi un tableau de tableaux d'entiers appelé Liens.

Supposons que le premier mot possède des liens : nous aurons Liens[0,0]:=0 pour identifier le tableau secondaire qui stockera ses liens. Le premier lien i avec ce mot sera stocké à la place suivante : Liens[0,1]:=i.

Le tableau principal est trié par ordre croissant des premières cases (identifiants).

Les tableaux secondaires sont triés par ordre croissant des valeurs qui occupent les cases suivantes.

Grâce à ces classements systématiques, les temps d'accès au tableau principal et à la valeur d'un lien se trouvent nettement réduits : le parcours est ramené, en moyenne, de la totalité d'une liste à sa moitié.

Interface graphique

Nous lançons Lazarus, fermons tous les fichiers ouverts et sélectionnons Nouveau projet : nous ajoutons une nouvelle fiche, puis une nouvelle unité.

Nous enregistrons l'ensemble dans le répertoire Lex12 en adoptant la nomenclature habituelle :

  • projet renommé en pLex12 ;
  • unité de la première fiche uLex12 ;
  • unité de la seconde fiche uDialog ;
  • troisième unité uDisque.

Chacune des unités inclut une ligne uses ; dans la ligne uses de uLex12, nous ajoutons uDialog et uDisque. Dans uDialog, sous le mot-clé implementation, nous ajoutons uses uLex12 ; de même pour uDisque.

Dans la première fenêtre, nous introduisons un composant PageControl et nous modifions sa taille pour qu'il occupe la totalité de la fenêtre. Dans ce composant, nous ajoutons cinq pages que nous renommons respectivement Recherche, Lecture, Ajout, Suppression et Fichier.

Page Fichier

Un clic sur la dernière page, et nous ajoutons trois boutons qui porteront les libellés Sauvegarder, Restaurer et Quitter. Nous arrangeons l'ensemble avec la souris pour obtenir sensiblement ceci :

Image non disponible

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.

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

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

Image non disponible

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 :

Image non disponible

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.

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

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

Image non disponible

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 :

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

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

Image non disponible

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 :

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

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

Image non disponible

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 :

Image non disponible

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

 
Sélectionnez
//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 » :

Image non disponible

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

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

 
Sélectionnez
procedure TForm1.FormCreate(Sender: TObject);
begin
 listeMots := TStringList.Create;
 listeMots.CaseSensitive:=True;
 lireFichier;
 lireLiens;
 nMots := listeMots.Count;
 Caption := 'Lexique de '+IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens)+' liés';
 iZoom := 1;
 iMot := 0;
 cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
//regroupe tous les caractères à remplacer
 sAcc := 'aaaeeeeiiouuuyc';
//regroupe tous les caractères de substitution
end;

Le bouton Chercher provoque la comparaison du masque avec la liste des occurrences, et si elle n'existe pas (longueur nulle pour le tableau), avec la totalité des mots.

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

Image non disponible

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 :

Image non disponible

Nous trouvons maintenant la réponse à la définition présentée par un humoriste fameux, Tristan Bernard : c'est l'entracte qui vide les baignoires et remplit les lavabos.

Page Ajout

Dans la page Ajout, nous plaçons cinq composants :

  1. un label, qui recevra le mot-titre ;
  2. un Edit autorisant la saisie d'un mot ;
  3. un bouton Flèche vers le haut pour faire passer ce mot en titre ;
  4. un ListBox recevant les mots liés au titre ;
  5. un bouton Flèche vers la droite pour faire passer le mot saisi en lien.

Avec la souris, nous agençons l'ensemble pour obtenir sensiblement ceci :

Image non disponible

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

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

Image non disponible

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 :

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

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

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

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

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

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 :

Image non disponible

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 :

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

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

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

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

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

Image non disponible

Notre projet comprend maintenant trois unités :

Unité uLex12

 
Sélectionnez
unit uLex12;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Dialogs,
  ComCtrls, StdCtrls, uDisque, uDialog;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button10: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    ListBox4: TListBox;
    ListBox5: TListBox;
    ListBox6: TListBox;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TrackBar1: TTrackBar;
    UpDown1: TUpDown;
    UpDown2: TUpDown;
    procedure Button10Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure ListBox5Click(Sender: TObject);
    procedure ListBox6Click(Sender: TObject);
    procedure TabSheet1Show(Sender: TObject);
    procedure TabSheet2Show(Sender: TObject);
    procedure AfficheLecture;
    function ChercheTabLiens(iMot : integer) : integer;
    procedure AfficheLiens;
    procedure TabSheet3Show(Sender: TObject);
    procedure TabSheet4Show(Sender: TObject);
    procedure TrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
    procedure AjoutOccur(iOccur : integer);
    procedure TriOccur;
    function SansAccent(rMot : string) : string;
    procedure MotsProches(NouvMot : string);
    function indexMotNouv(motNouv : string) : integer;
    procedure AjoutMot(motNouv : string; indexMN : integer);
    function fDoublon(iTab, iLien : integer) : boolean;
    procedure LieMots(iMot1, iMot2 : integer);
    procedure PlaceTab(k : integer);
    procedure PlaceLien(k : integer);
    procedure AfficheAjout;
    procedure AfficheSup;
    procedure SupMot;
    procedure SupprimeLien(iMot1, iTab, iMot2 : integer);

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

var
  Form1: TForm1;
  iZoom, iMot, iLien, iTabLiens : integer;
  tabReq, tabOccur : array of integer;
  cAcc, sAcc : string;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button2Click(Sender: TObject);
//restauration depuis le fichier de sauvegarde
begin
  LireMotsLiens;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   regMotsLiens;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
  TabSheet2.Show;
end;

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

procedure TForm1.Button4Click(Sender: TObject);
var i, j, k : integer;
begin
  //ajoute un mot à la liste de base tabreq
  i := ListeMots.IndexOf(UTF8toAnsi(Edit1.caption));
  if i>=0 then //le mot existe dans la liste principale
  begin
     j:=0;
     k := Length(tabReq);
     while (j<k) and (i<>tabReq[j]) do inc(j);
     if j=k then      //le mot peut être ajouté
     begin
       SetLength(tabReq, k+1); //ajoute une unité au tableau
       tabReq[k] := i;
       //affichage de la requête dans la ligne titre
       if Label3.caption = 'Saisir la requête' then
          Label3.caption:= Edit1.caption //premier mot clé
          else
          Label3.caption:= Label3.caption +' + '+Edit1.caption;
     end;
  end;
  Edit1.clear;
end;

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

procedure TForm1.Button6Click(Sender: TObject);
var i, j, k, iMax, p : integer;
    motCour, sMasque : string;
    exOccur : boolean;
begin
  i := 0;
  sMasque := SansAccent(Edit2.Caption);  //épuration de la saisie
  k := Length(sMasque);
  ListBox4.Clear;
  //vérifier que des occurrences existent
  exOccur := Length(tabOccur) > 0;
  if  exOccur then iMax :=  Length(tabOccur)
              else iMax := nMots;
  repeat
     if exOccur   then p :=  tabOccur[i] else p := i;
     motCour := SansAccent(listeMots[p]);  //épuration du mot consulté
     //recherche des mots de même longueur
     if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
     begin
       j := 1;
       while (j<=k) and ((sMasque[j]='$') or (sMasque[j] = motCour[j])) do inc(j);
       if j>k  then ListBox4.Items.Append(AnsiToUTF8(listeMots[p]));
     end;
     inc(i);
  until (i=iMax);
end;

procedure TForm1.Button7Click(Sender: TObject);
var motNouv : string;
    k : integer;
begin
 if Edit3.Caption > '' then
   begin
    motNouv := UTF8ToAnsi(Edit3.Caption);
    k := ListeMots.IndexOf(motNouv);
    if k >= 0 then iMot := k
    else
    begin
      MotsProches(motNouv);   //dresse la table des mots proches
      Form2.ChoixMot(motNouv);
      k := Form2.ShowModal;  //réponse de la boîte de dialogue
      Case  k of
        -2 : ShowMessage('Abandon');
        -1 : begin
               iMot := indexMotNouv(motNouv);
               AjoutMot(motNouv, iMot);
             end;
        else iMot := k;
      end;
    end;
    AfficheAjout;
 end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var motNouv : string;
    k : integer;
begin
  if (Edit3.Caption > '') and  (Edit3.Caption <> ListeMots[iMot])then
    begin
    motNouv := UTF8ToAnsi(Edit3.Caption);
    k := ListeMots.IndexOf(motNouv);
    if k >= 0 then iLien := k
    else
    begin
      MotsProches(motNouv);   //dresse la table des mots proches
      Form2.ChoixMot(motNouv);
      k := Form2.ShowModal;  //réponse de la boîte de dialogue
      Case  k of
        -2 : ShowMessage('Abandon');
        -1 : begin
               iLien := indexMotNouv(motNouv);
               AjoutMot(motNouv, iLien);
               if iLien<=iMot then inc(iMot);
             end;
        else iLien := k;
      end;
    end;
    if ((k >=0) and not fDoublon(iTabLiens, iLien))
       or (k = -1) then
    begin
      LieMots(iMot, iLien);
      LieMots(iLien, iMot);
      AfficheAjout;
    end;
  end;
  Edit3.Clear;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  if iTabLiens<0 then
  begin
    //le mot est seul, il peut être supprimé
    SupMot;
  end
  else
  begin
    SupprimeLien(iMot, iTabLiens, iLien);
    SupprimeLien(iLien, ChercheTabLiens(iLien), iMot);
    AfficheSup;
  end;
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
 listeMots := TStringList.Create;
 listeMots.CaseSensitive:=True;
 lireFichier;
 lireLiens;
 nMots := listeMots.Count;
 Caption := 'Lexique de '+IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens)+' liés';
 iZoom := 1;
 iMot := 0;
 cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
//regroupe tous les caractères à remplacer
 sAcc := 'aaaeeeeiiouuuyc';
//regroupe tous les caractères de substitution
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  iMot := (iMot-5+ListBox1.ItemIndex + nMots) mod nMots;
  AfficheLecture;
end;

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

procedure TForm1.ListBox5Click(Sender: TObject);
var k : integer;
begin
   k := ListBox5.ItemIndex;
   if k>=0 then
   begin
     iMot := Liens[iTabLiens, k +1 ];
     AfficheAjout;
   end;
end;

procedure TForm1.ListBox6Click(Sender: TObject);
begin
  iLien := Liens[iTabLiens, ListBox6.ItemIndex+1];
  Label7.Caption:='Supprimer le lien entre '+ Label6.Caption+
                    #13+' et '+AnsiToUTF8(ListeMots[iLien]);
end;

procedure TForm1.TabSheet1Show(Sender: TObject);
begin
  Label3.Caption := 'Saisir la requête';
  Label4.Caption := 'Saisir les lettres' + #13 +'séparées par le signe $' ;
  Edit1.Clear;
  Edit2.Clear;
  ListBox3.Clear;
  ListBox4.Clear;
  SetLength(tabReq, 0);
  SetLength(tabOccur, 0);
end;

procedure TForm1.TabSheet2Show(Sender: TObject);
begin
  AfficheLecture;
end;


procedure TForm1.AfficheLecture;
var i : integer;
begin
  Label2.Caption:='Zoom x '+ IntToStr(iZoom);
  TrackBar1.Position:= Round(iMot*1000/nMots);
  Label1.Caption:= AnsiToUTF8(ListeMots[iMot]);
  ListBox1.Clear;
  for i := 0 to 10  do
     ListBox1.Items.Add(AnsiToUTF8(ListeMots[(iMot-5 + i + nMots) mod nMots]));
  ListBox1.Selected[5] := True;
  AfficheLiens;
end;

function TForm1.ChercheTabLiens(iMot : integer): integer;
var i : integer;
begin
 ChercheTabLiens := -1;
 i := 0;
 while ((i<Length(Liens)-1) and (Liens[i, 0] < iMot)) do  inc(i);
 if (Liens[i, 0] = iMot) then ChercheTabLiens := i;
end;


procedure TForm1.AfficheLiens;
var i : integer;
begin
 if Length(Liens)>0 then
 begin
   ListBox2.Clear;
   iTabLiens := chercheTabLiens(iMot);
   if iTabLiens>=0 then
     for i :=1 to Length(Liens[iTabLiens]) -1 do
        if TabSheet2.TabVisible then
       ListBox2.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]))
        else if TabSheet2.TabVisible then
       ListBox5.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]));
 end;
end;


procedure TForm1.TabSheet3Show(Sender: TObject);
begin
  AfficheAjout;
end;

procedure TForm1.TabSheet4Show(Sender: TObject);
begin
  Button9.Caption:= 'OK';
  Button10.Caption:= 'Abandon';
  Button9.Enabled:=True;
  Button10.Enabled:=True;
  AfficheSup;
end;


procedure TForm1.TrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  iMot := (TrackBar1.Position*nMots div 1000 + nMots) mod nMots;
  AfficheLecture;
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
  if Button=btNext then Inc(iMot, iZoom)
                    else  Dec(iMot, iZoom);
  iMot := (iMot + nMots) mod nMots;
  AfficheLecture;
end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
  if Button=btNext then iZoom := iZoom * 10
                   else iZoom := iZoom div 10;
  Case iZoom of
    0 : iZoom := 1;
    1000000 : iZoom := 100000;
  end;
  Label2.Caption:= 'Zoom x '+IntToStr(iZoom);
end;

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

procedure TForm1.TriOccur;
var i, j, occTampon : integer ;
  triOK : boolean;
begin

 j := Length(tabOccur)-2;
 if j>0 then
 begin
 triOK := True;
 i := 0;
 repeat
    if (tabOccur[i] >  tabOccur[i+1])  then
    begin
      occTampon := tabOccur[i];
      tabOccur[i] := tabOccur[i+1];
      tabOccur[i+1] := occTampon;
      triOK := False;
    end;
    inc(i);
    if not triOK and (i>j) then
    begin
      i:=0; //nouvelle passe de permutations
      triOK:= True;
    end;
 until (i>j);

 end;
end;

function TForm1.SansAccent(rMot: string): string;
var i, j : integer;
//les variables sAcc et cAcc sont créées au démarrage
begin
 SansAccent := '';
 rMot := LowerCase(rMot);
 for i:=1 to Length(rMot) do
   begin
     j := Pos(rMot[i], cAcc);
     case j of
       0     : SansAccent := SansAccent + rMot[i];
       1..15 : SansAccent := SansAccent + sAcc[j];
     end;
   end;
end;

procedure TForm1.MotsProches(NouvMot: string);
var i,j : integer;
    motRef : string;
begin
  SetLength(tabOccur, 0); //vide la table existante
  motRef := SansAccent(NouvMot);
  i:=0;
  j:=0;
  while motRef[1]> SansAccent(ListeMots[i])[1] do inc(i);
  repeat
     if (motRef = SansAccent(ListeMots[i])) and (NouvMot <>ListeMots[i])then
     begin
       SetLength(tabOccur, Length(tabOccur)+1);
       tabOccur[j] := i;
       inc(j);
     end;
     inc(i);
  until ((motRef[1] < SansAccent(ListeMots[i])[1]) or (i>nMots-2));
end;

function TForm1.indexMotNouv(motNouv: string): integer;
var i : integer;
begin
  i := 0;
  motNouv := SansAccent(motNouv);
  while motNouv[1]>SansAccent(ListeMots[i][1]) do inc(i);
  while (motNouv > SansAccent(ListeMots[i])) and (i<nMots-1) do inc(i);
  indexMotNouv := i;
  if (motNouv > SansAccent(ListeMots[i])) then indexMotNouv := nMots;
end;

procedure TForm1.AjoutMot(motNouv: string; indexMN: integer);
var i, j : integer;
begin
  if indexMN<nMots-1 then
  listeMots.Insert(indexMN, motNouv)
  else listeMots.Append(motNouv);
  inc(nMots);
  //mise à jour de tous les liens
  for i:= 0 to Length(Liens)-1 do
    for j:=0 to Length(Liens[i])-1 do
      if Liens[i,j]>= indexMN then inc(Liens[i,j]);
  Caption := 'Lexique de '+IntToStr(nMots) + ' dont ' + IntToStr(nLiens) + ' liés';
end;

function TForm1.fDoublon(iTab, iLien: integer): boolean;
var i, k : integer;
begin
   fDoublon := False;
   if (iTabLiens>=0) then
   begin
     i := Length(Liens[iTab]);
     k := i-1;
     while (k>0) and (iLien < Liens[iTab, k]) do dec(k);
     if   (iLien = Liens[iTab, k]) then fDoublon := True;
   end;
end;


procedure TForm1.LieMots(iMot1, iMot2: integer);
var i, j : integer;
begin
  //pose premier lien
  i := chercheTabLiens(iMot1);
  if i<0 then
  begin
    inc(nLiens); //un mot lié supplémentaire
    SetLength(Liens, nLiens);
    SetLength(Liens[nLiens-1], 2);
    Liens[nLiens-1, 0] := iMot1; //identité du tableau secondaire
    Liens[nLiens-1, 1] := iMot2;  //premier lien
    PlaceTab(nLiens-1); //met le nouveau tableau à sa place
  end
  else //pose d'un lien supplémentaire
  begin
    j := Length(Liens[i]);
    SetLength(Liens[i], j + 1);
    Liens[i, j] := iMot2;
    PlaceLien(i);
  end;
end;

procedure TForm1.PlaceTab(k: integer);
var i : integer;
    Tamp : Array of integer;
begin
 i := k;  //dernier tableau entré
 while (i>0) and  (Liens[i, 0] < Liens[i-1, 0]) do
    begin
      Tamp :=  Liens[i];
      Liens[i] := Liens[i-1];
      Liens[i-1] := Tamp;
      dec(i);
    end;
end;

procedure TForm1.PlaceLien(k: integer);
var i, Tamp : integer;
begin
 i := Length(Liens[k]) - 1;
 while (i>1) and (Liens[k, i] < Liens[k, i-1]) do
 begin
      Tamp :=  Liens[k, i];
      Liens[k, i] := Liens[k, i-1];
      Liens[k, i-1] := Tamp;
      Dec(i);
 end;
end;


procedure TForm1.AfficheAjout;
var i : integer;
begin
  ListBox5.Clear;
  Edit3.Clear;
  Label5.Caption:= AnsiToUTF8(ListeMots[iMot]);
  iTabLiens := ChercheTabLiens(iMot);
  if iTabLiens>=0 then
   for i :=1 to Length(Liens[iTabLiens]) -1 do
     ListBox5.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]));
  Caption := 'Lexique de '+IntToStr(nMots) + ' dont ' + IntToStr(nLiens) + ' liés';

end;

procedure TForm1.AfficheSup;
var i : integer;
begin
  Label6.Caption:= AnsiToUTF8(ListeMots[iMot]);
  ListBox6.Clear;
  iTabLiens := ChercheTabLiens(iMot);
  if iTabLiens>=0 then
  begin
   for i :=1 to Length(Liens[iTabLiens]) -1 do
     ListBox6.Items.Add(AnsiToUTF8(listeMots[Liens[iTabLiens, i]]));
   iLien := Liens[iTabLiens, 1];
   ListBox6.Selected[0] := True;
   Label7.Caption:='Supprimer le lien entre '+ Label6.Caption+
                    #13+' et '+AnsiToUTF8(ListeMots[iLien]);
  end
  else
    Label7.Caption:='Supprimer le mot '+ Label6.Caption;
end;

procedure TForm1.SupMot;
var i, j : integer;
begin
  ListeMots.Delete(iMot);
  dec(nMots);
  //mise à jour de tous les liens
  for i:= 0 to Length(Liens)-1 do
    for j:=0 to Length(Liens[i])-1 do
      if Liens[i,j]>= iMot then dec(Liens[i,j]);
  Caption := 'Lexique de '+IntToStr(nMots) + ' dont ' + IntToStr(nLiens) + ' liés';
  Label6.Caption:= 'Mot supprimé';
  Label7.Caption:='';
  Button9.Enabled:=False;
  Button10.Enabled:=False;
  if iMot>0 then dec(iMot);
end;



procedure TForm1.SupprimeLien(iMot1, iTab, iMot2: integer);
var i : integer;
begin
  //recherche du tableau de liens
  if Length(Liens[iTab]) > 2 then
  begin
  for i:=1 to Length(Liens[iTab]) - 2 do
    if Liens[iTab, i]>= iMot2 then
       Liens[iTab, i] :=  Liens[iTab, i+1];
  //réduire la taille du tableau secondaire
  SetLength(Liens[iTab], Length(Liens[iTab]) - 1);
  end
  else
  begin
    //réduire la taille du tableau principal
    for i:= iTab to Length(Liens) - 2 do
      Liens[i] := Liens[i+1];
    SetLength(Liens, Length(Liens) - 1);
    dec(nLiens); //un mot lié en moins
  end;
end;

end.

Unité uDisque

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

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


précédentsommaire
Qui regroupe, de façon compacte, plus de 330 000 mots dont plus de 5 000 disposent de liens.
Avis aux bonnes volontés pour une icône plus présentable !
Une évolution du standard ASCII.
Norme contemporaine.
Pierre angulaire de notre projet, convient au format ANSI.
Nous avions utilisé la notion de mots voisins, pour désigner ceux qui précèdent ou suivent le mot sélectionné dans une liste

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2014 dimanche2003. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.