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

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

Program WriRead;
{ lecture de fichiers *.WRI produits par Write pour Windows;
  utilisation de l'objet TTextFile et des unités de fenêtrage }
{ KB août-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,Printer,
     UMem,UDrivers,
     OGenView,OTxtView,ODialWin,OHelpWin,OFWrite;

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

 erFile       = 10;
 NbSpCar      = 26;

 TableASCII:String[NbSpCar] =
   'àâäéèêëîïôöùûüç²°─Éǽ¼«»º ' ;
 TableANSI:String[NbSpCar] =
   #224#226#228#233#232#234#235#238#239#244#246#249#251#252#231+
   #178#176#151#201#199#189#188#171#187#186#9;

Type
 PSelWriWin=^TSelWriWin;
 TSelWriWin=object(TDirWin)
  Constructor Init;
  Procedure HandleEvent(Var Event:TEvent); virtual;
  End;

 PWriWin=^TWriWin;
 TWriWin=object(TWindow)
  Fichier  : PWriFile;
  Ligne1   : Integer;
  Marge    : Integer;
  Constructor Init(xi,yi,xf,yf:Byte;NomFichier:PathStr);
  Destructor Done;virtual;
  Function  GetErrorMsg:String;virtual;
  Procedure HandleEvent(Var Event:TEvent);virtual;
  Procedure DrawInterior;virtual;
  Procedure Scroll(x,y:integer);
  Function  Trouve(S:String):Boolean;
  Procedure Imprime;
  End;

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

Procedure StrAnsiToAsci(Var S:String);
Var i,l:Byte;
Begin
 For i:=1 to length(S) do
  begin
   l:=pos(S[i],TableAnsi);
   if l<>0
      then S[i]:=TableASCII[l];
  end;
End;

Procedure StrAsciToAnsi(Var S:String);
Var i,l:Byte;
Begin
 For i:=1 to length(S) do
  begin
   l:=pos(S[i],TableASCII);
   if l<>0
      then S[i]:=TableANSI[l];
  end;
End;

Function PrinterOK: boolean;
{ Vérifie si l'imprimante est prête et transmet le résultat True ou False. }
Var Reg:registers;
Begin
 Reg.ax:=$0200;
 Reg.dx:=0;
 intr($17,Reg);
 if Reg.ah=144
    then PrinterOk:=True
    else PrinterOk:=False;
End;

{ Objet TSelWriWin }

Constructor TSelWriWin.Init;
Begin
 TDirWin.Init(1,2,19,'*.WRI');
End;

Procedure TSelWriWin.HandleEvent(Var Event:TEvent);
Begin
 TDirWin.HandleEvent(Event);
 if ExitCode=exOk
    then begin
          ExitCode:=0;
          SetCommand(cmOpen);
         end;
End;

{ Objet TWriWin }

Constructor TWriWin.Init(xi,yi,xf,yf:Byte;NomFichier:PathStr);
Var D:DirStr;
    N:NameStr;
    E:ExtStr;
    t:Word;
Begin
 TWindow.Init(xi,yi,xf,yf,'');
 Ident:='WRIWIN';
 Marge:=1;
 Ligne1:=1;
 Fichier:=new(PWriFile,Init(NomFichier));
 if not Fichier^.IsValid
    then begin
          ErrorFlag:=erFile;
          exit;
         end;
 FSplit(FExpand(Nomfichier),D,N,E);
 Titre:=N+E;
End;

Destructor TWriWin.Done;
Begin
 dispose(Fichier,Done);
 TWindow.Done;
End;

Function TWriWin.GetErrorMsg:String;
Begin
 case ErrorFlag of
  erFile    : GetErrorMsg:=Fichier^.GetErrorMsg;
  else GetErrorMsg:=TWindow.GetErrorMsg;
  end;
End;

Procedure TWriWin.DrawInterior;
Var n:Word;
    S:String;
Begin
 for n:=Ligne1 to Ligne1+Hauteur-1 do
  begin
   S:=Fichier^.DonneLigne(n);
   if length(S)>Marge
      then s:=copy(s,Marge,length(s)-Marge+1)
      else s:='';
   Ajuste(S,Largeur);
   StrAnsiToAsci(S);
   Ecrire(S,1,n-Ligne1+1,0);
  end;
End;

Procedure TWriWin.Scroll(x,y:integer);
Var p : LongInt;
Begin
 if x<>0  { déplacement horizontal }
    then begin
          Marge:=Marge+x;
          if Marge>Largeur then Marge:=Largeur;
          if Marge<1 then Marge:=1;
         end;
 if y<>0  { déplacement vertical }
    then begin
          Ligne1:=Ligne1+y;
          if Ligne1<1 then Ligne1:=1;
          Fichier^.TabLigne.Lire(p,Fichier^.TabLigne.NombreItems);
          if (p>=Fichier^.PosFin) and (Ligne1>Fichier^.TabLigne.NombreItems)
             then Ligne1:=Fichier^.TabLigne.NombreItems;
         end;
End;

Procedure TWriWin.HandleEvent(Var Event:TEvent);
Begin
 TWindow.HandleEvent(Event);
 case Event.What of
  evMouseAuto:
    begin
     if Event.LButton and SurCadre(Event.Where)
        then begin
              if Event.Where.Y>Origin.Y+hauteur div 2
                 then scroll(0,1)
                 else scroll(0,-1);
             end
        else exit;
    end;
  evKeyDown:
   case Event.KeyCode of
    csdn:scroll(0,1);
    csup:scroll(0,-1);
    pgdn:scroll(0,Hauteur);
    pgup:scroll(0,-Hauteur);
    csrg:scroll(1,0);
    cslf:scroll(-1,0);
    home:Marge:=1;
    cpgup: Ligne1:=1;
    cpgdn: begin
            Ligne1:=Fichier^.NumLigne(Fichier^.PosFin)-Hauteur+1;
            if Ligne1<1 then Ligne1:=1;
           end;
    else exit;
   end;
  else exit;
  end;
 DrawInterior;
 Event.What:=evNothing;
End;

Function TWriWin.Trouve(S:String):Boolean;
Var p  : LongInt;
Begin
 StrAsciToAnsi(S);
 p:=Fichier^.PosLigne(Ligne1+1);
 Fichier^.SetFilePosit(p);
 if Fichier^.Find(S)
    then begin
          Ligne1:=Fichier^.NumLigne(Fichier^.GetFilePosit);
          Trouve:=true;
         end
    else Trouve:=false;
End;

Procedure TWriWin.Imprime;
Var  UneLigne: string;
     k:Integer;
     p:LongInt;
Begin
 writeln(LST,'');
 with Fichier^ do
  UneLigne:='   '+FDir+FName+FExt;
 writeln(LST,UneLigne);
 write(LST,'   ');
 For k:=1 to length(UneLigne)-3 do
  write(LST,'─');
 writeln(LST,'');
 writeln(LST,'');
 k:=1;
 repeat
  p:=Fichier^.PosLigne(k);
  UneLigne:=Fichier^.DonneLigne(k);
  StrAnsiToAsci(UneLigne);
  writeln(LST,'   '+UneLigne);
  inc(k);
 until p>=Fichier^.PosFin;
 write(LST,#12);
End;

{ objet TWriApp }

Constructor TWriApp.Init;
Var S:String;
Begin
 TTextApp.Init;
 Titre:='Afficheur de fichiers WRITE';
 SearchText:='';
 if paramcount>0
    then SetCommand(cmInit)
    else SetCommand(cmFile);
End;

Procedure TWriApp.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 TWriApp.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...        ',cmFile);
            AjouterItem('Aide...         F1',cmHelp);
            AjouterItem('Imprimer      AltI',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 TWriApp.MakeTextWin(S:PathStr);
Var W:PWriWin;
Begin
 if S=''
    then exit;
 Patience('Chargement en cours...');
 W:=New(PWriWin,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;

Procedure TWriApp.HandleEvent(Var Event:TEvent);
Var S : String;
    W : PMenuWin;
    H : PHelpWin;
    CurWin : PGenView;
    FileSelector : PDirWin;
Begin
 TTextApp.HandleEvent(Event);
 case Event.What of
  evCommand:
   case Event.Command of
    cmInit: MakeTextWin(ParamStr(1));
    cmOpen:
      begin
       FileSelector:=PDirWin(Event.InfoPtr);
       MakeTextWin(FileSelector^.FichierChoisi);
      end;
    cmFile:
      begin
       ClearDeskTop;
       FileSelector:=New(PSelWriWin,Init);
       FileSelector^.Ident:='FICHIERS';
       Insert(FileSelector);
       FileSelector^.Show;
      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+'wriread.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)
              +'      W R I R E A D   V 1.2          '+chr(13)
              +'         Kostrzewa Bruno             '+chr(13)
              +'         (novembre 1994)             '+chr(13));
    cmImprimer:
      begin
       CurWin:=FindSelect;
       if (CurWin=nil) or (CurWin^.Ident<>'WRIWIN')
          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...');
                         PWriWin(CurWin)^.Imprime;
                         FinPatience;
                        end;
               end;
      end;
    cmDialCherche:
      begin
       CurWin:=FindSelect;
       if (CurWin<>nil) and (CurWin^.Ident='WRIWIN')
          then begin
                WinRead(SearchText,' Chercher ');
                if SearchText<>''
                   then SetCommand(cmCherche);
               end
          else Message(' Pas de texte pour chercher ! ');
      end;
    cmCherche:
      begin
       CurWin:=FindSelect;
       if (CurWin<>nil) and (CurWin^.Ident='WRIWIN')
          then begin
                if SearchText<>''
                   then begin
                         Patience('Recherche de '+SearchText+' en cours...');
                         if not PWriWin(CurWin)^.Trouve(SearchText)
                            then Message(' Recherche terminée. ')
                            else PWriWin(CurWin)^.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(cmFile);
      F3 : SetCommand(cmDialCherche);
      F4 : SetCommand(cmCherche);
     ord('?') : SetCommand(cmAbout);
     F10 : SetCommand(cmMenu);
     else exit;
   end;
  else exit;
 end;
 Event.What:=evNothing;
End;

Var MonApp:PWriApp;

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

{                         Fin du fichier WRIREAD.PAS                        }