DP Tool Club 19/CD_ASCQ_19_010295.iso/dos/prg/pas/ktools/source/ofiches.pas

Pascal/Delphi Source File | 1994-11-22 | 7.9 KB | 346 lines

Unit OFiches;
{ unité créant un objet bloc-notes indexé sur des titres }
{ le bloc-notes est dans un fichier texte,
  chaque titre de fiche est précédé d'un # }
{ K.B. novembre 1994 }

INTERFACE

Uses Dos,UDrivers,
     OTableau,OTEdit,
     OEdWin,ODialWin,OGenView,OTxtView;

Const
 cmLoadEdit    = $400;
 cmBascule     = $401;
 erTabFiches   = 200;

Type PFiche=^TFiche;
     TFiche=Record
      Titre:String[40];
      Texte:PEdObj;
      end;

     PTabFiches=^TTabFiches;
     TTabFiches=object(TTabPtr)
      FileName  : String[80];
      Constructor Init;
      Constructor Load(NomDeFichier:String);
      Procedure Effacer(p:Pointer); virtual;
      Function GetErrorMsg:String; virtual;
      Procedure SauverSous(NomDeFichier:String);
      End;

     PLFWin=^TLFWin;
     TLFWin=object(TSelWin)
      TabFiches : PTabFiches;
      Constructor Init(x,y,l,h:Integer);
      Constructor Load(x,y,l,h:Integer;NomDeFichier:String);
      Destructor Done; virtual;
      Function  Ligne(n:Integer):String;virtual;
      Function  NombreItems:Integer;virtual;
      Procedure HandleEvent(Var Event:TEvent);virtual;
      Function  GetErrorMsg:String; virtual;
      Procedure AjouteFiche(Tit:String);
      Procedure InsereFiche(Tit:String);
      Procedure SupprimeFiche;
      End;

     PEdFiche=^TEdFiche;
     TEdFiche=object(TEdWin)
      Modified  : Boolean;
      Constructor Init(x,y,l,h:Integer;PF:PFiche);
      Destructor Done; virtual;
      Procedure HandleEvent(var Event:TEvent); virtual;
      End;

IMPLEMENTATION

{ objet TTabFiches }

Constructor TTabFiches.Init;
Var PF : PFiche;
Begin
 TTabPtr.Init(20,20);
 FileName:='';
 New(PF);
 PF^.Titre:='sans titre';
 PF^.Texte:=New(PEdObj,Init(25,80));
 Ajouter(PF);
End;

Constructor TTabFiches.Load(NomDeFichier:String);
Var f:Text;
    S:String;
    PF:PFiche;
    ok:Boolean;
Begin
 TTabPtr.Init(20,20);
 FileName:=NomDeFichier;
 assign(f,NomDeFichier);
 {$I-}
 reset(f);
 {$I+}
 if IOResult<>0
    then begin
          ErrorFlag:=erOpenFile;
          exit;
         end;
 PF:=nil;
 ok:=true;
 {$I-}
 readln(f,S);
 {$I+}
 if IOResult=0
    then begin
          if S[1]<>'#'
             then begin
                   ErrorFlag:=erFormatFile;
                   ok:=false;
                  end;
         end
    else begin
          ErrorFlag:=erReadFile;
          ok:=false;
         end;
 while ok and not(eof(f)) do
   begin
    if (S<>'') and (S[1]='#')
       then begin
             if PF<>nil
                then Ajouter(PF);
             New(PF);
             PF^.Titre:=copy(S,2,length(S)-1);
             PF^.Texte:=New(PEdObj,Init(25,80));
             if not EOF(f)
                then begin
                      {$I-}
                      readln(f,S);
                      {$I+}
                      if IOResult<>0
                         then begin
                               ErrorFlag:=erReadFile;
                               ok:=false;
                              end
                         else PF^.Texte^.ChangerLigne(1,S);
                     end;
            end
       else if PF<>nil
               then PF^.Texte^.AjouterLigne(S);
    {$I-}
    readln(f,S);
    {$I+}
    if IOResult<>0
       then begin
             ErrorFlag:=erReadFile;
             ok:=false;
            end;
   end;
 close(f);
 if PF<>nil
    then Ajouter(PF)
    else ErrorFlag:=erFormatFile;
End;

Procedure TTabFiches.Effacer(p:Pointer);
Var W : PFiche;
Begin
 if p=nil then exit;
 W:=PFiche(p);
 if W^.Texte<>nil
    then dispose(W^.Texte,done);
 freemem(p,sizeof(TFiche));
End;

Function TTabFiches.GetErrorMsg:String;
Begin
 case ErrorFlag of
  erOpenFile   : GetErrorMsg:='Ouverture du fichier impossible.';
  erFormatFile : GetErrorMsg:='Format de fichier incorrect.';
  erReadFile   : GetErrorMsg:='Erreur en lecture du fichier.';
  else GetErrorMsg:=TTabPtr.GetErrorMsg;
  end;
End;

Procedure TTabFiches.SauverSous(NomDeFichier:String);
Var S  : String;
    f  : Text;
    n,i : Integer;
    PF : PFiche;
Begin
 assign(f,NomDeFichier);
 {$I-}
 rewrite(f);
 {$I+}
 if IOResult<>0
    then begin
          ErrorFlag:=erOpenFile;
          exit;
         end;
 for n:=1 to NombreItems do
  begin
   Lire(PF,n);
   writeln(f,'#'+PF^.Titre);
   if (PF^.Texte=nil) or (PF^.Texte^.NombreItems=0)
      then writeln(f,'')
      else for i:=1 to PF^.Texte^.NombreItems do
             writeln(f,PF^.Texte^.Ligne(i));
  end;
 close(f);
 FileName:=NomDeFichier;
End;

{ objet TLFWin }

Constructor TLFWin.Init(x,y,l,h:Integer);
Begin
 TSelWin.Init(x,y,l,h,'NOUVEAU');
 Ident:='LISTE';
 PalOffset:=pCyan;
 Etat:=Etat and not(stOmbre);
 TabFiches:=New(PTabFiches,Init);
 if not TabFiches^.IsValid
    then ErrorFlag:=erTabFiches;
End;

Constructor TLFWin.Load(x,y,l,h:Integer;NomDeFichier:String);
Var D : DirStr;
    N : NameStr;
    E : ExtStr;
Begin
 FSplit(NomDeFichier,D,N,E);
 TSelWin.Init(x,y,l,h,N+E);
 Ident:='LISTE';
 PalOffset:=pCyan;
 Etat:=Etat and not(stOmbre);
 TabFiches:=New(PTabFiches,Load(NomDeFichier));
 if not TabFiches^.IsValid
    then ErrorFlag:=erTabFiches;
End;

Destructor TLFWin.Done;
Begin
 if TabFiches<>nil
    then dispose(TabFiches,Done);
 TSelWin.Done;
End;

Function TLFWin.GetErrorMsg:String;
Begin
 case ErrorFlag of
  erTabFiches : GetErrorMsg:=TabFiches^.GetErrorMsg;
  else GetErrorMsg:=TSelWin.GetErrorMsg;
  end;
End;

Function TLFWin.Ligne(n:Integer):String;
Var PF : PFiche;
Begin
 if (n<1) or (n>TabFiches^.NombreItems)
    then begin
          Ligne:='';
          exit;
         end;
 TabFiches^.Lire(PF,n);
 if PF<>nil
    then Ligne:=PF^.Titre
    else Ligne:='';
End;

Function TLFWin.NombreItems:Integer;
Begin
 NombreItems:=TabFiches^.NombreItems;
End;

Procedure TLFWin.AjouteFiche(Tit:String);
Var PF : PFiche;
Begin
 New(PF);
 PF^.Titre:=Tit;
 PF^.Texte:=New(PEdObj,Init(25,80));
 TabFiches^.Ajouter(PF);
 Choix:=NombreItems;
 DrawInterior;
End;

Procedure TLFWin.InsereFiche(Tit:String);
Var PF : PFiche;
Begin
 New(PF);
 PF^.Titre:=Tit;
 PF^.Texte:=New(PEdObj,Init(25,80));
 TabFiches^.Intercaler(PF,Choix);
 DrawInterior;
End;

Procedure TLFWin.SupprimeFiche;
Begin
 if NombreItems>1
    then begin
          TabFiches^.Eliminer(Choix);
          if Choix>NombreItems
             then Choix:=NombreItems;
          DrawInterior;
         end;
End;

Procedure TLFWin.HandleEvent(Var Event:TEvent);
Var E : TEvent;
Begin
 if (Event.What=evMouseLDown) and (MouseInView) and (Etat and stSelected=0)
    then Select;
 TSelWin.HandleEvent(Event);
 if ExitCode=exOk
    then begin
          ExitCode:=0;
          E.What:=evCommand;
          E.Command:=cmLoadEdit;
          TabFiches^.Lire(E.InfoPtr,Choix);
          SetEvent(E);
         end;
End;

{ objet TEdFiche }
{ éditeur de fiche }

Constructor TEdFiche.Init(x,y,l,h:Integer;PF:PFiche);
Begin
 TWindow.Init(x,y,l,h,PF^.Titre);
 Ident:='EDWIN';
 PalOffset:=pCyan;
 Etat:=Etat or stCurseur;
 Etat:=Etat and not(stOmbre);
 Modified:=false;
 EdObj:=PF^.Texte;
 EdObj^.NbLines:=h-2;
 EdObj^.NbCols:=l-2;
End;

Destructor TEdFiche.Done;
Begin
 TWindow.Done;
End;

Procedure TEdFiche.HandleEvent(var Event:TEvent);
Begin
 if not Modified
    then Modified:=EdObj^.TextChanged;
 { empêcher la fermeture héritée }
 if (Event.What=evKeyDown) and (Event.KeyCode=Echap)
    then Event.What:=evNothing;
 if (Event.What=evMouseRUp) and (Etat and stSelected<>0)
    then Event.What:=evNothing;
 { sélection à la souris }
 if (Event.What=evMouseLDown) and MouseInView and (Etat and stSelected=0)
    then begin
          SetCommand(cmBascule);
          exit;
         end;
 { gestion éditeur }
 TEdWin.HandleEvent(Event);
End;

END.

{                         Fin du Fichier OFiches.Pas                        }