GENÈSE D'UN DICTIONNAIRE

Construction d'un lexique interactif avec Lazarus

Compression▲

Introduction▲

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

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

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

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

Environnement▲

Chapitre 11…

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

ouvrir pLex10.lpi dans Lex11 avec Lazarus ;
enregistrer uLex10.pas sous le nom de uLex11.pas ;
accepter la suppression des références à uLex10.pas ;
enregistrer pLex10.pas sous le nom de pLex11.pas ;
renommer la fenêtre Lex10 en Lex11 ;
dans le répertoire Lex11 supprimer les anciens fichiers contenant la mention Lex10 ;
dans la procédure MAJBalayage, remplacer Lex10 par Lex11.

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

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

Modification du stockage▲

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

Nom	Taille (kOctets)
LiMots.txt	3 981
FichLiens.bin	95
total	4 076

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

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

Temps d'accès aux deux fichiers▲

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

Sélectionnez

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

Dans les variables globales, nous ajoutons TopChro qui recevra la valeur du compteur au départ du chronomètre :

Sélectionnez

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

Et nous recopions la procédure(44) TopChrono :

Sélectionnez

procedure TForm1.TopChrono(Message: string);
begin
  if TopChro = 0 then
  begin
    TopChro := GetTickCount;
    Form1.Memo1.Append(Message);
  end
  else
  Form1.Memo1.Append(Message + ' Durée '
                             + IntToStr(GetTickCount-TopChro)+' ms');
end;

Notre interface graphique comprend de nombreux onglets, dont le dernier, Fichier, qui est pratiquement vide. Nous y ajoutons un bouton (Caption modifié en « Chrono1 ») et un Memo :

Nous voulons provoquer la lecture et l'enregistrement des fichiers depuis un clic sur le bouton.

La procédure onClick de ce bouton peut s'écrire ainsi :

Sélectionnez

procedure TForm1.Button4Click(Sender: TObject);
begin
  TopChro := 0;
  TopChrono('Début processus');
  LireFichier(ListeMots);
  lireLiens;
  regFichier(listeMots);
  regLiens;
  TopChrono('Fin processus');
end;

Lançons l'exécution (petit triangle vert) ; clic sur le bouton Chrono1 : le mémo affiche le résultat de la mesure, soit 500 ms pour l'ensemble des processus de lecture et d'enregistrement des données.

Nous remarquons que le chargement de l'application et sa fermeture - enregistrement des données inclus - prennent au total un délai tout à fait acceptable compte tenu de la masse des informations traitées.

Les résultats peuvent varier sensiblement d'un ordinateur à un autre.

La valeur - purement indicative - sera réutilisée ultérieurement.

Fichier unique▲

Nous savons enregistrer du texte et, séparément, des tableaux de nombres de taille variable. L'emploi de l'instruction BlockWrite permet d'enregistrer toute donnée, en prenant soin de préciser au préalable sa taille : une chaîne de caractères de 7 signes sera enregistrée avec l'inscription de sa longueur -7- immédiatement avant. Un nombre quelconque sera enregistré selon la longueur qui doit être précisée : un octet sur une longueur de 1, un entier sera enregistré sur 4 octets, etc. Nous pouvons donc engager la séquence suivante :

ouverture d'un fichier qui sera nommé Lex1.bin ;
ouverture d'une boucle qui balaiera toute la liste de mots :
1. pour chaque mot, enregistrement :
  1. de sa longueur,
  2. du mot proprement dit,
  3. de la taille du tableau de liens qui lui est associé,
    1. des liens éventuels.
fermeture du fichier.

Le code de la procédure ecrireBase peut s'écrire ainsi :

Sélectionnez

procedure ecrireBase;
var
  i, j, k, m, nbOct, SLong: integer;
  Erreur: integer;
  Moti :      string;
begin
  AssignFile(fLex, 'Lex1.bin'); //==========nouveau fichier==============================
  {$I-}
  Reset(fLex, 1);
  {$I+}
  Erreur := IOResult;
  if Erreur <> 0 then
    ReWrite(fLex, 1);
  for i := 0 to listeMots.Count - 1 do
    //champ par champ à coder (longueur)
  begin
      Moti := listeMots[i];
      ecrireMot(Moti);
      m := Form1.chercheTab(i); //présence de liens
      if m<0 then j:=0
      else j:= Length(Liens[m]);
      ecrireNombre(j, 4);
      if j>0 then
        for k:= 0 to j-1 do
            ecrireNombre(Liens[m, k], 4);
  end;
  CloseFile(fLex);
end;

À noter la variable globale fLex : file à créer en tête, juste après l'instruction uses :

Sélectionnez

implementation
uses ulex11;
var fLex : file;

Deux procédures, ecrireMot et ecrireNombre, sont spécialisées dans les accès au disque :

Sélectionnez

procedure ecrireMot(Moti : string);
var
  longMot : byte;
  nbOct: integer;
begin
  longMot := Length(Moti);
  BlockWrite(fLex, longMot, SizeOf(longMot), nbOct);
  BlockWrite(fLex, Moti[1], longMot, nbOct);
end;

procedure ecrireNombre(var k; longK: byte);
var nbOct : integer;
begin
  BlockWrite(fLex, k, longK, nbOct);
end;

Un lecteur attentif aura remarqué que le nombre peut être enregistré sur une longueur qui sera fixée par paramètre (longK).

Par ailleurs, la variable nbOct reste inutilisée ici : elle serait utile pour analyser un éventuel problème lors des accès au disque.

Pour la lecture, nous reprenons la même méthode ; ne connaissant pas le nombre de mots, le programme va incrémenter une variable jusqu'à rencontrer la fin du fichier. Le code peut s'écrire ainsi :

Sélectionnez

procedure lireBase;
var
  i, j, k, iTab, nbOct, SLong: integer;
  Erreur: integer;

