Il s'agit de montrer un exemple de gestion de fichier pour comprendre comment ça marche. Cet exemple est basé sur une collection de timbres mais pourra facilement être adapté à tout autre type d'objets (y compris des oiseaux, des livres, des diapos etc ...).

Le projet se compose de 3 fiches :

• La fiche principale qui montre la liste des timbres et plusieurs boutons :

  
• La fiche qui s'ouvre lorsqu'on clique sur le bouton Nouveau
  :
• Enfin, la fiche qui s'ouvre lorsqu'on clique sur le bouton Voir de la fiche principale :
  

Cette dernière fiche ressemble beaucoup à la fiche qui permet de créer un nouveau timbre mais les boutons sont différents car ils permettent de naviguer d'un timbre à un autre dans la collection.

unit uCollection;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, FileCtrl;

type
   TfmCollection = class(TForm)
      ListeTimbres: TListBox;
      btVoir: TButton;
      btQuitter: TButton;
      btSupprimer: TButton;
      btNouveau: TButton;
      procedure FormCreate(Sender: TObject);
      procedure FormActivate(Sender: TObject);
      procedure btQuitterClick(Sender: TObject);
      procedure btNouveauClick(Sender: TObject);
      procedure btSupprimerClick(Sender: TObject);
      procedure btVoirClick(Sender: TObject);
   private
      { Déclarations privées }
   public
      { Déclarations publiques }
      procedure AfficherListe;
   end;

   TCategorie = (paysage, portrait, sport, animal, peinture, celebrite);
   TTimbre = Record
               Code : string[8]; //code du timbre formé de 8 caractères
               pays : string[20]; //pays émetteur du timbre
               annee : string[4]; //année de fabrication du timbre
               valeur : real; //valeur indiquée sur le timbre
               largeur,hauteur : integer; //dimensions du timbre
               Categorie : TCategorie; //catégorie du timbre
               Obliteration : boolean; //vrai si le timbre est oblitéré
             end;

var
   fmCollection: TfmCollection;
   FichierTimbres : File of TTimbre;

implementation

uses uNouveauTimbre, uTimbre;

{$R *.DFM}

procedure TfmCollection.FormCreate(Sender: TObject);
begin
   //création du répertoire s'il n'existe pas déjà.
   if not DirectoryExists('C:\collection') then mkDir('C:\collection');

   //création du fichier contenant la collection de timbres s'il n'existe pas encore
   if not FileExists('c:\collection\timbres') then
   begin
      AssignFile(FichierTimbres,'c:\collection\timbres');
      Rewrite(FichierTimbres);
      CloseFile(FichierTimbres);
   end;
end;

procedure TfmCollection.AfficherListe;
var Timbre : TTimbre;
ch : string;
begin
   AssignFile(FichierTimbres,'c:\collection\timbres');
   Reset(FichierTimbres); //ouverture du fichier des timbres
   ListeTimbres.Clear; //effacement de la liste affichée sur l'écran
   while not eof(FichierTimbres) do {tant qu'on n'est pas arrivé à la fin du fichier}
   begin
      read(FichierTimbres,Timbre); //on charge le timbre suivant
      ch:=Timbre.code+','+
      Timbre.pays+','+
      Timbre.annee+',';
      case Timbre.Categorie of
         portrait : ch:=ch+'portrait';
         paysage : ch:=ch+'paysage';
         sport : ch:=ch+'sport';
         animal : ch:=ch+'animal';
         peinture : ch:=ch+'peinture';
         celebrite: ch:=ch+'célébrité';
      end;
      ListeTimbres.Items.Add(ch); //on ajoute le timbre dans la liste affichée
   end;
   CloseFile(FichierTimbres);
end;

procedure TfmCollection.FormActivate(Sender: TObject);
begin
   AfficherListe;
end;

procedure TfmCollection.btQuitterClick(Sender: TObject);
begin
   close;
end;

