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

Pascal/Delphi Source File | 1994-11-16 | 14KB | 645 lines

Unit ODialWin;
{ Unité définissant :
  - 2 fenêtres de dialogue : une fenêtre de message et une
  fenêtre de lecture d'une chaine de caractères.
  - des fenêtres de sélection }
{ KB mai-novembre 1994 }

{$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}

INTERFACE

Uses Dos,UDrivers,UTextScr,
     OChamp,OTableau,OFDirTab,
     OGenView,OTxtView;

Const
 erMenuItems=200;
 erDirTab=201;

Type
 TStr12=String[12];
 TStr30=String[30];
 TStr80=String[80];

 PMessageWin=^TMessageWin;
 TMessageWin=object(TWindow)
  Txt:String;
  Constructor Init(Msg:String);
  Procedure DrawInterior;virtual;
  Procedure HandleEvent(Var Event:TEvent);virtual;
  End;

 PDialWin=^TDialWin;
 TDialWin=object(TWindow)
  Champ:PChamp;
  Constructor Init(l:Integer;Tit:TStr30);
  Destructor Done;virtual;
  Procedure DrawInterior;virtual;
  Procedure Select; virtual;
  Procedure HandleEvent(Var Event:TEvent);virtual;
  Procedure SetData(Var Rec);virtual;
  Procedure GetData(Var Rec);virtual;
  Function DataSize:Integer;virtual;
  End;

 PPassWordWin=^TPassWordWin;
 TPassWordWin=object(TWindow)
  Mot:TStr12;
  MotDePasse:TStr12;
  XPos:Byte;
  Constructor Init(M:TStr12);
  Procedure HandleEvent(Var Event:TEvent);virtual;
  Procedure DrawInterior;virtual;
  Function IsOk:Boolean;
  End;

 PSelWin=^TSelWin;
 TSelWin=object(TWindow)
  Choix:Integer;
  L1:Integer;
  Constructor Init(x,y,l,h:Integer;T:String);
  Function Ligne(n:Integer):String;virtual;
  Function NombreItems:Integer;virtual;
  Procedure Avancer(n:Integer);
  Function DonneChoix:Integer;
  Procedure DrawInterior;virtual;
  Procedure HandleEvent(Var Event:TEvent);virtual;
  End;

 PMenuWin=^TMenuWin;
 TMenuWin=object(TSelWin)
  Items:TTableau;
  Constructor Init(xi,yi:Integer);
  Destructor Done;virtual;
  Function GetErrorMsg:String;virtual;
  Function Ligne(n:Integer):String;virtual;
  Function NombreItems:Integer;virtual;
  Procedure HandleEvent(Var Event:TEvent);virtual;
  Procedure AjouterItem(N:TStr30;K:Word);
  End;

 PDirWin=^TDirWin;
 TDirWin=object(TSelWin)
  DirTab:TFileTab;
  Constructor Init(xi,yi,h:Byte;CheminMasque:PathStr);
  Destructor Done;virtual;
  Function  GetErrorMsg:String;virtual;
  Function  NombreItems:Integer;virtual;
  Function  Ligne(n:Integer):String;virtual;
  Procedure HandleEvent(Var Event:TEvent);virtual;
  Function  FichierChoisi:String;
  end;

Function  GetFile(Mask:PathStr):PathStr;
Procedure Message(S:String);
Procedure WinRead(Var S:String; Tit:String);
Function  PassWord(S:TStr12):Boolean;

IMPLEMENTATION

Procedure Scrute(S:String;Var h,l:Integer);
{ renvoie dans l la largeur de S et dans h sa hauteur en lignes }
Var i,lt:Byte;
Begin
 h:=1;
 l:=0;
 lt:=0;
 for i:=1 to length(S) do
  begin
   if S[i]=#13
      then begin
            inc(h);
            if lt>l
               then l:=lt;
            lt:=0;
           end
      else inc(lt);
  end;
 if lt>l
    then l:=lt;
End;

{ objet TMessageWin }

Constructor TMessageWin.Init(Msg:String);
Var x,y,h,l:Integer;
Begin
 Scrute(Msg,h,l);
 if l>70
    then l:=70;
 if l<10
    then l:=10;
 x:=(80-l-4) div 2;
 y:=(25-h-2) div 2;
 TWindow.Init(x,y,l+2,h+2,' INFO ');
 Ident:='MSGWIN';
 PalOffset:=pVert;
 Txt:=Msg;
End;