begin
  SetLength(Liens, 0);
  AssignFile(fLex, 'Lex1.bin'); //=nouveau fichier==================
  {$I-}
  Reset(fLex, 1);
  {$I+}
  Erreur := IOResult;
  if Erreur <> 0 then
    ReWrite(fLex, 1);
  i:=0;//indice du mot
  iTab :=0;//indice du tableau de liens
  listeMots.Clear;
  while not EOF(fLex) do
  begin
    listeMots.Append(Lire);
    j := lireNombre(4);
    if j>0 then
    begin
      SetLength(Liens, Length(Liens)+1);
      SetLength(Liens[iTab], j);
      for k:=0 to j-1 do
        Liens[iTab, k] :=  lireNombre(4);
      inc(iTab);
    end;
    inc(i);
  end;

  CloseFile(fLex);
end;

Les accès disque sont réservés aux fonctions Lire et lireNombre :

Sélectionnez

function lire: string;
var
  longMot : byte;
  nbOct: integer;
  S: string;

begin
  BlockRead(fLex, longMot, 1, nbOct);
  SetLength(S, longMot);
  BlockRead(fLex, S[1], longMot, nbOct);
  lire := S;
end;

function lireNombre(i: byte): integer;
var
  nbOct: integer;
begin
  BlockRead(fLex, Result, i, nbOct);

end;

Il nous reste maintenant à évaluer le résultat.

Nous introduisons un nouveau bouton, propriété Caption « Chrono2 », et dans la procédure onClick de ce bouton nous déclenchons le chrono pour encadrer les tâches d'enregistrement et de lecture :

Sélectionnez

procedure TForm1.Button5Click(Sender: TObject);
begin
  TopChro := 0;
  TopChrono('Début processus');
  ecrireBase;
  lireBase;
  TopChrono('Fin processus');
end;

Un clic sur le petit triangle vert… un clic sur le bouton Chrono2… un peu de patience… et le résultat désastreux s'affiche :

La réunion des deux fichiers a multiplié le temps de chargement/déchargement par un facteur de 46 !

Voyons si ce délai peut être raccourci.

Compression des mots▲

Le nouveau fichier de données s'appelle Lex1.bin. Si l'on examine son contenu à l'aide d'un éditeur, Notepad++ par exemple, on constate une répétition systématique de portions de chaînes :

Après tout, pour stocker un mot, il suffit d'enregistrer la différence qu'il présente avec le mot précédent…

Nous créons donc la fonction compteLet, qui fixe le nombre de lettres à reprendre du mot précédent pour le début du mot d'indice i.

Sélectionnez

function compteLet(MotPrec, Moti: string): byte;
var i : byte;
begin
  i:= 1;
  while (i<Length(MotPrec)) and (i<Length(Moti))
                         and (MotPrec[i] = Moti[i]) do inc(i);
  compteLet := i-1;
end;

Connaissant ce paramètre, nous pouvons remanier l'organigramme précédent pour l'intégrer lors de l'enregistrement :

ouverture d'un fichier, qui sera nommé Lex2.bin ;
ouverture d'une boucle qui balaiera toute la liste de mots :
1. pour chaque mot, enregistrement :
  1. de sa longueur réduite à la partie droite différente par rapport au mot précédent,
  2. de cette partie proprement dite,
  3. du nombre de lettres à reprendre du mot précédent,
  4. de la taille du tableau de liens qui lui est associé,
    1. des liens éventuels.
Fermeture du fichier.

La procédure ecrireMot devient ecrireZip :

Sélectionnez

procedure ecrireZip;
var
  i, j, k, m, nbOct : integer;
  nLiens, nLet : byte;
  Erreur: integer;
  S, MotPrec, Moti :      string;
begin

  //nTotLiens := 0;
  AssignFile(fLex, 'Lex2.bin'); //==========nouveau fichier dico==============================
  {$I-}
  Reset(fLex, 1);
  {$I+}
  Erreur := IOResult;
  if Erreur <> 0 then
    ReWrite(fLex, 1);
  Truncate(fLex);
  Seek(fLex, 0);
  MotPrec := '';
  for i := 0 to listeMots.Count - 1 do
    //champ par champ à coder (longueur)
  begin
      Moti := listeMots[i];
      nLet := compteLet(MotPrec, Moti);
      S := RightStr(Moti, Length(Moti)-nLet);
      EcrireMot(S);
      EcrireNombre(nLet, 1); //nombre de lettres communes avec le préc
      m := Form1.chercheTab(i); //présence de liens
      if m<0 then nLiens:=0
      else nLiens:= Length(Liens[m]);
      ecrireNombre(nLiens, 1);
      if nLiens>0 then
        for k:= 0 to nLiens-1 do
            ecrireNombre(Liens[m, k], 4);
      MotPrec := Moti;
  end;
  CloseFile(fLex);
end;

Pour lire les données ainsi enregistrées, nous créons la procédure lireZip, qui accèdera aux données dans le même ordre :

Sélectionnez

procedure lireZip;
var   longLiens, nLet : byte;
      i, j, k, iTab : integer;
      MotPrec, Moti : string;
begin
  AssignFile(fLex, 'LexLiens.bin');
  {$I-}
  Reset(fLex, 1);
  {$I+}
  if IOResult = 0 then
  begin
    Seek(fLex, 0);
    i := 0;
    listeMots.Clear;
    SetLength(Liens, 0);
    iTab := 0;
    MotPrec := '';
    while not EOF(fLex) do
    begin
        Moti   := Lire;
        nLet := LireNombre(1); //nombre de lettres à reprendre du précédent
        Moti := LeftStr(MotPrec, nLet) + Moti;
        listeMots.Append(Moti);
        MotPrec := Moti; //
        longLiens := lireNombre(1);
        if longLiens>0 then
        begin
          SetLength(Liens, Length(Liens)+1);
          SetLength(Liens[iTab], longLiens);
          for k:=0 to longLiens-1 do
            Liens[iTab, k] :=  lireNombre(4);
          inc(iTab);
        end;
        Inc(i);
    end;
    nLiens := iTab;
    CloseFile(fLex);
  end;
end;

Pour évaluer l'efficacité de la méthode, nous mesurons la durée de l'enregistrement et de la lecture des données.

