home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / ktools / source / fiches.pas < prev    next >
Pascal/Delphi Source File  |  1994-11-22  |  10KB  |  388 lines
  1. Program Fiches;
  2. { Editeur de fiches }
  3. { K.B. novembre 1994 }
  4.  
  5. {.$DEFINE debug}
  6.  
  7. {$IFDEF debug}
  8.  {$A+,B-,D+,E-,F-,I+,L+,N-,R+,S+,V-,W+,X+}
  9. {$ELSE}
  10.  {$A+,B-,D-,E-,F-,I+,L-,N-,R-,S-,V-,W+,X+}
  11. {$ENDIF}
  12.  
  13. Uses Dos,UMem,UDrivers,
  14.      OGenView,OTxtView,OEdWin,OFiches,ODialWin;
  15.  
  16. Const
  17.  cmInit        = $300;
  18.  cmOpen        = $301;
  19.  cmAjouteFiche = $302;
  20.  cmInsereFiche = $303;
  21.  cmChangeTitre = $304;
  22.  cmMenu        = $305;
  23.  cmHelp        = $306;
  24.  cmImprimer    = $307;
  25.  cmAbout       = $308;
  26.  cmNouveau     = $309;
  27.  cmSupprime    = $30A;
  28.  
  29. Type
  30.  TFichesApp=object(TTextApp)
  31.   Constructor Init;
  32.   Procedure InitStatusLine;virtual;
  33.   Procedure HandleEvent(Var Event:TEvent);virtual;
  34.   Procedure ExecMenu;
  35.   Procedure LoadFile(S:String);
  36.   Procedure NewFile;
  37.   Procedure SaveFile;
  38.   Procedure ChangeTitre;
  39.   Procedure AjouteFiche(ALaFin:Boolean);
  40.   Procedure SupprimeFiche;
  41.   Procedure Bascule;
  42.   End;
  43.  
  44. Constructor TFichesApp.Init;
  45. Begin
  46.  TTextApp.Init;
  47.  Titre:='Editeur de fiches V 1.0 (K.B. 1994)';
  48.  if paramcount>0
  49.     then SetCommand(cmInit);
  50. End;
  51.  
  52. Procedure TFichesApp.InitStatusLine;
  53. Begin
  54.  TTextApp.InitStatusLine;
  55.  with StatusLine^ do
  56.   begin
  57.    AjouterItem('AltX Quitter',AltX);
  58.    AjouterItem('F2 Ouvrir',F2);
  59.    AjouterItem('F3 Sauver',F3);
  60.    AjouterItem('F4 Nouveau',F4);
  61.    AjouterItem('F5 Bascule',F5);
  62.    AjouterItem('F10 Menu',F10);
  63.   end;
  64. End;
  65.  
  66. Procedure TFichesApp.ExecMenu;
  67. Var MenuWin:PMenuWin;
  68. Begin
  69.  MenuWin:=New(PMenuWin,Init(10,4));
  70.  MenuWin^.Ident:='MENU';
  71.  if MenuWin^.IsValid
  72.     then begin
  73.           with MenuWin^ do
  74.            begin
  75.             AjouterItem('Aide                      F1',cmHelp);
  76.             AjouterItem('Fichier...                F2',cmOpen);
  77.             AjouterItem('Sauver                    F3',cmSave);
  78.             AjouterItem('Ajouter une fiche...      F4',cmAjouteFiche);
  79.             AjouterItem('Insérer une fiche...   Alt-I',cmInsereFiche);
  80.             AjouterItem('Supprimer une fiche... Alt-D',cmSupprime);
  81.             AjouterItem('Changer le titre...    Alt-T',cmChangeTitre);
  82.             AjouterItem('Nouveau fichier             ',cmNouveau);
  83.             AjouterItem('A Propos...            Alt-A',cmAbout);
  84.             AjouterItem('Quitter                Alt-X',cmQuit);
  85.            end;
  86.           Insert(MenuWin);
  87.           MenuWin^.Exec;
  88.          end
  89.     else Message(MenuWin^.GetErrorMsg);
  90.  dispose(MenuWin,Done);
  91. End;
  92.  
  93. Procedure TFichesApp.LoadFile(S:String);
  94. Var SelWin   : PLFWin;
  95.     FicheWin : PEdFiche;
  96.     PF       : PFiche;
  97. Begin
  98.  ClearDeskTop;
  99.  Patience('Chargement en cours ...');
  100.  SelWin:=New(PLFWin,Load(0,1,20,23,S));
  101.  if SelWin^.IsValid
  102.     then begin
  103.           Insert(SelWin);
  104.           SelWin^.Show;
  105.           SelWin^.TabFiches^.Lire(PF,1);
  106.           FicheWin:=New(PEdFiche,Init(20,1,60,23,PF));
  107.           Insert(FicheWin);
  108.           FicheWin^.Show;
  109.          end
  110.     else begin
  111.           Message(SelWin^.GetErrorMsg);
  112.           dispose(SelWin,Done);
  113.          end;
  114.  FinPatience;
  115. End;
  116.  
  117. Procedure TFichesApp.NewFile;
  118. Var SelWin   : PLFWin;
  119.     FicheWin : PEdFiche;
  120.     PF       : PFiche;
  121. Begin
  122.  ClearDeskTop;
  123.  SelWin:=New(PLFWin,Init(0,1,20,23));
  124.  if SelWin^.IsValid
  125.     then begin
  126.           Insert(SelWin);
  127.           SelWin^.Show;
  128.           SelWin^.TabFiches^.Lire(PF,1);
  129.           FicheWin:=New(PEdFiche,Init(20,1,60,23,PF));
  130.           Insert(FicheWin);
  131.           FicheWin^.Show;
  132.          end
  133.     else begin
  134.           Message(SelWin^.GetErrorMsg);
  135.           dispose(SelWin,Done);
  136.          end;
  137. End;
  138.  
  139. Procedure TFichesApp.SaveFile;
  140. Var S : String;
  141.     W : PLFWin;
  142.     D : DirStr;
  143.     N : NameStr;
  144.     E : ExtStr;
  145.     p : Byte;
  146.     WE : PEdFiche;
  147. Begin
  148.  W:=PLFWin(Find('LISTE'));
  149.  if W=nil
  150.     then exit;
  151.  if W^.TabFiches^.FileName<>''
  152.     then begin
  153.           Patience('Sauvegarde en cours...');
  154.           W^.TabFiches^.SauverSous(W^.TabFiches^.FileName);
  155.           FinPatience;
  156.          end
  157.     else begin
  158.           S:='';
  159.           WinRead(S,'Nom du fichier à sauver');
  160.           if S<>''
  161.              then begin
  162.                    Majuscule(S);
  163.                    p:=pos('.',S);
  164.                    if p=0
  165.                       then S:=S+'.BNT';
  166.                    Patience('Sauvegarde en cours...');
  167.                    W^.TabFiches^.SauverSous(S);
  168.                    FinPatience;
  169.                    if not W^.TabFiches^.IsValid
  170.                       then begin
  171.                             Message(W^.TabFiches^.GetErrorMsg);
  172.                             W^.TabFiches^.ErrorFlag:=0;
  173.                            end
  174.                       else begin
  175.                             FSplit(S,D,N,E);
  176.                             W^.ChangeTitre(N+E);
  177.                            end;
  178.                   end;
  179.          end;
  180.  WE:=PEdFiche(Find('EDWIN'));
  181.  if WE<>nil
  182.     then WE^.Modified:=false;
  183. End;
  184.  
  185. Procedure TFichesApp.ChangeTitre;
  186. Var W  : PLFWin;
  187.     E  : TEvent;
  188.     S  : String;
  189.     PF : PFiche;
  190.     WE : PEdFiche;
  191. Begin
  192.  W:=PLFWin(Find('LISTE'));
  193.  if W=nil
  194.     then exit;
  195.  W^.TabFiches^.Lire(PF,W^.Choix);
  196.  S:=PF^.Titre;
  197.  WinRead(S,'Nouveau titre');
  198.  if S<>''
  199.     then begin
  200.           PF^.Titre:=S;
  201.           W^.DrawInterior;
  202.           WE:=PEdFiche(Find('EDWIN'));
  203.           if WE<>nil
  204.              then WE^.Modified:=true;
  205.           E.What:=evCommand;
  206.           E.Command:=cmLoadEdit;
  207.           W^.TabFiches^.Lire(E.InfoPtr,W^.Choix);
  208.           SetEvent(E);
  209.          end;
  210. End;
  211.  
  212. Procedure TFichesApp.AjouteFiche(ALaFin:Boolean);
  213. Var S  : String;
  214.     W  : PLFWin;
  215.     E  : TEvent;
  216.     WE : PEdFiche;
  217. Begin
  218.  W:=PLFWin(Find('LISTE'));
  219.  if W=nil
  220.     then exit;
  221.  S:='';
  222.  WinRead(S,'Titre de la nouvelle fiche');
  223.  if S<>''
  224.     then begin
  225.           if ALaFin
  226.              then W^.AjouteFiche(S)
  227.              else W^.InsereFiche(S);
  228.           WE:=PEdFiche(Find('EDWIN'));
  229.           if WE<>nil
  230.              then WE^.Modified:=true;
  231.           E.What:=evCommand;
  232.           E.Command:=cmLoadEdit;
  233.           W^.TabFiches^.Lire(E.InfoPtr,W^.Choix);
  234.           SetEvent(E);
  235.          end;
  236. End;
  237.  
  238. Procedure TFichesApp.SupprimeFiche;
  239. Var S  : String;
  240.     W  : PLFWin;
  241.     E  : TEvent;
  242.     WE : PEdFiche;
  243. Begin
  244.  W:=PLFWin(Find('LISTE'));
  245.  if W=nil
  246.     then exit;
  247.  S:='';
  248.  WinRead(S,'Supprimer cette fiche ?');
  249.  Majuscule(S);
  250.  if S='OUI'
  251.     then begin
  252.           W^.SupprimeFiche;
  253.           WE:=PEdFiche(Find('EDWIN'));
  254.           if WE<>nil
  255.              then WE^.Modified:=true;
  256.           E.What:=evCommand;
  257.           E.Command:=cmLoadEdit;
  258.           W^.TabFiches^.Lire(E.InfoPtr,W^.Choix);
  259.           SetEvent(E);
  260.          end;
  261. End;
  262.  
  263. Procedure TFichesApp.Bascule;
  264. Var W : PGenView;
  265.     L : PLFWin;
  266.     E : TEvent;
  267. Begin
  268.  W:=FindSelect;
  269.  if W=nil
  270.     then exit;
  271.  if W^.Ident='LISTE'
  272.     then begin
  273.           L:=PLFWin(W);
  274.           E.What:=evCommand;
  275.           E.Command:=cmLoadEdit;
  276.           L^.TabFiches^.Lire(E.InfoPtr,L^.Choix);
  277.           SetEvent(E);
  278.          end;
  279.  if W^.Ident='EDWIN'
  280.     then if W^.Prec<>nil
  281.             then W^.Prec^.Select;
  282. End;
  283.  
  284. Procedure TFichesApp.HandleEvent(Var Event:TEvent);
  285. Var FicheWin : PEdFiche;
  286.     PF       : PFiche;
  287.     S        : String;
  288.     Menu     : PMenuWin;
  289. Begin
  290.  if (Event.What=evCommand) and (Event.Command=cmClose)
  291.     then begin
  292.           FicheWin:=PEdFiche(Find('EDWIN'));
  293.           if (FicheWin<>nil) and (FicheWin^.Modified=true)
  294.              then SaveFile;
  295.           ClearDeskTop;
  296.           exit;
  297.          end;
  298.  TTextApp.HandleEvent(Event);
  299.  case Event.What of
  300.   evCommand:
  301.     case Event.Command of
  302.      cmLoadEdit :
  303.        begin
  304.         PF:=PFiche(Event.InfoPtr);
  305.         FicheWin:=PEdFiche(Find('EDWIN'));
  306.         if FicheWin<>nil
  307.            then begin
  308.                  FicheWin^.ChangeTitre(PF^.Titre);
  309.                  FicheWin^.EdObj:=PF^.Texte;
  310.                  FicheWin^.EdObj^.NbCols:=FicheWin^.Largeur;
  311.                  FicheWin^.EdObj^.NbLines:=FicheWin^.Hauteur;
  312.                  FicheWin^.DrawInterior;
  313.                  FicheWin^.Select;
  314.                 end
  315.            else begin
  316.                  FicheWin:=New(PEdFiche,Init(20,1,60,23,PF));
  317.                  Insert(FicheWin);
  318.                  FicheWin^.Show;
  319.                 end;
  320.        end;
  321.      cmOpen:
  322.        begin
  323.         FicheWin:=PEdFiche(Find('EDWIN'));
  324.         if (FicheWin<>nil) and (FicheWin^.Modified=true)
  325.            then SaveFile;
  326.         S:=GetFile('*.BNT');
  327.         if S<>''
  328.            then LoadFile(S);
  329.        end;
  330.      cmInit    : LoadFile(ParamStr(1));
  331.      cmMenu    : ExecMenu;
  332.      cmNouveau : begin
  333.                   FicheWin:=PEdFiche(Find('EDWIN'));
  334.                   if FicheWin^.Modified=true
  335.                      then SaveFile;
  336.                   NewFile;
  337.                  end;
  338.      cmSave    : SaveFile;
  339.      cmChangeTitre : ChangeTitre;
  340.      cmAjouteFiche : AjouteFiche(true);
  341.      cmInsereFiche : AjouteFiche(false);
  342.      cmSupprime    : SupprimeFiche;
  343.      cmBascule     : Bascule;
  344.      cmAbout:
  345.         Message(chr(13)+
  346.                  '      Editeur de Fiches        '+chr(13)+
  347.                  '        Version 1.0            '+chr(13)+
  348.                  '    Kostrzewa Bruno (1994)     '+chr(13));
  349.      else exit;
  350.      end;
  351.   evKeyDown:
  352.     case Event.KeyCode of
  353.      F1:   SetCommand(cmHelp);
  354.      F2:   SetCommand(cmOpen);
  355.      F3:   SetCommand(cmSave);
  356.      F4:   SetCommand(cmAjouteFiche);
  357.      F5:   SetCommand(cmBascule);
  358.      F10:  SetCommand(cmMenu);
  359.      AltN: SetCommand(cmAjouteFiche);
  360.      AltT: SetCommand(cmChangeTitre);
  361.      AltA: SetCommand(cmAbout);
  362.      AltD: SetCommand(cmSupprime);
  363.      AltI: SetCommand(cmInsereFiche);
  364.      else exit;
  365.     end;
  366.   else exit;
  367.   end;
  368.  Event.What:=evNothing;
  369. End;
  370.  
  371. Var MonApp:TFichesApp;
  372.  
  373. BEGIN
  374.  {$ifdef debug}
  375.  initmem;
  376.  {$endif}
  377.  MonApp.Init;
  378.  if MonApp.IsValid
  379.     then MonApp.Exec
  380.     else QuitMsg:=MonApp.GetErrorMsg;
  381.  MonApp.Done;
  382.  {$ifdef debug}
  383.  diagmem;
  384.  {$endif}
  385. END.
  386.  
  387. {                         Fin du fichier Fiches.Pas                         }
  388.