Procedure TMessageWin.DrawInterior;
Var x,y,i:Byte;
Begin
 x:=1;
 y:=1;
 for i:=1 to length(Txt) do
  begin
   case Txt[i] of
    #13: begin
          inc(y);
          x:=1;
         end;
    #10:;
    else begin
          Ecrire(Txt[i],x,y,0);
          inc(x);
         end;
   end;
  end;
End;

Procedure TMessageWin.HandleEvent(Var Event:TEvent);
Begin
 TWindow.HandleEvent(Event);
 if (Event.What=evKeyDown) or (Event.What=evMouseLDown)
    then ExitCode:=exAnnule;
End;

{ objet TDialWin }

Constructor TDialWin.Init(l:Integer;Tit:TStr30);
Var x:Integer;
Begin
 if l>70 then l:=70;
 x:=(80-l) div 2;
 TWindow.Init(x,10,l+2,3,Tit);
 Etat:=Etat or stCurseur;
 PalOffset:=pGris;
 Champ:=new(PChamp,Init('',80,Largeur));
End;

Destructor TDialWin.Done;
Begin
 dispose(Champ,Done);
 TWindow.Done;
End;

Procedure TDialWin.Select;
Var P : TPoint;
Begin
 TWindow.Select;
 if Champ<>nil
    then begin
          MakeGlobal(Origin,P);
          SetCursorPos(P.X+Champ^.XScr,P.Y+1);
         end;
End;

Procedure TDialWin.DrawInterior;
Var Temp:String;
    P : TPoint;
Begin
 Temp:=Champ^.GetDrawString;
 Ecrire(Temp,1,1,0);
 MakeGlobal(Origin,P);
 SetCursorPos(P.X+Champ^.XScr,P.Y+1);
End;

Procedure TDialWin.HandleEvent(Var Event:TEvent);
Var r:Word;
Begin
 TWindow.HandleEvent(Event);
 if ExitCode=exAnnule
    then Champ^.Txt:='';
 if Event.What=evKeyDown
    then begin
          r:=Champ^.Exec(Event.KeyCode);
          if r=Ret
             then ExitCode:=exOk;
         end
    else exit;
 Event.What:=evNothing;
 DrawInterior;
End;

Procedure TDialWin.GetData(Var Rec);
Begin
 String(Rec):=Champ^.Renvoi;
End;

Procedure TDialWin.SetData(Var Rec);
Begin
 Dispose(champ,done);
 Champ:=New(PChamp,Init(String(Rec),80,Largeur));
End;

Function TDialWin.DataSize:Integer;
Begin
 DataSize:=256;
End;

{ objet TPassWordWin }

Constructor TPassWordWin.Init(M:TStr12);
Begin
 TWindow.Init(29,10,19,3,'Mot de passe');
 Etat:=Etat or stCurseur;
 PalOffset:=pRouge;
 MotDePasse:=M;
 Mot:='';
 XPos:=1;
End;

Procedure TPassWordWin.HandleEvent(Var Event:TEvent);
Begin
 TWindow.HandleEvent(Event);
 if ExitCode=exAnnule
    then Mot:='';
 case Event.What of
  evKeyDown:
   case Event.KeyCode of
    BSP:if xpos>1
           then begin
                 Ecrire(' ',xpos-1,1,0);
                 dec(xpos);
                 DrawInterior;
                end;
    Ret: ExitCode:=exOk;
    32..255: if XPos<12
                then begin
                      Mot:=Mot+chr(Event.KeyCode);
                      Ecrire('X',xpos,1,0);
                      inc(xpos);
                      DrawInterior;
                     end;
    else exit;
    end;
  else exit;
 end;
 Event.What:=evNothing;
 Event.InfoPtr:=@self;
End;

Procedure TPassWordWin.DrawInterior;
Begin
 SetCursorPos(Origin.X+xpos,Origin.Y+1);
End;

Function TPassWordWin.IsOk:Boolean;
Begin
 if Mot=MotDePasse
    then IsOk:=true
    else IsOk:=false;
End;

{ objet TSelWin }

Constructor TSelWin.Init(x,y,l,h:Integer;T:String);
Begin
 TWindow.Init(x,y,l,h,T);
 Ident:='SELWIN';
 PalOffset:=pGris;
 Choix:=1;
 L1:=1;
End;

Function TSelWin.Ligne(n:Integer):String;
Begin
 Ligne:='';
End;

Function TSelWin.NombreItems:Integer;
Begin
 NombreItems:=0;