Dans l'onglet Fichier, nous ajoutons un bouton, Caption « Chrono3 », et dans la procédure onClick de ce bouton, nous complétons le code comme précédemment :

Sélectionnez

procedure TForm1.Button11Click(Sender: TObject);
begin
 TopChro := 0;
 TopChrono('Début processus');
 ecrireZip;
 lireZip;
 TopChrono('Fin processus');
end;

Un clic sur le petit triangle vert pour lancer l'exécution, un clic sur le nouveau bouton, et le verdict apparaît :

Mode retenu▲

Sans appel : nos manœuvres aboutissent à des résultats rédhibitoires, et la solution antérieure se révèle nettement supérieure aux variantes envisagées. Nous avions déjà eu l'occasion de signaler la puissance de la fonction précâblée autorisant la lecture d'un texte en une seule fois, et nous constatons encore son efficacité.

Fichiers de données	Volume (KO)	Durée Entrée/Sortie (ms)
LiMots.txt + fichLiens.bin	4 076	500
Lex1.bin	5 043	23 125
Lex2.bin	1 888	28 156

Pourtant, la compacité du fichier zip obtenu (1,9 Mo) présente un certain intérêt : pourquoi ne pas adopter ce format pour sauvegarder les données et les restaurer en cas de problème ?

Le lecteur avisé remplacera les boutons Chrono par un bouton de sauvegarde, et un second destiné à la restauration. Le format de fichier sera évidemment celui qui donne le volume le plus réduit.

Ainsi, il sera armé en cas de problème sur l'un ou l'autre des fichiers de données.

Le troisième bouton pourra être supprimé de l'onglet ainsi que le composant Memo.

Pour revenir aux accès-fichiers antérieurs, nous réactivons les instructions LireFichier et LireLiens dans la procédure FormCreate, et regLiens, regFichier dans la procédure Button1Click.

Fenêtre de choix▲

Les boîtes de dialogue offertes par Lazarus sont pratiques, mais leurs performances souvent limitées.

Par exemple, si un utilisateur frappe le mot « macon », notre logiciel fait apparaître une fenêtre de confirmation qui présente bien les mots proches existants, et le choix Yes/No. Le signe point d'interrogation ne présente aucun intérêt, de même que la croix de fermeture.

Image non disponible

Nous nous proposons ici de créer une boîte de dialogue dans laquelle l'utilisateur pourra cliquer sur un des mots présentés en alternative, pour le sélectionner, et avec un libellé des boutons plus précis.

Principe de fonctionnement▲

Pour créer une fenêtre de dialogue, nous disposons des fonctions Hide, Show, Activate, Visible, etc. qui permettent d'afficher et de cacher une fenêtre. L'ensemble devient rapidement lourd et complexe.

Pourtant, la tâche devient très simple en utilisant la variable ModalResult liée à chaque fenêtre.

La procédure est la suivante :

ajouter au projet une nouvelle fiche ;
la nouvelle fiche est affectée automatiquement d'une variable cachée, ModalResult(45), dont la valeur initiale est fixée à zéro ;
aussitôt que, dans le cadre d'un événement quelconque, cette variable reçoit une nouvelle valeur (donc différente de zéro), la nouvelle fiche est cachée ;
la valeur de la variable est récupérable dans la fenêtre principale (ou toute autre fenêtre du projet) sous le nom de ShowModal.

Par exemple, dans la nouvelle fenêtre Form2, nous introduisons un bouton, et dans la procédure onClick de ce bouton, nous écrivons l'instruction unique :

Sélectionnez

ModalResult:= 333 ;

Aussitôt que l'on aura cliqué sur le bouton, la nouvelle fenêtre disparaîtra. Pour récupérer la valeur de ModalResult dans la variable i, il suffira d'écrire l'instruction :

Sélectionnez

I := Form2.ShowModal ;

Fenêtre modale▲

Dans le menu de Lazarus, nous cliquons sur le mot Fichier et choisissons Nouvelle Fiche. L'objet apparaît sur le bureau, complété dans l'éditeur de source par une nouvelle unité que nous enregistrons sous le nom de uDialog.

Déclarations▲

Cette unité est déclarée à la suite des autres dans la ligne Uses de uLex11 :

Sélectionnez

interface

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

Par ailleurs, dans l'unité uDialog, nous déclarons l'unité principale uLex11, sous le mot-clé implementation :

Sélectionnez

implementation

uses uLex11;

{ TForm2 }

Interface graphique▲

Nous titrons la fenêtre (propriété Caption) en « Choix du mot » et nous lui ajoutons quatre composants :

un ListBox, qui recevra le mot nouveau et les mots approchants éventuels ;
un Label qui affichera le mot sélectionné ;
un bouton (Caption porté à « Confirmer ») ;
un second bouton, « Abandon ».

Les dispositions sont ajustées à la souris pour obtenir sensiblement ceci :

Image non disponible

Pour supprimer les icônes techniques, nous portons à False toutes les valeurs des lignes de BorderIcons dans l'inspecteur d'objets. Au sujet de l'encadrement de la fenêtre, nous choisissons bsDialog dans la ligne BorderStyle.

Code▲

La procédure Choix affichera dans le ListBox le mot nouveau, transmis en paramètre, suivi de tous les mots approchants. Sa déclaration se fait à la suite des composants. Un appui sur les touches Ctrl + Maj + C créent la nouvelle structure, que nous complétons ainsi :

Sélectionnez

procedure TForm2.Choix(motNouv: string);
var i : integer;
begin
  Label1.Caption:=AnsiToUTF8(motNouv);
  ListBox1.Clear;
  ListBox1.Items.Append(Label1.Caption);
  ListBox1.Selected[0] := True;
  iProv := -1;
  if Length(tabApprox) > 0 then
    for i:= 0 to Length(tabApprox)-1 do
      ListBox1.Items.Append(AnsiToUTF8(listeMots[tabApprox[i]]));
end;