procedure TfmCollection.btNouveauClick(Sender: TObject);
var NouveauTimbre : TTimbre;
begin
   with fmNouveauTimbre do
      if ShowModal=mrOK then
      begin
         NouveauTimbre.Code:=edCode.Text;
         NouveauTimbre.pays:=edPays.Text;
         NouveauTimbre.annee:=edAnnee.Text;
         NouveauTimbre.valeur:=StrToFloat(edValeur.text);
         NouveauTimbre.largeur:=StrToInt(edLargeur.text);
         NouveauTimbre.hauteur:=StrToInt(edHauteur.text);
         NouveauTimbre.Categorie:=TCategorie(cbCategorie.ItemIndex);
         NouveauTimbre.Obliteration:=rgOblitere.ItemIndex=0;
         AssignFile(FichierTimbres,'c:\collection\timbres');
         Reset(FichierTimbres); //ouverture du fichier des timbres
         Seek(FichierTimbres,FileSize(FichierTimbres));
         Write(FichierTimbres,NouveauTimbre);
         CloseFile(FichierTimbres);
         AfficherListe;
      end;
end;

procedure TfmCollection.btSupprimerClick(Sender: TObject);
var NouveauFichier : File of TTimbre;
    Timbre : TTimbre;
    i,n : integer;
begin
   n:=ListeTimbres.ItemIndex; //n est le n° du timbre qu'on veut supprimer
   if MessageDlg('Attention ! Vous allez supprimer le timbre de la collection :'
      +chr(13)+ListeTimbres.Items[n],mtWarning,[mbOk,mbCancel],0)=mrOK then
   begin
      assignFile(FichierTimbres,'c:\collection\timbres');
      reset(FichierTimbres); //ouverture en lecture
      assignFile(NouveauFichier,'c:\collection\timbres.tmp');
      rewrite(NouveauFichier); //ouverture en écriture
      for i:=0 to FileSize(FichierTimbres)-1 do
      begin
         read(FichierTimbres,Timbre); //lecture du timbre n° i
         //écriture du timbre i sauf si c'est celui qu'on veut supprimer (n)
        if i<>n then write(NouveauFichier,Timbre);
      end;
      CloseFile(FichierTimbres); //fermeture de l'ancien fichier
      CloseFile(NouveauFichier); //fermeture du nouveau fichier
      erase(FichierTimbres); //effacement du disque de l'ancien fichier
      rename(NouveauFichier,'c:\collection\timbres'); {on renomme le nouveau fichier}
      AfficherListe; //mise à jour de la liste affichée
   end;
end;

procedure TfmCollection.btVoirClick(Sender: TObject);
var Timbre : TTimbre;
    n : integer;
begin
   n:=ListeTimbres.ItemIndex;
   with fmTimbre do
   begin
      AssignFile(FichierTimbres,'c:\collection\timbres');
      Reset(FichierTimbres); //ouverture du fichier des timbres
      Seek(FichierTimbres,n);
      read(FichierTimbres,timbre);
      CloseFile(FichierTimbres);
      edCode.Text:=Timbre.Code;
      edPays.Text:=Timbre.pays;
      edAnnee.Text:=Timbre.annee;
      edValeur.Text:=FloatToStrF(Timbre.valeur,ffGeneral,2,4);
      edLargeur.Text:=IntToStr(Timbre.largeur);
      edHauteur.Text:=IntToStr(Timbre.hauteur);
      cbCategorie.ItemIndex:=ord(Timbre.categorie);
      if Timbre.Obliteration then rgOblitere.ItemIndex:=0;
      ShowModal;
   end;
end;

end.

Le code ci-dessous ne contient que du texte créé par Delphi au fur et à mesure qu'on ajoute des composants dans la fiche. Il n'y a donc pas besoin,normalement, d'ajouter manuellement quoi que ce soit.

unit uNouveauTimbre;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ExtCtrls;

type
   TfmNouveauTimbre = class(TForm)
      ImageTimbre: TImage;
      LabelCode: TLabel;
      edCode: TEdit;
      Label1: TLabel;
      edPays: TEdit;
      Label2: TLabel;
      edAnnee: TEdit;
      Label3: TLabel;
      edValeur: TEdit;
      Label4: TLabel;
      edLargeur: TEdit;
      edHauteur: TEdit;
      Label5: TLabel;
      rgOblitere: TRadioGroup;
      Label6: TLabel;
      cbCategorie: TComboBox;
      btEnregistrer: TButton;
      btAnnuler: TButton;