End;

Procedure TSelWin.Avancer(n:Integer);
Begin
 Choix:=Choix+n;
 if Choix<1
    then Choix:=1;
 if Choix>NombreItems
    then Choix:=NombreItems;
 if Choix<L1
    then L1:=Choix;
 if Choix>L1+Hauteur-1
    then L1:=Choix-Hauteur+1;
End;

Function TSelWin.DonneChoix:Integer;
Begin
 DonneChoix:=Choix;
End;

Procedure TSelWin.DrawInterior;
Var i:Byte;
    temp:Byte;
    S:String;
Begin
 for i:=1 to Hauteur do
  begin
   S:=Ligne(L1+i-1);
   Ajuste(S,largeur);
   if L1+i-1=Choix
        then Ecrire(S,1,i,1)
        else Ecrire(S,1,i,0);
  end;
End;

Procedure TSelWin.HandleEvent(Var Event:TEvent);
Var i:Byte;
    delta:Integer;
    P : TPoint;
Begin
 TWindow.HandleEvent(Event);
 if (ExitCode<>0) and (ExitCode<>exOk)
    then Choix:=0;
 MakeGlobal(Origin,P);
 case Event.What of
   evMouseAuto:
     if Event.LButton and SurCadre(Event.Where)
        then begin
              if Event.Where.Y>P.Y+hauteur div 2
                 then Avancer(1)
                 else Avancer(-1);
              wait(1);
             end
        else exit;
   evDoubleClic:
     begin
      if (not MouseInView) or (Etat and stSelected=0)
         then exit;
      if not SurCadre(Event.Where)
         then begin
               delta:=Event.Where.Y-P.Y-1;
               if L1+delta=Choix
                  then SetCommand(cmOk)
                  else if L1+delta<=NombreItems
                          then Choix:=L1+delta;
              end
         else exit;
     end;
   evMouseLDown:
     begin
      if (not MouseInView) or (Etat and stSelected=0)
         then exit;
      if not SurCadre(Event.Where)
         then begin
               delta:=Event.Where.Y-P.Y-1;
               if L1+delta<=NombreItems
                  then Choix:=L1+delta
                  else exit;
              end
         else exit;
     end;
   evKeyDown:
     case Event.KeyCode of
      ret : SetCommand(cmOk);
      csup: Avancer(-1);
      csdn: Avancer(1);
      pgup: Avancer(-10);
      pgdn: Avancer(10);
      else exit;
      end;
   evCommand:
     case Event.Command of
      cmOk: ExitCode:=exOk;
      else exit;
      end;
   else exit;
   end;
 DrawInterior;
 Event.What:=evNothing;
End;

{ objet TMenuWin }

Constructor TMenuWin.Init(xi,yi:Integer);
Begin
 TSelWin.Init(xi,yi,10,2,' Menu ');
 Items.Init(5,5,sizeof(TMenuItem));
 if not Items.IsValid
    then ErrorFlag:=erMenuItems;
End;

Destructor TMenuWin.Done;
Begin
 Items.Done;
 TSelWin.Done;
End;

Function TMenuWin.GetErrorMsg:String;
Begin
 case ErrorFlag of
  erMenuItems: GetErrorMsg:=Items.GetErrorMsg;
  else GetErrorMsg:=TSelWin.GetErrorMsg;
  end;
End;

Function TMenuWin.Ligne(n:Integer):String;
Var V:TMenuItem;
    S:String;
Begin
 if (n<1) or (n>NombreItems)
    then S:=''
    else begin
          Items.Lire(V,n);
          S:=V.Nom;
         end;
 Ligne:=S;
End;

Function TMenuWin.NombreItems:Integer;
Begin
 NombreItems:=Items.NombreItems;
End;

Procedure TMenuWin.HandleEvent(Var Event:TEvent);
Var V:TMenuItem;
Begin
 TSelWin.HandleEvent(Event);
 if (ExitCode=exOk) and (Choix>0) and (Choix<=NombreItems)
    then begin
          Items.Lire(V,Choix);
          SetCommand(V.Touche);
         end;
End;

Procedure TMenuWin.AjouterItem(N:TStr30;K:Word);
Var V : TMenuItem;
    P : TPoint;
Begin
 MakeMenuItem(V,N,K);
 MakeLocal(Origin,P);
 Items.Ajouter(V);
 if P.Y+Size.Y<21
    then inc(Size.Y);
 if length(N)>largeur
    then Size.X:=length(N)+2;