La variable provisoire iProv recevra les indices des mots choisis ; au départ, elle vaut -1, ce qui exprime que le mot sélectionné est le mot nouveau. Cette variable sera modifiée dans d'autres procédures : il faut donc la déclarer en variable globale.

Sélectionnez

var
  Form2: TForm2;
  iProv : integer;

implementation

uses uLex11;

{ TForm2 }

Pour modifier la sélection, nous utilisons l'événement onClick du listBox :

Sélectionnez

procedure TForm2.ListBox1Click(Sender: TObject);
begin
   Label1.Caption:= ListBox1.GetSelectedText;
   if ListBox1.ItemIndex>0 then iProv := tabApprox[ListBox1.ItemIndex-1]
   else  iProv := -1;
end;

Pour confirmer le choix, nous cliquons sur le premier bouton ; la procédure onClick s'écrit simplement ainsi :

Sélectionnez

procedure TForm2.Button1Click(Sender: TObject);
begin
  ModalResult := iProv;
end;

Et pour abandonner, un clic sur le 2e bouton déclenchera la procédure suivante :

Sélectionnez

procedure TForm2.Button2Click(Sender: TObject);
begin
   ModalResult := -2;
end;

Ouverture du dialogue▲

Jusqu'à présent, la boîte de dialogue s'ouvrait dans le cours de la fonction fAnnonceMotNouveau : nous la remanions pour lancer la procédure Choix et récupérer la valeur de ShowModal.

Sélectionnez

function TForm1.fAnnonceMotNouveau(motNouv: string): integer;
var i, indexMotNouv  : integer;

 begin
    Form2.Choix(motNouv);
    i := Form2.ShowModal;
    Case i of
      -2 : ShowMessage('Abandon');
      -1 : begin
              indexMotNouv := fMotNouv(motNouv);
              AjoutMot(motNouv, indexMotNouv);
              fAnnonceMotNouveau := indexMotNouv;
            end ;
      else begin
              fAnnonceMotNouveau := i;
              Edit3.Caption := AnsiToUTF8(listeMots[i]);
           end;
      end;
 end;

Application▲

Nous allons tester notre nouvelle boîte de dialogue en entrant le nom de Pâris, qui est le fils de Priam, roi de Troie. Dans l'onglet Liens, nous écrivons « Pâris » et cliquons sur la flèche vers le haut : notre nouvelle fenêtre de dialogue apparaît.

Image non disponible

À cet instant, l'utilisateur aura la possibilité de sélectionner un des deux autres mots, de changer d'avis, et enfin de confirmer son choix ou d'abandonner. Dès qu'il aura pris sa décision (un clic sur un bouton est nécessaire), la fenêtre de dialogue disparaîtra et la gestion habituelle de notre dictionnaire pourra reprendre.

Il semble que l'ergonomie de notre projet se soit nettement améliorée… mais incontestablement, il reste encore à faire pour le mettre à l'abri de toute critique !

Conclusion▲

Ce chapitre nous a montré comment stocker et sauvegarder nos données de façon efficace : rapide pour un accès courant, compacte pour des sauvegardes de sécurité. Nous avons laissé au lecteur le soin de nettoyer le dernier onglet pour ne laisser, outre le bouton Arrêt, que les boutons Sauvegarde et Récupération.

Par ailleurs, nous avons réalisé une boîte de dialogue personnalisée qui améliore l'assistance de l'utilisateur lorsqu'il entre un mot nouveau. La programmation se révèle particulièrement simple et le résultat convaincant.

Notre projet tient maintenant la route et nous espérons qu'il sera utile à de nombreux cruciverbistes et… aux apprentis programmeurs, qui peuvent constater ici que l'informatique peut - aussi - aborder des domaines aussi complexes que le vocabulaire, l'orthographe, et… l'association d'idées.

Cédille

Signe typographique inventé par un certain M. Duçon.

Code▲

Unité uLex11▲

Sélectionnez

