home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 19
/
CD_ASCQ_19_010295.iso
/
dos
/
prg
/
pas
/
ktools
/
source
/
ofiches.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-11-22
|
8KB
|
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 }