End;

{ objet TDirWin }

Constructor TDirWin.Init(xi,yi,h:Byte;CheminMasque:PathStr);
Begin
 TSelWin.Init(xi,yi,22,h+1,' Fichiers ');
 DirTab.Init(CheminMasque);
 if not DirTab.Isvalid
    then ErrorFlag:=erDirtab
    else if DirTab.NombreItems=0
            then Choix:=0;
End;

Destructor TDirWin.Done;
Begin
 DirTab.Done;
 TSelWin.Done;
End;

Function TDirWin.GetErrorMsg:String;
Begin
 if ErrorFlag=erDirTab
    then GetErrorMsg:=DirTab.GetErrorMsg
    else GetErrorMsg:=TSelWin.GetErrorMsg;
End;

Function TDirWin.NombreItems:Integer;
Begin
 NombreItems:=DirTab.NombreItems;
End;

Function TDirWin.Ligne(n:Integer):String;
Var P:PSearchFileRec;
    S1,S2:String;
    t:LongInt;
Begin
 if (n<1) or (n>NombreItems)
    then begin
          Ligne:='';
          exit;
         end;
 DirTab.Lire(P,n);
 S1:=NomFichier(P);
 if AttributFichier(P) and Directory <> 0
    then S2:='<REP>'
    else begin
          t:=TailleFichier(P) div 1024;
          str(t:4,S2);
          S2:=S2+' Ko';
         end;
 Ajuste(S1,13);
 S1:=S1+S2;
 Ligne:=S1;
End;

Procedure TDirWin.HandleEvent(Var Event:TEvent);
Var P:PSearchFileRec;
Begin
 TSelWin.HandleEvent(Event);
 if ExitCode=exOk
    then begin
          DirTab.Lire(P,Choix);
          if AttributFichier(P) and Directory <> 0
             then begin
                   with DirTab do
                    ChangeDir(DonneRepertoire+NomFichier(P));
                   if not DirTab.IsValid
                      then begin
                            ErrorFlag:=erDirTab;
                            ExitCode:=exAnnule;
                            Choix:=0;
                            Event.What:=evNothing;
                            exit;
                           end;
                   ExitCode:=0;
                   if DirTab.NombreItems>=1
                      then Choix:=1
                      else Choix:=0;
                   L1:=1;
                   DrawInterior;
                   Event.What:=evNothing;
                  end;
         end;
End;

Function TDirWin.FichierChoisi:String;
Var P:PSearchFileRec;
Begin
 if (Choix<1) or (Choix>NombreItems)
    then FichierChoisi:=''
    else begin
          DirTab.Lire(P,Choix);
          FichierChoisi:=DirTab.DonneRepertoire+NomFichier(P);
         end;
End;

{ procédures et fonctions utilisant les objets définis }

Procedure Message(S:String);
Var W:PMessageWin;
    b:Byte;
    C:TCursorState;
Begin
 {GetCursorState(C);}
 W:=New(PMessageWin,Init(S));
 Application^.Insert(W);
 b:=W^.Exec;
 dispose(W,Done);
 {SetCursorState(C);}
End;

Procedure WinRead(Var S:String; Tit:String);
Var W:PDialWin;
    b:Byte;
    C:TCursorState;
Begin
 {GetCursorState(C);}
 W:=New(PDialWin,Init(40,Tit));
 Application^.Insert(W);
 b:=W^.Exec;
 if b=exOk
    then W^.GetData(S)
    else S:='';
 dispose(W,Done);
 {SetCursorState(C);}
End;

Function PassWord(S:TStr12):Boolean;
Var W:PPassWordWin;
    b:Byte;
    C:TCursorState;
Begin
 {GetCursorState(C);}
 W:=New(PPassWordWin,Init(S));
 Application^.Insert(W);
 b:=W^.Exec;
 PassWord:=W^.IsOk;
 dispose(W,Done);
 {SetCursorState(C);}
End;

Function GetFile(Mask:PathStr):PathStr;
Var W:PDirWin;
    b:Byte;
    C:TCursorState;
Begin
 {GetCursorState(C);}
 W:=New(PDirWin,Init(1,2,20,Mask));
 Application^.Insert(W);
 b:=W^.Exec;
 if W^.IsValid
    then GetFile:=W^.FichierChoisi
    else GetFile:='';
 Dispose(W,Done);
 {SetCursorState(C);}
End;

END.

{                        Fin du fichier ODialWin.Pas                        }