unit ulex11;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button2: TButton;
    Button3: TButton;
    boutFH: TButton;
    boutReq: TButton;
    boutMasq: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    CheckBox1: TCheckBox;
    edMasq: TEdit;
    edReq: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    labMasq: TLabel;
    labReq: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    ListBox4: TListBox;
    lisReq: TListBox;
    lisMasq: TListBox;
    Memo1: TMemo;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    tabLogique: TTabSheet;
    Zoom: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    AffListe: TListBox;
    PageControl1: TPageControl;
    Page1: TTabSheet;
    TabSheet1: TTabSheet;
    TrackBar1: TTrackBar;
    UpDown2: TUpDown;
    procedure AffListeClick(Sender: TObject);
    procedure boutFHClick(Sender: TObject);
    procedure boutMasqClick(Sender: TObject);
    procedure boutReqClick(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure CheckBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure ListBox3Click(Sender: TObject);
    procedure ListBox4Click(Sender: TObject);
    procedure Recherche(rechMot: string);
    procedure tabLogiqueExit(Sender: TObject);
    procedure tabLogiqueShow(Sender: TObject);
    procedure TabSheet1Show(Sender: TObject);
    procedure TabSheet3Show(Sender: TObject);
    procedure TabSheet4Show(Sender: TObject);
    procedure TabSheet5Show(Sender: TObject);
    procedure TrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MAJBalayage;
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
    procedure ZoomMouseLeave(Sender: TObject);
    function chercheTab(iMot : integer) : integer;
    procedure Lier(iMot, iLien : integer);
    procedure AffLiens;
    procedure PlaceLien(k : integer);
    function PlaceTab(k : integer) : integer;
    function SansAccent(rMot : string) : string;
    procedure listeApprox(rechMot : string);
    procedure MAJSupp;
    procedure SuppLien(iMot, iLien : integer);
    function fMotNouv(rechMot : string) : integer;
    function fAnnonceMotNouveau(motNouv : string) : integer;
    procedure AjoutMot(motNouv : string; indexMotNouv : integer);
    procedure AjoutMotSecur(motNouv : string ; indexMotNouv : integer);
    procedure SupMot(motCour : string; indexMotCour : integer);
    function fDoublon(iMot, iLien: integer): boolean;
    procedure Masque(rechMot: string);
    procedure AjoutOccur(iOccur : integer);
    procedure TriOccur;

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

const delta=5;

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

implementation

{$R *.lfm}

{ TForm1 }

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

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

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

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


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


procedure TForm1.Button10Click(Sender: TObject);
var iLien : integer;
    motNouv : string;
begin
     if Edit3.Caption > #47 then
     begin
       motNouv := UTF8ToAnsi(Edit3.Caption);
       iLien := listeMots.IndexOf(motNouv);
       if iLien<0 then  iLien := fAnnonceMotNouveau(motNouv);
       //iLien vaut maintenant l'index du mot nouveau ou approché
       if (iLien>=0) and  (iLien<>iMot) and not fDoublon(iMot, iLien) then
       begin
           Label4.Caption:= Edit3.Caption;
           iMot := iLien;
       end;
       AffLiens;
     end
     else ShowMessage('Entrez le mot');
     Edit3.Clear;
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
  //regMotCourtsLiens;
  ecrirebase;
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
  //LireMotCourtsLiens;
  lirebase;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   //Recherche(UTF8ToAnsi(Edit2.Caption));
   ListBox3.Clear;
   Masque(SansAccent(UTF8ToAnsi(Edit2.Caption)));
end;


function TForm1.fMotNouv(rechMot: string): integer;
var i, k : integer;
    referMot : string;
begin
      SetLength(tabApprox, 0);   //mise à zéro du tableau
      referMot := SansAccent(rechMot);
      //point de démarrage de la recherche : première lettre du mot
      i := 0;
      k := 0;
      while SansAccent(listeMots[i][1]) < referMot[1] do inc(i);
      //début de la recherche
      repeat
        //k index futur du mot nouveau
        if (k=0) and (SansAccent(listeMots[i]) > referMot) then  k := i
        else if SansAccent(listeMots[i]) = referMot then
        begin
           //enregistrement des index pour réutilisation
           SetLength(tabApprox, Length(tabApprox)+1);
           tabApprox[Length(tabApprox)-1] := i;
        end;
        inc(i)
      until (i>nMots-1) or (SansAccent(listeMots[i][1]) > referMot[1]);
      if k=0 then fMotNouv := nMots else fMotNouv := k;
end;

//==========================
function TForm1.fAnnonceMotNouveau(motNouv: string): integer;
 var i, indexMotNouv  : integer;

 begin
    Form2.Choix(motNouv);
    i := Form2.ShowModal;
    Case i of
      -2 : ShowMessage('Abandon');
      -1 : begin
              indexMotNouv := fMotNouv(motNouv);
              AjoutMot(motNouv, indexMotNouv);
              fAnnonceMotNouveau := indexMotNouv;
            end ;
      else begin
              fAnnonceMotNouveau := i;
              Edit3.Caption := AnsiToUTF8(listeMots[i]);
           end;
      end;
 end;

procedure TForm1.AjoutMot(motNouv: string; indexMotNouv: integer);
var   nouvLiens : array of array of integer;
      i, j : integer;
begin
   nouvLiens := Liens;
   for i:=0 to Length(Liens)-1 do
     for j:=0 to Length(Liens[i])-1 do
       if Liens[i, j]>= indexMotNouv then inc(Liens[i, j]);
   if iMot >= indexMotNouv then inc(iMot);                     //mise à jour effectuée
   SetLength(nouvLiens, 0);
   listeMots.Insert(indexMotNouv, motNouv); //modification de la liste principale
   inc(nMots);
end;
//===========doublons=======================
function TForm1.fDoublon(iMot, iLien: integer): boolean;
var i, j : integer;
begin
  //vérfie que le lien n'existe pas déjà
  //cherche le tableau de liens correspondant à iMot
  fDoublon := False;
  j := chercheTab(iMot);
  if j>=0 then
  begin
    i := Length(Liens[j])-1;
    while (i>0) and (iLien<Liens[j, i]) do dec(i);
    if iLien = Liens[j, i] then fDoublon := True;
    if fDoublon then ShowMessage('Doublon refusé');
  end;
end;

procedure TForm1.Masque(rechMot: string);
var i, j, k : integer;
    motCour : string;
begin
  i := 0;
  k := Length(rechMot);
  Label1.Caption:= ('Mot de ' + IntToStr(k)+ ' lettres' );
  ListBox3.Clear;
  repeat
    motCour := SansAccent(listeMots[i]);
    if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
    begin
      j := 1;

      while (j<=k) and ((rechMot[j]='$') or (rechMot[j] = motCour[j])) do inc(j);
      if j>k  then ListBox3.Items.Append(AnsiToUTF8(listeMots[i]));
    end;
    inc(i);
  until (i=nMots) or ((rechMot[1]='$') and (rechMot[1] > motCour[1]));
  //balayage tant que la première lettre est inférieure à celle du masque
  if ListBox3.Count=0 then Label1.Caption:= ('échec')
                      else Label1.Caption:= (IntToStr(ListBox3.Count)+
                                             ' mots trouvés');
end;

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

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


procedure TForm1.AjoutMotSecur(motNouv: string; indexMotNouv: integer);
var  nouvLiens : array of array of integer;
      i, j : integer;
begin
   SetLength(nouvLiens, Length(Liens));
   for i:=0 to Length(Liens)-1 do
     begin
       SetLength(nouvLiens[i], Length(Liens[i]));
       for j:=0 to Length(Liens[i])-1 do
         if Liens[i, j]>= indexMotNouv then nouvLiens[i, j] := Liens[i, j] + 1
         else nouvLiens[i, j] := Liens[i, j];
     end;
   Liens := nouvLiens;   //mise à jour effectuée
   if iMot >= indexMotNouv then inc(iMot);
   listeMots.Insert(indexMotNouv, motNouv); //modification de la liste principale
   inc(nMots);
end;

//==============================

procedure TForm1.SupMot(motCour: string; indexMotCour: integer);
var  nouvLiens : array of array of integer;
     i, j : integer;
begin
   SetLength(nouvLiens, Length(Liens));
   for i:=0 to Length(nouvLiens)-1 do
     begin
       SetLength(nouvLiens[i], Length(Liens[i]));
       for j:=0 to Length(nouvLiens[i])-1 do
         if Liens[i, j]>= indexMotCour then nouvLiens[i, j] := Liens[i, j] - 1
         else  nouvLiens[i, j] := Liens[i, j];
     end;
   if iMot >= indexMotCour then dec(iMot);
   Liens := nouvLiens;
   //mise à jour effectuée
   listeMots.Delete(indexMotCour);        //modification de la liste principale
   dec(nMots);
end;


procedure TForm1.Button3Click(Sender: TObject);
var iLien : integer;
    motNouv : string;
begin
     if Edit3.Caption > #47 then
     begin
       motNouv := UTF8ToAnsi(Edit3.Caption);
       iLien := listeMots.IndexOf(motNouv);
       if iLien<0 then  iLien := fAnnonceMotNouveau(motNouv);
       if (iLien>=0) and  (iLien<>iMot) and not fDoublon(iMot, iLien) then
       begin
           Lier(iMot, iLien);
           Lier(iLien, iMot);
       end;
       AffLiens;
     end
     else ShowMessage('Entrez le mot');
     Edit3.Clear;
end;

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

procedure TForm1.Button5Click(Sender: TObject);
begin
  lireMotsLiens;
end;




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

//=================
procedure TForm1.Button7Click(Sender: TObject);
var i  : integer;
    motNouv : string;
begin
   motNouv := UTF8ToAnsi(Edit4.Caption);
   i := listeMots.IndexOf(motNouv);
   if (i >= 0) then ShowMessage('Mot existant')
   else
   begin
     i := fAnnonceMotNouveau(motNouv);
     if i>=0 then iMot :=  i;
     Edit4.Clear;
   end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var indexMotCour  : integer;
    motCour, Rep : string;
begin
//le mot peut être supprimé si aucun lien ne lui est affecté
     motCour := UTF8ToAnsi(Edit4.Caption);
     indexMotCour := listeMots.IndexOf(motCour);
     if (indexMotCour<0) then ShowMessage ('Supprimé')
     else if (chercheTab(indexMotCour)<0) then
     begin
       Rep := 'Supprimer le mot '+ Edit4.Caption +' ? ';
       if MessageDlg ('Suppression', Rep, mtConfirmation,
                        [mbYes, mbNo],0) = mrYes
       then SupMot(motCour, indexMotCour);
       MAJBalayage;
       Edit4.Clear;
     end
     else ShowMessage ('Supprimez les liens avant de supprimer le mot');
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  ShowMessage('Supprimez le mot, puis ajoutez le nouveau mot');
end;


procedure TForm1.CheckBox1Change(Sender: TObject);
begin
  if CheckBox1.Checked then CheckBox1.Caption := 'Avec filtre'
  else CheckBox1.Caption := 'Sans filtre';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  listeMots := TStringList.Create;
  listeMots.CaseSensitive:=True;
  //LireFichier(listeMots);
  //lireLiens;
  lireMotsLiens;
  //lirebase;
  nMots := listeMots.Count;

  iMot := 0;
  Edit3.Clear;
  Edit2.Clear;
  Label1.Caption := 'saisir les lettres séparées par le signe $';
  MAJBalayage;
  cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
//regroupe tous les caractères à remplacer
  sAcc := 'aaaeeeeiiouuuyc';
//regroupe tous les caractères de substitution
end;

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

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

procedure TForm1.ListBox3Click(Sender: TObject);
begin
 if ListBox3.ItemIndex>=0 then
 begin
  iMot := listeMots.IndexOf(ListBox3.Items[ListBox3.ItemIndex]);
  Label1.Caption:= listeMots[iMot];
 end;
end;

procedure TForm1.ListBox4Click(Sender: TObject);
begin
  if ListBox4.ItemIndex >= 0 then
  begin
    iLien := Liens[chercheTab(iMot), ListBox4.ItemIndex+1];
    Label6.Caption:= 'Supprimer le lien entre '+
                      AnsiToUTF8(listeMots[iMot]) +  ' et '+
                      AnsiToUTF8(listeMots[iLien])+ ' ?';
    Button6.Enabled := True;
  end;
end;

procedure TForm1.MAJBalayage;
var i : integer;
begin
   Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
   Label4.Caption:=Label2.Caption;
   TrackBar1.Position:= Round(iMot*1000/nMots);
   Edit2.Clear;
   AffListe.Clear;
   for i := 0 to 10 do
       AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-5 + i + nMots) mod nMots]));
   AffListe.Selected[5] := True;
   AffLiens;
   Caption := 'Lex11 '+IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens) + ' liés';
   MAJSupp;