private
   { Déclarations privées }
public
   { Déclarations publiques }
end;

var
   fmNouveauTimbre: TfmNouveauTimbre;

implementation

{$R *.DFM}

end.

Le code ci-dessous n'est pas complet. En particulier le bouton " Enregistrer " n'est pas du tout géré. Il devrait être utilisable pour modifier un timbre déjà présent dans la collection mais pour lequel on a apporté des modifications.

unit uTimbre;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ExtCtrls;

type
   TfmTimbre = class(TForm)
      ImageTimbre: TImage;
      LabelCode: TLabel;
      edCode: TEdit;
      Label1: TLabel;
      edPays: TEdit;
      Label2: TLabel;
      edAnnee: TEdit;
      Label3: TLabel;
      edValeur: TEdit;
      Label4: TLabel;
      edLargeur: TEdit;
      edHauteur: TEdit;
      Label5: TLabel;
      rgOblitere: TRadioGroup;
      Label6: TLabel;
      cbCategorie: TComboBox;
      btPrecedent: TButton;
      btSuivant: TButton;
      btFermer: TButton;
      btEnregistrer: TButton;
      procedure btFermerClick(Sender: TObject);
      procedure btSuivantClick(Sender: TObject);
      procedure btPrecedentClick(Sender: TObject);
   private
      { Déclarations privées }
   public
      { Déclarations publiques }
end;

var
   fmTimbre: TfmTimbre;

implementation

uses uCollection;

{$R *.DFM}

procedure TfmTimbre.btFermerClick(Sender: TObject);
begin
   Close;
end;

procedure TfmTimbre.btSuivantClick(Sender: TObject);
var Timbre : TTimbre;
begin
   AssignFile(FichierTimbres,'c:\collection\timbres');
   reset(FichierTimbres);
   repeat
      read(FichierTimbres,timbre);
   until Timbre.code=edCode.text;
   if not eof(FichierTimbres) then read(FichierTimbres,Timbre);
   edCode.Text:=Timbre.Code;
   edPays.Text:=Timbre.pays;
   edAnnee.Text:=Timbre.annee;
   edValeur.Text:=FloatToStrF(Timbre.valeur,ffGeneral,2,4);
   edLargeur.Text:=IntToStr(Timbre.largeur);
   edHauteur.Text:=IntToStr(Timbre.hauteur);
   cbCategorie.ItemIndex:=ord(Timbre.categorie);
   if Timbre.Obliteration then rgOblitere.ItemIndex:=0;
   CloseFile(FichierTimbres);
end;

procedure TfmTimbre.btPrecedentClick(Sender: TObject);
var n      : integer; //position du timbre dans le fichier
    Timbre : TTimbre;
begin
   AssignFile(FichierTimbres,'c:\collection\timbres');
   reset(FichierTimbres);
   repeat
   read(FichierTimbres,timbre);
   until Timbre.code=edCode.text;
   if FilePos(FichierTimbres)>1 then n:=FilePos(FichierTimbres)-2
                                else n:=0;
   seek(FichierTimbres,n);
   read(FichierTimbres,Timbre);
   edCode.Text:=Timbre.Code;
   edPays.Text:=Timbre.pays;
   edAnnee.Text:=Timbre.annee;
   edValeur.Text:=FloatToStrF(Timbre.valeur,ffGeneral,2,4);
   edLargeur.Text:=IntToStr(Timbre.largeur);
   edHauteur.Text:=IntToStr(Timbre.hauteur);
   cbCategorie.ItemIndex:=ord(Timbre.categorie);
   if Timbre.Obliteration then rgOblitere.ItemIndex:=0;
   CloseFile(FichierTimbres);
end;

end.

Dans le cas d'une collection de timbres comme ici, on aura sûrement besoin de créer, pour chaque timbre, un fichier image qui pourra être visualisé. Ce fichier image devrait porter comme nom le code du timbre suivi de l'extension jpg (par exemple). De même, on peut envisager de créer un fichier commentaire (texte) associé à chaque timbre ...