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

Pascal/Delphi Source File | 1994-11-13 | 14KB | 649 lines

Unit OGenView;
{ objet générique pour applications en POO avec gestion des évènements }
{ K.B. octobre 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 UDrivers;

Const
 { Constantes d'état des objets }
 stVisible    = $0001;
 stSelectable = $0002;
 stSelected   = $0004;

 { Constantes des commandes standards }
 cmGeneric = 000;
 cmOK      = cmGeneric+01;
 cmAnnule  = cmGeneric+02;
 cmNew     = cmGeneric+03;
 cmOpen    = cmGeneric+04;
 cmSave    = cmGeneric+05;
 cmSaveAs  = cmGeneric+06;
 cmOui     = cmGeneric+07;
 cmNon     = cmGeneric+08;
 cmClose   = cmGeneric+09;
 cmQuit    = cmGeneric+10;

 { Constantes des codes de sortie de Exec }
 exOK         = 1;
 exAnnule     = 2;
 exOui        = 3;
 exNon        = 4;

 { Constantes des codes d'erreur }
 erMemoire    = 1;
 erOpenFile   = 2;
 erFormatFile = 3;
 erReadFile   = 4;
 erWriteFile  = 5;
 erCloseFile  = 6;
 erChild      = 7;

Type
 PGenView  = ^TGenView;
 TGenView  = Object
  Ident       : String[10];     { identificateur }
  Prec,Suiv   : PGenView;       { éléments suivant et précédent
                                  dans le groupe parent }
  Owner       : PGenView;       { élément parent }
  Child       : PGenView;       { élément enfant }
  Origin      : TPoint;         { coin supérieur gauche }
  Size        : TPoint;         { taille }
  Etat        : Word;           { état (visible, actif, etc..) }
  ErrorFlag   : Byte;           { indicateur d'erreur }
  ExitCode    : Byte;           { code de sortie }
  MouseInView : Boolean;     { présence de la souris }
  MouseAspect : PMouseAspect;   { aspect de la souris }
  Constructor Init(X,Y,L,H:Integer);
  { initialise les dimensions }
  Destructor Done; virtual;
  { retire l'élément du groupe parent et le détruit }
  Procedure HandleEvent(Var Event : TEvent); virtual;
  { gestion des évènements }
  Procedure Draw; virtual;
  { affichage du fond puis des enfants }
  Procedure ReDraw;
  { affichage des enfants }
  Procedure BackGround; virtual;
  { dessine le fond }
  Procedure MakeGlobal(Src:TPoint; Var Dst:TPoint);
  { conversion de coordonnées }
  Procedure MakeLocal(Src:TPoint; Var Dst:TPoint);
  { conversion de coordonnées }
  Procedure Insert(W:PGenView);
  { ajoute un élément dans le groupe Enfant }
  Function Find(Id:String):PGenView;
  { cherche un enfant à partir de son identificateur }
  Function FindSelect:PGenView;
  { cherche l'enfant sélectionné }
  Procedure DrawBegin; virtual;
  { appelée avant un affichage : masque la souris }
  Procedure DrawEnd; virtual;
  { appelée après un affichage : rétablit la souris }
  Procedure Decroche;
  { retire l'élément du parent }
  Function Suivant : PGenView;
  { élément suivant du parent, après le dernier on renvoie le premier }
  Function Precedent : PGenView;
  { élément précédent du parent, avant le premier on renvoie le dernier }
  Procedure SetData(Var Rec); virtual;
  { initialisation des données }
  Procedure GetData(Var Rec); virtual;
  { récupération des données }
  Function DataSize:Integer; virtual;
  { taille des données utilisées par SetData et GetData }
  Procedure GetEvent(Var Event:TEvent); virtual;
  { pour recueillir les évènements }
  Procedure SetCommand(Command:Word);
  { envoie un évènement commande }
  Procedure SauveEcran; virtual;
  { sauve la partie d'écran recouverte }
  Procedure RestitueEcran; virtual;
  { restitue la partie d'écran sauvée avec SauveEcran }
  Function Exec : Byte;
  { boucle d'exécution }
  Procedure Select; virtual;
  { fait passer à l'état sélectionné }
  Procedure UnSelect; virtual;
  { quitte l'état sélectionné }
  Function Isvalid : Boolean; virtual;
  { indique une erreur }
  Function GetErrorMsg : String; virtual;
  { renvoie un message d'erreur }
 End;

 PGenApp = ^TGenApp;
 TGenApp = Object(TGenView)
  Constructor Init;
  { initialise les drivers écran, clavier,souris,...}
  Destructor Done; virtual;
  { pour quitter l'application }
  Procedure VideoInit; virtual;
  { initialise le mode vidéo choisi }
  Procedure VideoDone; virtual;
  { quitte le mode vidéo choisi }
  Procedure HandleEvent(Var Event : TEvent); virtual;
  { gestion des évènements : commande cmQuit et touche AltX }
  Procedure GetEvent(Var Event : TEvent); virtual;
  { lecture des évènements }
  Procedure Quit; virtual;
  Procedure TempsMort; virtual;
  End;

Var
 Application : PGenView;   { application }

Function ExecView(W:PGenView):Byte;

IMPLEMENTATION

Type
 { zone de transfert des données }
 PDataArea = ^TDataArea;
 TDataArea = Array[0..60000] of Byte;

Var MouseView : PGenView;     { Objet qui contient la souris }

{ objet TGenView }

Constructor TGenView.Init(X,Y,L,H:Integer);
Begin
 Ident:='GENVIEW';
 Prec:=nil;
 Suiv:=nil;
 Owner:=nil;
 Child:=nil;
 Origin.X:=X;
 Origin.Y:=Y;
 Size.X:=L;
 Size.Y:=H;
 ExitCode:=0;
 ErrorFlag:=0;
 Etat:=0;
 MouseInView:=false;
 MouseAspect:=nil;
End;

Destructor TGenView.Done;
Var W,Tmp : PGenView;
Begin
 { destruction des enfants }
 W:=Child;
 while (W<>nil) do
  begin
   Tmp:=W^.Suiv;
   Dispose(W,Done);
   W:=Tmp;
  end;
 { sortie du parent }
 Decroche;
End;

Procedure TGenView.MakeGlobal(Src:TPoint; Var Dst:TPoint);
Var W : PGenView;
Begin
 Dst:=Src;
 W:=Owner;
 while (W<>nil) do
  begin
   Dst.X:=Dst.X+W^.Origin.X;
   Dst.Y:=Dst.Y+W^.Origin.Y;
   W:=W^.Owner;
  end;
End;

Procedure TGenView.MakeLocal(Src:TPoint; Var Dst:TPoint);
Var W : PGenView;
Begin
 Dst:=Src;
 W:=Owner;
 while (W<>nil) do
  begin
   Dst.X:=Dst.X-W^.Origin.X;
   Dst.Y:=Dst.Y-W^.Origin.Y;
   W:=W^.Owner;
  end;
End;

Procedure TGenView.HandleEvent(Var Event : TEvent);
Var P : TPoint;
    W : PGenView;
Begin
 if Event.What=evKeyDown
    then if Event.KeyCode=AltX
            then begin
                  ExitCode:=exAnnule;
                  SetEvent(Event);
                  exit;
                 end;
 { gestion du curseur souris et du champ MouseInView }
 MakeGlobal(Origin,P);
 if (Event.What = evMouseMove) and (Etat and stVisible <> 0)
    then if (Event.Where.X>=P.X) and
            (Event.Where.X<=P.X+Size.X-1) and
            (Event.Where.Y>=P.Y) and
            (Event.Where.Y<=P.Y+Size.Y-1)
            then begin
                  if not MouseInView
                     then begin
                           MouseInView:=true;
                           ChangeMouseAspect(MouseAspect);
                           MouseView:=@Self;
                          end;
                 end
            else begin
                  if MouseInView
                     then begin
                           MouseInView:=false;
                           if MouseView=@Self
                              then begin
                                    MouseView:=Owner;
                                    ChangeMouseAspect(Owner^.MouseAspect);
                                   end;
                          end;
                 end;
 case Event.What of
  evNothing : exit;
  evKeyDown,evCommand,evMouseAuto:
 { gestion des évènements claviers et commandes : envoi à l'élément
   sélectionné }
       begin
        W:=FindSelect;
        if W<>nil
           then W^.HandleEvent(Event);
       end;
  { les autres évènements sont envoyés à tous les enfants }
  else begin
        W:=Child;
        while ((W<>nil) and (Event.What<>evNothing)) do
         begin
          W^.HandleEvent(Event);
          W:=W^.Suiv;
         end;
       end;
  end;
End;

Procedure TGenView.Draw;
{ affichage complet : fond et enfants }
Begin
 Etat:=Etat or stVisible;
 BackGround;
 Redraw;
End;

Procedure TGenView.ReDraw;
{ affichage des enfants }
Var W : PGenView;
Begin
 W:=Child;
 while (W<>nil) do
  begin
   W^.Draw;
   W:=W^.Suiv;
  end;
End;

Procedure TGenView.BackGround;
{ affichage du fond }
Begin
End;

Procedure TGenView.Decroche;
Begin
 if Owner<>nil
    then if Owner^.Child=@Self
            then Owner^.Child:=Suiv;
 if (Suiv<>nil)
    then Suiv^.Prec:=Prec;
 if (Prec<>nil)
    then Prec^.Suiv:=Suiv;
 Prec:=nil;
 Suiv:=nil;
 Owner:=nil;
End;

Procedure TGenView.Insert(W : PGenView);
Var Tmp:PGenView;
Begin
 if W=nil
    then begin
          ErrorFlag:=erMemoire;
          exit;
         end;
 Tmp:=W;
 { tous les enfants frères ont le même parent }
 while (Tmp<>nil) do
  begin
   Tmp^.Owner:=@Self;
   Tmp:=Tmp^.Suiv;
  end;
 if (Child=nil)
    then Child:=W
    else begin
          Tmp:=Child;
          { chercher le dernier enfant }
          while (Tmp^.Suiv<>nil) do Tmp:=Tmp^.Suiv;
          W^.Prec:=Tmp;
          Tmp^.Suiv:=W;
         end;
 if not W^.IsValid
    then ErrorFlag:=erChild;
End;

Function TGenView.Suivant : PGenView;
{ élément suivant du parent, après le dernier on renvoie le premier }
Var W : PGenView;
Begin
 W:=Suiv;
 if W=nil
    then begin
          W:=@Self;
          while W^.Prec<>nil do W:=W^.Prec;
         end;
 Suivant:=W;
End;

Function TGenView.Precedent : PGenView;
{ élément précédent du parent, avant le premier on renvoie le dernier }
Var W : PGenView;
Begin
 W:=Prec;
 if W=nil
    then begin
          W:=@Self;
          while W^.Suiv<>nil do W:=W^.Suiv;
         end;
 Precedent:=W;
End;

Procedure TGenView.SetData(Var Rec);
Var Pos : Integer;
    W   : PGenView;
    Tbl : PDataArea;
Begin
 Tbl:=@Rec;
 Pos:=0;
 W:=Child;
 while (W<>nil) do
  begin
   W^.SetData(Tbl^[Pos]);
   Pos:=Pos+W^.DataSize;
   W:=W^.Suiv;
  end;
End;

Procedure TGenView.GetData(Var Rec);
Var Pos : Integer;
    W   : PGenView;
    Tbl : PDataArea;
Begin
 Tbl:=@Rec;
 Pos:=0;
 W:=Child;
 while (W<>nil) do
  begin
   W^.GetData(Tbl^[Pos]);
   Pos:=Pos+W^.DataSize;
   W:=W^.Suiv;
  end;
End;

Function TGenView.DataSize : Integer;
Var Result : Integer;
    W      : PGenView;
Begin
 Result:=0;
 W:=Child;
 while (W<>nil) do
  begin
   Result:=Result+W^.DataSize;
   W:=W^.Suiv;
  end;
 DataSize:=Result;
End;

Function TGenView.Isvalid:Boolean;
Var W:PGenView;
    ok:Boolean;
Begin
 ok:=ErrorFlag=0;
 W:=Child;
 while ok and (W<>nil) do
  begin
   ok:=W^.IsValid;
   W:=W^.Suiv;
  end;
 IsValid:=ok;
End;

Function TGenView.GetErrorMsg:String;
Var W:PGenView;
    S:String;
Begin
 S:='';
 W:=Child;
 while (W<>nil) and (S='') do
  begin
   S:=W^.GetErrorMsg;
   W:=W^.Suiv;
  end;
 GetErrorMsg:=S;
End;

Procedure TGenView.GetEvent(Var Event : TEvent);
Begin
 if Owner<>nil
    then Owner^.GetEvent(Event)
    else ReadEvent(Event);
End;

Procedure TGenView.SetCommand(Command : Word);
Var Event : TEvent;
Begin
 Event.What:=evCommand;
 Event.Command:=Command;
 Event.InfoPtr:=@self;
 SetEvent(Event);
End;

Procedure TGenView.SauveEcran;
Begin
End;

Procedure TGenView.RestitueEcran;
Begin
End;

Function TGenView.Exec : Byte;
Var Event : TEvent;
    W     : PGenView;
Begin
 if not IsValid
    then begin
          Exec:=$FF;
          exit;
         end;
 SauveEcran;
 if Owner<>nil
    then W:=Owner^.FindSelect
    else W:=nil;
 Select;
 Draw;
 { mise à jour du pointeur souris }
 Event.What:=evMouseMove;
 Event.Where.X:=MouseX;
 Event.Where.Y:=MouseY;
 HandleEvent(Event);
 { boucle de gestion des évènements }
 repeat
  GetEvent(Event);
  if Event.What<>evNothing
     then HandleEvent(Event);
 until ExitCode<>0;
 RestitueEcran;
 if W<>nil
    then W^.Select;
 Exec:=ExitCode;
End;

Procedure TGenView.DrawBegin;
Var P : TPoint;
Begin
 MakeGlobal(Origin,P);
 MouseClipON(P.X,P.Y,P.X+Size.X,P.Y+Size.Y);
End;

Procedure TGenView.DrawEnd;
Begin
 MouseClipOFF;
End;

Procedure TGenView.Select;
Var W  : PGenView;
    ok : Boolean;
Begin
 { désélectionner le frère sélectionné }
 if Owner<>nil
    then begin
          W:=Owner^.Child;
          ok:=false;
          while (W<>nil) and not ok do
           begin
            if W^.Etat and stSelected <> 0
               then begin
                     W^.UnSelect;
                     ok:=true;
                    end;
            W:=W^.Suiv;
           end;
         end;
 if Etat and stSelectable <> 0
    then Etat:=Etat or stSelected;
End;

Procedure TGenView.UnSelect;
Begin
 if Etat and stSelected <> 0
    then Etat:=Etat xor stSelected;
End;

Function TGenView.FindSelect:PGenView;
Var W : PGenView;
    ok:Boolean;
Begin
 ok:=false;
 W:=Child;
 while (W<>nil) and not ok do
  begin
   if W^.Etat and stSelected <> 0
      then ok:=true
      else W:=W^.suiv;
  end;
 if ok
    then FindSelect:=W
    else FindSelect:=nil;
End;

Function TGenView.Find(Id:String):PGenView;
Var W : PGenView;
    ok:Boolean;
Begin
 ok:=false;
 W:=Child;
 while (W<>nil) and not ok do
  begin
   if W^.Ident=Id
      then ok:=true
      else W:=W^.suiv;
  end;
 if ok
    then Find:=W
    else Find:=nil;
End;

Function ExecView(W:PGenView):Byte;
Var result:Byte;
Begin
 Application^.Insert(W);
 result:=W^.Exec;
 Dispose(W,Done);
 ExecView:=result;
End;

{ objet TGenApp }

Constructor TGenApp.Init;
Begin
 TGenView.Init(0,0,1,1);
 Etat:=stSelectable+stSelected;
 VideoInit;
 DriversInit;
 MouseView:=nil;
 Ident:='GENAPP';
 Application:=@Self;
End;

Destructor TGenApp.Done;
Begin
 TGenView.Done;
 DriversDone;
 VideoDone;
End;

Procedure TGenApp.TempsMort;
Begin
End;

Procedure TGenApp.VideoInit;
Begin
End;

Procedure TGenApp.VideoDone;
Begin
End;

Procedure TGenApp.GetEvent(Var Event:TEvent);
Begin
 ReadEvent(Event);
 if Event.What=evNothing
    then TempsMort;
End;

Procedure TGenApp.Quit;
Begin
 ExitCode:=exAnnule;
End;

Procedure TGenApp.HandleEvent(Var Event : TEvent);
Begin
 if Event.What=evKeyDown
    then if Event.KeyCode=AltX
            then begin
                  SetCommand(cmQuit);
                  Event.What:=evNothing;
                 end;
 TGenView.HandleEvent(Event);
 case Event.What of
  evCommand:
   case Event.Command of
     cmQuit: Quit;
     else Exit;
   end;
  else exit;
  end;
 Event.What:=evNothing;
End;

END.

{                        Fin du Fichier OGenView.Pas                        }