end;


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

procedure TForm1.ZoomMouseLeave(Sender: TObject);
begin
   if RadioButton1.Checked then UpDown2.Increment := 1
   else if RadioButton2.Checked then UpDown2.Increment := 10
   else if RadioButton3.Checked then UpDown2.Increment := 100
   else if RadioButton4.Checked then UpDown2.Increment := 1000;
end;


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

procedure TForm1.Lier(iMot, iLien: integer);
var k : integer;
begin
  k := chercheTab(iMot);
  if k < 0 then
  begin
     SetLength(Liens, Length(Liens)+1); //extension du tableau principal
     k := Length(Liens)-1;
     SetLength(Liens[k], 1);
     Liens[k][0] := iMot; //identifiant
     k := PlaceTab(k);    //nouvel emplacement
     Inc(nLiens); //mise à jour du nombre de mots liés
  end;
  SetLength(Liens[k], Length(Liens[k])+1);  //extension du tableau secondaire
  Liens[k, Length(Liens[k])-1] := iLien;  // lien
  PlaceLien(k);                           //tri
end;

procedure TForm1.AffLiens;
var i, k : integer;
begin
 if Length(Liens)>0 then
 begin
   ListBox1.Clear;
   k := chercheTab(iMot);
   if k>=0 then
     for i :=1 to Length(Liens[k]) -1 do
       ListBox1.Items.Add(AnsiToUTF8(listeMots[Liens[k, i]]));
   ListBox2.Items := ListBox1.Items;
 end;
