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

Pascal/Delphi Source File | 1994-11-12 | 6KB | 253 lines

Program TextRead;
{ lecture de fichiers textes; utilisation de l'objet TTextFile et des
  unités de fenêtrage }
{ K.B. mai-novembre 1994 }

{.$DEFINE debug}

{$IFDEF debug}
 {$A+,B-,D+,E-,F-,I+,L+,N-,R+,S+,V-,W+,X+}
{$ELSE}
 {$A+,B-,D-,E-,F-,I+,L-,N-,R-,S-,V-,W+,X+}
{$ENDIF}

Uses Dos,
     UImprim,UMem,UDrivers,
     OGenView,OTxtView,OFileWin,ODialWin,OHelpWin;

Const
 cmInit=$300;
 cmOpen=$301;
 cmCherche=$302;
 cmDialCherche=$303;
 cmChercheEncore=$304;
 cmMenu=$305;
 cmHelp=$306;
 cmImprimer=$307;
 cmAbout=$308;

Type

 PTextReadApp=^TTextReadApp;
 TTextReadApp=object(TTextApp)
  SearchText:String[80];
  Constructor Init;
  Procedure InitStatusLine;virtual;
  Procedure HandleEvent(Var Event:TEvent);virtual;
  Procedure MakeTextWin(S:PathStr);
  Function  FindTextWin : PFileWin;
  Function InitMenu:PMenuWin;
  End;

Var MonApp:PTextReadApp;

{ objet TTextApp }

Constructor TTextReadApp.Init;
Var S:String;
Begin
 TTextApp.Init;
 Titre:='Afficheur de fichiers ASCII (KB juin 1994)';
 SearchText:='';
 if paramcount>0
    then SetCommand(cmInit);
End;

Procedure TTextReadApp.InitStatusLine;
Begin
 StatusLine:=New(PStatusLine,Init);
 with StatusLine^ do
  begin
   AjouterItem('F1 Aide',F1);
   AjouterItem('F2 Fichier',F2);
   AjouterItem('F10 Menu',F10);
   AjouterItem('AltX Quitter',AltX);
  end;
End;

Function TTextReadApp.InitMenu:PMenuWin;
Var MenuWin:PMenuWin;
Begin
 MenuWin:=New(PMenuWin,Init(10,4));
 MenuWin^.Ident:='MENU';
 if MenuWin^.IsValid
    then begin
          with MenuWin^ do
           begin
            AjouterItem('Fichier...        ',cmOpen);
            AjouterItem('Aide...           ',cmHelp);
            AjouterItem('Imprimer          ',cmImprimer);
            AjouterItem('Chercher...     F3',cmDialCherche);
            AjouterItem('Chercher encore F4',cmCherche);
            AjouterItem('A Propos...       ',cmAbout);
            AjouterItem('Quitter       AltX',cmQuit);
           end;
          InitMenu:=MenuWin;
         end
    else begin
          Message(MenuWin^.GetErrorMsg);
          dispose(MenuWin,Done);
          InitMenu:=nil;
         end;
End;

Procedure TTextReadApp.HandleEvent(Var Event:TEvent);
Var S : String;
    W : PMenuWin;
    H : PHelpWin;
    CurTextWin : PFileWin;
Begin
 TTextApp.HandleEvent(Event);
 case Event.What of
  evCommand:
   case Event.Command of
    cmInit:
      begin
       S:=ParamStr(1);
       MakeTextWin(S);
      end;
    cmOpen:
      begin
       S:=GetFile('*.*');
       if S<>''
          then begin
                ClearDeskTop;
                MakeTextWin(S);
               end;
      end;
    cmMenu:
      begin
       W:=InitMenu;
       if W<>nil
          then begin
                Insert(W);
                W^.Exec;
                dispose(W,Done);
               end;
      end;
    cmHelp:
      begin
       H:=new(PHelpWin,Init(AppPath+'textread.hlp'));
       if H^.IsValid
          then begin
                H^.Ident:='AIDE';
                Insert(H);
                H^.Exec;
                dispose(H,Done);
               end
          else begin
                Message(H^.GetErrorMsg);
                dispose(H,done);
               end;
      end;
    cmAbout:
      Message(chr(13)
              +'     T E X T R E A D   V 1.1         '+chr(13)
              +'         Kostrzewa Bruno             '+chr(13)
              +'         (novembre 1994)             '+chr(13));
    cmImprimer:
      begin
       CurTextWin:=FindTextWin;
       if CurTextWin=nil
          then Message(' Rien à imprimer !!! ')
          else begin
                if not PrinterOK
                   then Message(' Allumez l''imprimante, SVP... ');
                if not PrinterOK
                   then Message(' Imprimante hors ligne. '+chr(13)+
                                '        Abandon.        ')
                   else begin
                         Patience('Impression en cours...');
                         CurTextWin^.Imprime;
                         FinPatience;
                        end;
               end;
      end;
    cmDialCherche:
      begin
       CurTextWin:=FindTextWin;
       if CurTextWin=nil
          then Message('Pas de texte pour chercher ! ')
          else begin
                WinRead(SearchText,' Chercher ');
                if SearchText<>''
                   then SetCommand(cmCherche);
               end;
      end;
    cmCherche:
      begin
       CurTextWin:=FindTextWin;
       if CurTextWin<>nil
          then begin
                if SearchText<>''
                   then begin
                         Patience('Recherche de '+SearchText+' en cours...');
                         if not CurTextWin^.Trouve(SearchText)
                            then Message(' Recherche terminée. ')
                            else CurTextWin^.DrawInterior;
                         FinPatience;
                        end
                   else Message(' Pas de chaine à chercher ! ');
               end
          else Message(' Pas de texte pour chercher ! ');
      end;
     else exit;
   end;
  evKeyDown:
   case Event.KeyCode of
    AltI : SetCommand(cmImprimer);
      F1 : SetCommand(cmHelp);
      F2 : SetCommand(cmOpen);
      F3 : SetCommand(cmDialCherche);
      F4 : SetCommand(cmCherche);
     F10 : SetCommand(cmMenu);
     else exit;
   end;
  else exit;
 end;
 Event.What:=evNothing;
End;

Procedure TTextReadApp.MakeTextWin(S:PathStr);
Var W:PFileWin;
Begin
 if S=''
    then exit;
 Patience('Chargement en cours...');
 W:=New(PFileWin,Init(1,2,77,20,S));
 FinPatience;
 if W^.IsValid
    then begin
          Insert(W);
          W^.Show;
         end
    else begin
          Message(W^.GetErrorMsg);
          dispose(W,Done);
         end;
End;

Function TTextReadApp.FindTextWin : PFileWin;
Var W : PGenView;
Begin
 W:=FindSelect;
 if W<>nil
    then if W^.Ident<>'TEXTWIN'
            then W:=nil;
 FindTextWin:=PFileWin(W);
End;

BEGIN
 {$ifdef debug}
 initmem;
 {$endif}
 MonApp:=New(PTextReadApp,Init);
 MonApp^.Exec;
 dispose(MonApp,Done);
 {$ifdef debug}
 diagmem;
 {$endif}
END.

{                        Fin du fichier TEXTREAD.PAS                        }