end;

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

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

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

procedure TForm1.listeApprox(rechMot: string);
var i : integer;
    referMot : string;
    begin
     SetLength(tabApprox, 0);   //mise à zéro du tableau
     referMot := SansAccent(rechMot);
     if referMot>'' then
     begin
        //point de démarrage de la recherche : première lettre du mot
        i := 0;
        while SansAccent(listeMots[i][1]) < referMot[1] do inc(i);
        //début de la recherche
        repeat
          if SansAccent(listeMots[i]) = referMot then
          begin
             listBox3.Items.Append(AnsiToUTF8(listeMots[i]));
             //enregistrement des index pour réutilisation
             SetLength(tabApprox, Length(tabApprox)+1);
             tabApprox[Length(tabApprox)-1] := i;
          end;
          inc(i)
        until (i>nMots-1) or (SansAccent(listeMots[i][1]) > referMot[1]);
        //la première lettre a changé
    end;
end;
procedure TForm1.MAJSupp;
begin
  Label5.Caption := Label4.Caption;
  ListBox4.Items := ListBox1.Items;
  Label6.Caption:= '';
  Button6.Enabled:= False;
end;

procedure TForm1.SuppLien(iMot, iLien: integer);
var i, k : integer;
begin
//dans le tableau secondaire de iMot, on supprime iLien
  k := chercheTab(iMot);
  i:=1;
  while Liens[k, i]<> iLien do inc(i);
  while (i<Length(Liens[k])-1) do
  begin
     Liens[k, i] :=  Liens[k, i+1];
     inc(i);
  end;
  SetLength(Liens[k], Length(Liens[k]) - 1);
  if (Length(Liens[k]) = 1) then  //le mot n'a plus de lien
  begin
     for i := k to Length(Liens)-2 do
         Liens[i] := Liens[i+1];
     SetLength(Liens, Length(Liens)-1);
     nLiens := Length(Liens);
  end;
  MAJBalayage;
end;


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


procedure TForm1.Recherche(rechMot: string);
var irechMot : integer;
begin
 listBox3.Clear;
 irechMot := listeMots.IndexOf(rechMot);
 if irechMot >= 0 then
  begin
    Label1.Caption:= AnsiToUTF8(listeMots[irechMot]);
    iMot := irechMot;
    MAJBalayage;
  end
  else
  begin
    Label1.Caption:= 'échec';
    listeApprox(rechMot);
  end;
end;

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

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

procedure TForm1.TabSheet1Show(Sender: TObject);
begin
  MAJBalayage;
end;

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

procedure TForm1.TabSheet4Show(Sender: TObject);
begin
  MAJSupp;
end;

procedure TForm1.TabSheet5Show(Sender: TObject);
begin
   Edit4.Caption := AnsiToUTF8(listeMots[iMot]);
end;


end.

Unité uDisque▲

Sélectionnez

unit uDisque;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Dialogs;

procedure LireFichier(listeMots : TStringList);
procedure regLiens;
procedure lireLiens;
procedure regFichier(listeMots : TStringList);
procedure regMotsLiens;
//function compteLet(Moti, MotSuiv : string) : byte;
function compteLet(MotPrec, Moti: string): byte;
procedure ecrireMot(Moti : string);
procedure ecrireNombre(var k; longK : byte);
procedure lireMotsLiens;
function lireNombre(i : byte) : integer;
function lire : string;
procedure ecrireBase;
procedure lireBase;

implementation

uses ulex11;

var fLex : file;

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

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

begin
  AssignFile(fLiens, 'fichLiens.bin');
  {$I-}
  Reset(fLiens);
  {$I+}
  ReWrite(fLiens, 1);
  for i := 0 to Length(Liens)-1 do
  begin
    j := Length(Liens[i]);
    Write(fLiens, j);
    for k:=0 to j-1 do
      Write(fLiens, Liens[i, k]);
  end;
  CloseFile(fLiens);
end;
//====&#8658;&#8658;


procedure lireLiens;
var
  j, m : integer;
  fLiens : file of integer;
begin
  nLiens := 0;   //nombre de mots liés
  AssignFile(fLiens, 'fichLiens.bin');
  {$I-}
  Reset(fLiens);
  {$I+}
  if IOResult<>0 then
    ShowMessage('Fichier liens inexistant')
  else
  while not EOF(fLiens) do
  begin
    SetLength(Liens, nLiens+1);      //taille du tableau principal
    Read(fLiens, m);
    SetLength(Liens[nLiens], m);     //taille du tableau secondaire
    for j := 0 to m-1 do
      Read(fLiens, Liens[nLiens, j]); //remplissage du tableau secondaire
    inc(nLiens);                      //nombre de mots liés
  end;
  CloseFile(fLiens);
end;

procedure regFichier(listeMots: TStringList);
begin
   listeMots.SaveToFile('liMots.txt');
end;

procedure regMotsLiens;
var
  i, j, k, m, nbOct, SLong: integer;
  nLiens, nLet : byte;
  Erreur: integer;
  S, MotPrec, Moti :      string;
begin

  //nTotLiens := 0;
  AssignFile(fLex, 'LexLiens.bin'); //==========nouveau fichier dico==============================
  {$I-}
  Reset(fLex, 1);
  {$I+}
  Erreur := IOResult;
  if Erreur <> 0 then
    ReWrite(fLex, 1);
  Truncate(fLex);
  Seek(fLex, 0);
  MotPrec := '';
  for i := 0 to listeMots.Count - 1 do
    //champ par champ à coder (longueur)
  begin
      Moti := listeMots[i];
      nLet := compteLet(MotPrec, Moti);
      S := RightStr(Moti, Length(Moti)-nLet);
      EcrireMot(S);
      EcrireNombre(nLet, 1); //nombre de lettres communes avec le préc
      m := Form1.chercheTab(i); //présence de liens
      //ShowMessage(IntToStr(j)+' liens');
      if m<0 then nLiens:=0
      else nLiens:= Length(Liens[m]);
      ecrireNombre(nLiens, 1);
      if nLiens>0 then
        for k:= 0 to nLiens-1 do
            ecrireNombre(Liens[m, k], 4);
      MotPrec := Moti;
  end;
  CloseFile(fLex);
end;

function compteLet(MotPrec, Moti: string): byte;
var i : byte;
begin
  i:= 1;
  while (i<Length(MotPrec)) and (i<Length(Moti))
                         and (MotPrec[i] = Moti[i]) do inc(i);
  compteLet := i-1;
end;


procedure ecrireNombre(var k; longK: byte);
var nbOct : integer;
begin
  BlockWrite(fLex, k, longK, nbOct);
end;

procedure lireMotsLiens;
var   longLiens, nLet : byte;
      i, j, k, iTab : integer;
      MotPrec, Moti : string;
begin
  AssignFile(fLex, 'LexLiens.bin');
  {$I-}
  Reset(fLex, 1);
  {$I+}
  if IOResult = 0 then
  begin
    Seek(fLex, 0);
    i := 0;
    listeMots.Clear;
    SetLength(Liens, 0);
    iTab := 0;
    MotPrec := '';
    while not EOF(fLex) do
    begin
        Moti   := Lire;
        nLet := LireNombre(1); //nombre de lettres à reprendre du précédent
        Moti := LeftStr(MotPrec, nLet) + Moti;
        listeMots.Append(Moti);
        MotPrec := Moti; //
        longLiens := lireNombre(1);
        if longLiens>0 then
        begin
          SetLength(Liens, Length(Liens)+1);
          SetLength(Liens[iTab], longLiens);
          for k:=0 to longLiens-1 do
            Liens[iTab, k] :=  lireNombre(4);
          inc(iTab);
        end;
        Inc(i);
    end;
    nLiens := iTab;
    CloseFile(fLex);
  end;
end;

function lireNombre(i: byte): integer;
var
  nbOct: integer;
begin
  BlockRead(fLex, Result, i, nbOct);
end;

function lire: string;
var
  longMot : byte;
  nbOct: integer;
  S: string;

begin
  BlockRead(fLex, longMot, 1, nbOct);
  SetLength(S, longMot);
  BlockRead(fLex, S[1], longMot, nbOct);
  lire := S;
end;

procedure ecrireBase;
var
  i, j, k, m, nbOct, SLong: integer;
  nLiens, nLet : byte;
  Erreur: integer;
  Moti :      string;
begin
  AssignFile(fLex, 'Lex1.bin'); //==========nouveau fichier==============================
  {$I-}
  Reset(fLex, 1);
  {$I+}
  Erreur := IOResult;
  if Erreur <> 0 then
    ReWrite(fLex, 1);
  for i := 0 to listeMots.Count - 1 do
    //champ par champ à coder (longueur)
  begin
      Moti := listeMots[i];
      ecrireMot(Moti);
      m := Form1.chercheTab(i); //présence de liens
      if m<0 then j:=0
      else j:= Length(Liens[m]);
      ecrireNombre(j, 4);
      if j>0 then
        for k:= 0 to j-1 do
            ecrireNombre(Liens[m, k], 4);
  end;
  CloseFile(fLex);
end;

procedure lireBase;
var
  i, j, k, iTab, nbOct, SLong: integer;
  Erreur: integer;

begin
  SetLength(Liens, 0);
  AssignFile(fLex, 'Lex1.bin'); //==========nouveau fichier==============================
  {$I-}
  Reset(fLex, 1);
  {$I+}
  Erreur := IOResult;
  if Erreur <> 0 then
    ReWrite(fLex, 1);
  i:=0;
  iTab :=0;
  listeMots.Clear;
  while not EOF(flex) do
  begin
    listeMots.Append(Lire);
    j := lireNombre(4);
    if j>0 then
    begin
      SetLength(Liens, Length(Liens)+1);
      SetLength(Liens[iTab], j);
      for k:=0 to j-1 do
        Liens[iTab, k] :=  lireNombre(4);
      inc(iTab);
    end;
    inc(i);
  end;

  CloseFile(fLex);
end;


procedure ecrireMot(Moti : string);
var
  longMot : byte;
  nbOct: integer;
begin
  longMot := Length(Moti);
  BlockWrite(fLex, longMot, SizeOf(longMot), nbOct);
  BlockWrite(fLex, Moti[1], longMot, nbOct);
end;



end.

Unité uDialog▲

Sélectionnez

unit uDialog;

{$mode objfpc}{$H+}

interface

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

type

  { TForm2 }

  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Choix(motNouv : string);
    procedure ListBox1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form2: TForm2;
  iProv : integer;

implementation

uses uLex11;

{ TForm2 }

procedure TForm2.Choix(motNouv: string);
var i : integer;
begin
  Label1.Caption:=AnsiToUTF8(motNouv);
  ListBox1.Clear;
  ListBox1.Items.Append(Label1.Caption);
  ListBox1.Selected[0] := True;
  iProv := -1;
  if Length(tabApprox) > 0 then
    for i:= 0 to Length(tabApprox)-1 do
      ListBox1.Items.Append(AnsiToUTF8(listeMots[tabApprox[i]]));
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  ModalResult := iProv;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
   ModalResult := -2;
end;

procedure TForm2.ListBox1Click(Sender: TObject);
begin
   Label1.Caption:= ListBox1.GetSelectedText;
   if ListBox1.ItemIndex>0 then iProv := tabApprox[ListBox1.ItemIndex-1]
   else  iProv := -1;
end;



{$R *.lfm}

end.

Projet complet▲

Pour charger les fichiers de données et l'ensemble des sources du projet, cliquez ici.

(44)

La procédure doit être déclarée à la suite des déclarations existantes ; un appui sur les touches Ctrl + Maj + C crée la structure adéquate à compléter par vos soins.

(45)

Variable de type Entier

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.