{==============  FICHIER DE EDNUM  ======================}
{ Unite Graphe Trace.pas  Usinage machines a c.n. NUM750 }
{ programmation Pascal                                   }
{ Copyright (S) 1997-2011                                }
{ programmeur du programme A.Ara                         }
{ 64150 Mourenx - France.                                }
{ Licence d'utilisation accord dans un but démonstratif  }
{ Unite ed13fnum.pas graphiques EDnum c.n du bois        }
{========================================================}
{========================================================}
{                                                        }
{ ED13FNUM  comprend La fonction Miroir / ED Rotation    }
{ les variables L0 .. L19                                }
{                                                        } 
{========================================================}

{$O+,F+}

Unit ED13FNUM;

Interface

{***define __TYPE_M100__}  {** Si la machine demande de serrer la piece **}


      {$IFDEF __Type_M100__}

Const Serrage_Piece:Boolean=False;

      {$ENDIF}


Procedure InitGraphique;
Procedure GraPhique_Numeriqe(RepertoireFile1,NomFile1:String);
Function  SuprimeCommentaires(S:String):String;
Function  VerifyLetreIso(SSS:String):Boolean;
Function  Decode_Ligne(Var lig:Integer;Texte:String):Boolean;
Procedure Init_Table(uu:Integer);
Procedure Numerical;
Procedure Metre_un_Veille;


Implementation


Uses crt,Dos,GRAPH,
     Crtkey,
     Get_Key,
     Buffs         , {**}
     Buff_Tex      , {**}
     NUM_Buff      , {**}
     VAR_NUM       , {**}
     OPEN_GPH      , {**}
     UFormule      , {**} 
     UTIL7F        , {**}
     FONC_GXM      , {**}
     RepetG77;       {**}   


Const
LetreNotISO:set of Char = [#0..#9,#12,#14..#25,#27..#31,#33..#36,#38,#39,#59,#63,#91..#255];
Type ResolutionPreference = (Lower, Higher);

Var ix      : Integer;
    ReserveZ: Integer;
    Snnn    : String[3];
    Scommand: String[6];
    Modale  : Boolean;


Function Decode_Ligne(Var lig:Integer;Texte:String):Boolean;

Label Finis;
Const
Commande1: Array[1..40] Of String[4] = ('G0', 'G00','G1', 'G01','G2', 'G02',
                                        'G3', 'G03','G',  'GXY','GXYZ',
                                        'M2', 'M02','M3', 'M03','M4', 'M04',
                                        'M5', 'M05','M6', 'M06','G51','G59',
                                        'G52','G79','G77','G54','G80','G81','G82',
                                        'G83','G84','G85','G86','G87','G88',
                                        'G89','G45','M100','M101'); {**G90','G91');***}

Var Recherche,tex  :String;
    i,u,NN,s,n,Z   :Integer;
    cc,a,x,Err     :Integer;
    _P,_ER,_Z,Vii  :Real;
    StrVar         :String[40];
    StrVar1        :String[40];
    Valeur         :Real;
    NN_ligne       :Longint;
    Temporal       :String[20];

 Procedure Analise_Commande(xx:Byte);
 var Trouve:Boolean;
     u:Byte;

 begin
   i:=xx-1;
   While (i>2)  DO
   begin
      Trouve:=False;u:=1;
      While (Not Trouve) And (u<=40) Do
      begin
         if (Tab128[i]=Commande1[u]) Then
         begin
            Temporal:=Tab128[i];
            Tab128[i]:=Tab128[i-1];
            Tab128[i-1]:=Temporal;
            trouve:=True;
         end;
        Inc(u);
      end;
      Dec(i);
   end;
 end;


begin
   if Ordinateur486 Then begin end;

   For i:=1 To 20 DO Tab128[i]:='';
   texte:=Uppers(Texte)+' ';
   a:=1;x:=0;
   cc:=length(texte);
   z:=1;
   Repeat
      tex:=Copy(Texte,a,cc);
      s:=pos(' ',tex);
      Recherche:=Copy(tex,1,s);
      n:=length(Recherche);
      Inc(a,n);
      if Recherche<>' ' Then
       begin
        Recherche:=Copy(Recherche,1,n-1);
        if length(Recherche)>40 Then
         begin
            Erreur_Formule(4,0,Tab128[1]);
            Decode_Ligne:=False;
            Goto Finis;
         end
        else
        begin
          if (Modale) And (z=2) And (Pos('G',Texte)=0) Then
           begin
             if (((Recherche[1]='X') OR (Recherche[1]='Y')) And
                 ((Scommand='G0')  OR (Scommand='G1')  OR
                  (Scommand='G2')  OR (Scommand='G3')  OR
                  (Scommand='G00') OR (Scommand='G01') OR
                  (Scommand='G02') OR (Scommand='G03') OR
                  (Scommand='G81')  OR (Scommand='G82')  OR
                  (Scommand='G83')  OR (Scommand='G84')  OR
                  (Scommand='G85') OR (Scommand='G86') OR
                  (Scommand='G87') OR (Scommand='G88') OR
                  (Scommand='G89'))) Then
              begin
                  Tab128[z]:=Scommand;
                  Inc(z);
                  Tab128[z]:=Recherche;
              end;
           end;

           if (Recherche='G') Then
           begin
              Recherche:='G1';
              Scommand:='G1';
           end;

          if (z>1) And ((Recherche='GXY') OR (Recherche='GXYZ')) Then
           begin
              Scommand:='G1';
              Tab128[z]:=Scommand;
              Inc(z);
              Tab128[z]:='X0';
              Inc(z);
              Tab128[z]:='Y0';
              if Recherche='GXYZ'Then
               begin
                  Inc(z);
                  Tab128[z]:='Z0';
               end;
           End
          else
           tab128[z]:=Recherche;


         if (z>1) Then
          begin
           if (Recherche='G0') OR (Recherche='G00') Then Scommand:='G0'
            else
           if (Recherche='G1') OR (Recherche='G01') Then Scommand:='G1'
            else
           if (Recherche='G2') OR (Recherche='G02') Then Scommand:='G2'
            else
           if (Recherche='G3') OR (Recherche='G03') Then Scommand:='G3'
           else
           if ((Recherche='M2')  OR (Recherche='M02') OR
               (Recherche='M3')  OR (Recherche='M03') OR
               (Recherche='M4')  OR (Recherche='M04') OR
               (Recherche='M5')  OR (Recherche='M05') OR
               (Recherche='M6')  OR (Recherche='M06') OR
               (Recherche='G51') OR (Recherche='G79') OR
               (Recherche='G77') OR (Recherche='G54') OR
               (Recherche='G80') OR (Recherche='G59')) Then Scommand:='G1'
          else
          if ( (Recherche='G81') OR
               (Recherche='G82') OR (Recherche='G83') OR
               (Recherche='G84') OR (Recherche='G85') OR
               (Recherche='G86') OR (Recherche='G87') OR
               (Recherche='G88') OR (Recherche='G89')) Then
                  Scommand:=Recherche;

          end;
         end;

        if (Tab128[z]='X') OR (Tab128[z]='Y') OR (Tab128[z]='Z') Then
         Insert('0',Tab128[z],2);
        Inc(z);
       end;

   Until (a>cc) OR (z=limite);

   if z>2 Then Analise_Commande(z);

   if ((Tab128[2]='G0') OR (Tab128[2]='G00') OR
       (Tab128[2]='G1') OR (Tab128[2]='G01')) And
      (POS('Z',Tab128[3])=1) And (Tab128[4]='') Then
     begin
        Tab128[2]:=Tab128[3];
        Tab128[3]:='';
     end;

   U:=1;
   if (Tab128[u]='M2') OR (Tab128[u]='M02') Then
   begin
      if (Tab128[u]='M02') Then Tab128[u]:='M2';
      C^[Lig].CN:=Tab128[u];
      if (u=1) And (Lig>1) Then
       begin
          StrVar:=Copy(C^[Lig-1].CN,2,Length(C^[Lig-1].CN));
          {$R-}
          Val(StrVar,Valeur,Err);
          {$R+}
          if (Err=0) Then
           begin
              Valeur:=Valeur+1;
              Str(Round(Valeur),StrVar);
              C^[Lig].CN:='N'+StrVar;
           end;
       end;
      FIN_M2:=False;
      Inc(Lig);
      Decode_Ligne:=False;
      Goto Finis;
    End
   else
   if Tab128[u]<>'' Then
    begin
        if Tab128[1][1]<>'N' Then Erreur_Formule(20,0,Tab128[1])
          else
           begin
            StrVar:=Copy(Tab128[1],2,Length(Tab128[u]));
            {$R-}
            Val(StrVar,NN_Ligne,Err);
            {$R+}
            if (Err<>0) OR (NN_Ligne>32767) Then Erreur_Formule(21,0,Tab128[1])
            else
            if N_Number>=NN_Ligne Then Erreur_Formule(26,0,Tab128[1])
            else
            N_number:=NN_Ligne;
           end;
       C^[Lig].CN:=Tab128[1];
       Inc(u);
    end;

   if (Tab128[u]='M2') OR (Tab128[u]='M02') Then
    begin
      if (Tab128[u]='M02') Then Tab128[u]:='M2';
      C^[Lig].CG:=Tab128[u];
      FIN_M2:=False;
      Inc(Lig);
      Decode_Ligne:=False;
      Goto Finis;
    End
   else

   if (Tab128[u]='G91') OR (Tab128[u]='G90') Then
   begin
      if (Tab128[u]='G91') Then C^[Lig].CS:='G91'
      else C^[Lig].CS:='G90';
      Inc(u);
   end;


   if (Tab128[U]='M3') OR (Tab128[u]='M03') OR (Tab128[u]='M04') OR
      (Tab128[u]='M4') OR (Tab128[u]='M5') OR (Tab128[u]='M05') Then
    begin
       if (Tab128[u]='M03') Then Tab128[u]:='M3';
       if (Tab128[u]='M04') Then Tab128[u]:='M4';
       if (Tab128[u]='M05') Then Tab128[u]:='M5';
       cc:=2;
       While (cc<Limite) And (Tab128[cc]<>'') DO
        begin
         if (Tab128[cc]='M3') OR (Tab128[cc]='M4') OR (Tab128[cc]='M5') Then
           C^[Lig].CG:=Tab128[cc]
         else
         if Tab128[cc][1]='M' Then C^[Lig].CX:=Tab128[cc]
         else
         if Tab128[cc][1]='S' Then C^[Lig].CY:=Tab128[cc];
         Inc(cc);
        end;
    end;

    if Tab128[U]='G79' Then   {Saut inconditionel/conditionel}
     begin
       C^[Lig].CG:=Tab128[U];
       if Tab128[U+1][1]='N' Then C^[Lig].CX:=Tab128[U+1]
       else
       if Tab128[U+1][1]<>'' Then
        begin
          if (Condition(Tab128[U+1]) In[1,0]) Then
           begin
              C^[Lig].CY:=Tab128[U+1];
              C^[Lig].CX:=Tab128[U+2];
           End
          else
           begin
              Erreur_Formule(5,Formule_Erreur,Tab128[1]);
              Decode_Ligne:=False;
              Goto Finis;
           end;
        end;
     end;

    if Tab128[U]='G77' Then      {Repete bloc}
     begin
       C^[Lig].CG:=Tab128[U];
       C^[Lig].CX:=Tab128[U+1];
       C^[Lig].CY:=Tab128[U+2];
       if POS('S',Tab128[U+3])>0 Then
        begin
         if I>0 Then
          if (Not Controle_Formule(Copy(Tab128[U+3],2,Length(Tab128[U+3])),2)) Then
           begin
              Erreur_Formule(2,Formule_Erreur,Tab128[1]);
              Decode_Ligne:=False;
              Goto Finis;
           End
           else
           C^[Lig].CR:=Tab128[U+3];
           Tab128[U+3]:='';
        End
         else C^[Lig].CR:='  ';
     end;

    if Tab128[U]='G51' Then      {Miroir}
     begin
       C^[Lig].CG:=Tab128[U];
       C^[Lig].CX:=Tab128[U+1];
       C^[Lig].CY:=Tab128[U+2];
     end;


   (***==========================================================
    *if Tab128[U]='G54' Then   {Validation des decalges}
    * begin
    *   C^[Lig].CG:=Tab128[U];
    *   if Tab128[u+1][1]='X' Then C^[Lig].CX:=Tab128[U+1];
    *   if Tab128[u+2][1]='Y' Then C^[Lig].CY:=Tab128[U+2];
    *
    *   if Tab128[u+1][1]='Y' Then C^[Lig].CY:=Tab128[U+1];
    *   if Tab128[u+2][1]='X' Then C^[Lig].CX:=Tab128[U+2];
    *
    * end;
    ***=======================================================***)


    if (POS('ED',Tab128[U])=1) Then    {**Rotation ED**}
     begin
       C^[Lig].CED:='ED';
       if (POS('L',Tab128[U])>0) Then
        begin
           if Length(Tab128[u])<=Long_Formule Then
           begin
           i:=Pos('L',Tab128[U]);
           if (i>1) And
              (Controle_Formule(Copy(Tab128[u],3,Length(Tab128[U])),i)) Then
            begin
               New(C^[Lig].LED);
               C^[Lig].LED^:=Copy(Tab128[u],3,Length(Tab128[U]));
               DElete(Tab128[U],3,Length(Tab128[U]));
               Insert('400',Tab128[U],3);
               StrVar:=Copy(Tab128[u],3,Length(Tab128[u]));
            End
            else
             begin
               Erreur_Formule(1,Formule_Erreur,Tab128[1]);
               Decode_Ligne:=False;
               Goto Finis;
             end;

           End
           else
            begin
               Erreur_Formule(6,0,Tab128[1]);
               Decode_Ligne:=False;
               Goto Finis;
             end;
        end;
     end;

    if POS('L',Tab128[U])>0 Then   {**Variables**}
     begin
        if Length(Tab128[u])<=Long_Formule Then
        begin
        i:=Pos('L',Tab128[U]);
        if i>1 Then
         begin
          if (Tab128[U][1] In['X','Y','R','I','J']) And
             (Controle_Formule(Tab128[U],i)) Then
            begin
              Case Tab128[U][1] Of
               'X': begin
                     New(C^[Lig].LX);
                     C^[Lig].LX^:=Copy(Tab128[u],2,Length(Tab128[U]));
                    end;
               'Y': begin
                       New(C^[Lig].LY);
                       C^[Lig].LY^:=Copy(Tab128[u],2,Length(Tab128[U]));
                    end;
               'R': begin
                       New(C^[Lig].LR);
                       C^[Lig].LR^:=Copy(Tab128[u],2,Length(Tab128[U]));
                    end;
               'I': begin
                       New(C^[Lig].LI);
                       C^[Lig].LI^:=Copy(Tab128[u],2,Length(Tab128[U]));
                    end;
               'J': begin
                       New(C^[Lig].LJ);
                       C^[Lig].LJ^:=Copy(Tab128[u],2,Length(Tab128[U]));
                    end;
              end;
              DElete(Tab128[U],2,Length(Tab128[U]));
              Insert('-30000',Tab128[U],2);
            End
            else
            begin
              Erreur_Formule(2,Formule_Erreur,Tab128[1]);
              Decode_Ligne:=False;
              Goto Finis;
            end;
         End
        else
        if (i=1) And (Tab128[U][1]='L') Then
         begin
           if (Controle_Formule(Tab128[U],i))  Then
            begin
             New(C^[Lig].LA);
             C^[Lig].LA^:=Tab128[u];  {**L=formule**}
             Tab128[u]:='$-40000';
            End
           else
            begin
              Erreur_Formule(1,Formule_Erreur,Tab128[1]);
              Decode_Ligne:=False;
              Goto Finis;
            end;
         end;
        End
        else
            begin
               Erreur_Formule(6,0,Tab128[1]);
               Decode_Ligne:=False;
               Goto Finis;
             end;
     end;


    if (Tab128[U]='G80') Then   {**Stop Circle Percage**}
     begin
       Circle_Percage:=False;
       C^[Lig].CG:=Tab128[U];
       if Tab128[U+1]<>'' Then C^[Lig].CX:=Tab128[U+1];
       if Tab128[U+2]<>'' Then C^[Lig].CY:=Tab128[U+2];
       if Tab128[U+3]<>'' Then C^[Lig].CR:=Tab128[U+3];
       ModeG81:='';
       Z_G81:='';
       ERG81:='';
       F_G81:='';
     End
    else
    if (Circle_Percage) OR (Tab128[U]='G81') OR (Tab128[U]='G82') OR
       (Tab128[U]='G83') OR (Tab128[U]='G84') OR (Tab128[U]='G85') OR
       (Tab128[U]='G86') OR (Tab128[U]='G87') OR (Tab128[U]='G88') OR
       (Tab128[U]='G89') Then   {Circle Percage}
    begin
     if (Circle_Percage) AND (Tab128[u]<>'G81')  And (Tab128[U]<>'G81') And
        (Tab128[U]<>'G82') And (Tab128[U]<>'G83') And (Tab128[U]<>'G84') And
        (Tab128[U]<>'G85') And (Tab128[U]<>'G86') And (Tab128[U]<>'G87') And
        (Tab128[U]<>'G88') And (Tab128[U]<>'G89') Then
      begin
         if ModeG81<>'' Then C^[lig].CG:=ModeG81;
         if F_G81<>'' Then C^[lig].CF:=F_G81;
         i:=2;
         While Tab128[i]<>'' DO Inc(i);
         if Tab128[i]='' Then Tab128[i]:=Z_G81;
         if Tab128[i+1]='' Then Tab128[i+1]:=ERG81;
      End
      else
       begin
           Circle_Percage:=True;
           i:=2;

           While Tab128[i]<>'' DO
            begin
               if POS('G8',Tab128[i])>0 Then
                begin
                   C^[Lig].CG:=Tab128[i];
                   ModeG81:=Tab128[i];
                End
               else
               if POS('ER',Tab128[i])>0 Then
                begin
                   ERG81:=Tab128[i];
                End
               else
               if POS('Z',Tab128[i])>0 Then
                begin
                   Z_G81:=Tab128[i];
                End
               else
               if POS('F',Tab128[i])>0 Then
                begin
                   C^[Lig].CF:=Tab128[i];
                   F_G81:=Tab128[i];
                end;
               Inc(i);
            end; {while}
         end; {end bloc}
     End
     else
     if Tab128[U]='G45' Then  {**controle La commande G45**}
      begin
         cc:=U+1;_Z:=0.0;_ER:=0.0;_P:=0.0;Err:=0;Vii:=0.0;
         While (cc<20) And (Err=0) And (Tab128[cc]<>'') DO
          begin
             if (Pos('Z',Tab128[cc])>0) Then
              begin
                 StrVar1:=Tab128[cc];
                 StrVar1:=Copy(StrVar1,2,Length(StrVar1));
                 {$R-}
                 Val(StrVar1,_z,Err);   {**valeur de Z**}
                 {$R+}
              End
             else
             if (Pos('ER',Tab128[cc])>0) Then
              begin
                 StrVar1:=Tab128[cc];
                 StrVar1:=Copy(StrVar1,3,Length(StrVar1));
                 {$R-}
                 Val(StrVar1,_ER,Err);  {**valeur de ER**}
                 {$R+}
              End
             else
             if (Pos('EP',Tab128[cc])=0) And (Pos('P',Tab128[cc])>0) then
              begin
                 StrVar1:=Tab128[cc];
                 StrVar1:=Copy(StrVar1,2,Length(StrVar1));
                 {$R-}
                 Val(StrVar1,_P,Err);  {**valeur de P**}
                 {$R+}
                 if (Err=0) And (_P<=0.0) then Err:=-1;
              End
             else
             if (Pos('EP',Tab128[cc])>0) then
              begin
                 Vii:=0.0;
                 StrVar1:=Tab128[cc];
                 StrVar1:=Copy(StrVar1,3,Length(StrVar1));
                 {$R-}
                 Val(StrVar1,Vii,Err);  {**valeur de EP**}
                 {$R+}
                 if (Err=0) And (Vii<=0.0) then Err:=-1;
              End
             else
             if (Pos('EQ',Tab128[cc])=0) And (Pos('Q',Tab128[cc])>0) then
              begin
                 Vii:=0.0;
                 StrVar1:=Tab128[cc];
                 StrVar1:=Copy(StrVar1,2,Length(StrVar1));
                 {$R-}
                 Val(StrVar1,Vii,Err);  {**valeur de Q**}
                 {$R+}
                 if (Err=0) And (Vii<=0.0) then Err:=-1;
              End
             else
             if (Pos('EQ',Tab128[cc])>0) then
              begin
                 Vii:=0.0;
                 StrVar1:=Tab128[cc];
                 StrVar1:=Copy(StrVar1,3,Length(StrVar1));
                 {$R-}
                 Val(StrVar1,Vii,Err);  {**valeur de EQ**}
                 {$R+}
                 if (Err=0) And (Vii<=0.0) then Err:=-1;
              End
             else
             if (Pos('EB',Tab128[cc])>0) then
              begin
                 Vii:=0.0;
                 StrVar1:=Tab128[cc];
                 StrVar1:=Copy(StrVar1,3,Length(StrVar1));
                 {$R-}
                 Val(StrVar1,Vii,Err);  {**valeur de EB**}
                 {$R+}
                 if (Err=0) And (Vii<=0.0) then Err:=-1;
              End
              else
              if (Pos('EX',Tab128[cc])>0) then
              begin
                 Vii:=0.0;
                 StrVar1:=Tab128[cc];
                 StrVar1:=Copy(StrVar1,3,Length(StrVar1));
                 {$R-}
                 Val(StrVar1,Vii,Err);  {**valeur de EX**}
                 {$R+}
                 if (Err=0) And (Vii<=0.0) then Err:=-1;
              End
             else
             if (Pos('EY',Tab128[cc])>0) then
              begin
                 Vii:=0.0;
                 StrVar1:=Tab128[cc];
                 StrVar1:=Copy(StrVar1,3,Length(StrVar1));
                 {$R-}
                 Val(StrVar1,Vii,Err);  {**valeur de EY**}
                 {$R+}
                 if (Err=0) And (Vii<=0.0) then Err:=-1;
              end;
             Inc(cc);
          end; {**fin de while**}


         if (Err=0) Then
          begin
                          {**Erreur si P plus Grand que (Z*-1)+R**}
            if ( _P > ((_z * -1)+_ER) ) Then
             begin
                Erreur_Formule(66,0,Tab128[1]);
                Decode_Ligne:=False;
                Exit;
                Goto Finis;
             end;
          End
           else
             begin
                Erreur_Formule(3,0,Tab128[1]);
                Decode_Ligne:=False;
                Exit;
                Goto Finis;
             end;
      end; {**fin de controle du commande G45**}


     {$IFDEF __Type_M100__}

      if (Tab128[U]='M100') OR (Tab128[U]='M101') Then   {**Serrage Piece**}
       begin
          C^[Lig].CG:=Tab128[U];
       end;

     {$ENDIF}

  if (Tab128[U]<>'G77') And (Tab128[u]<>''   )  And
     (Tab128[u]<>'M3' ) And (Tab128[u]<>'M03' ) And (Tab128[u]<>'M04' ) And
     (Tab128[u]<>'M4' ) And (Tab128[u]<>'M5' ) And (Tab128[u]<>'M05') And
     (Tab128[U]<>'G79')  And (Tab128[U]<>'G51') And (Tab128[U]<>'M100') And
     (Tab128[U]<>'M101') Then
   While (U<20) And (Tab128[u]<>'') And (ErreurFile=0) DO
    begin
      if (Tab128[u]='G1') OR (Tab128[u]='G01') OR (Tab128[u]='G2') OR
         (Tab128[u]='G02') OR (Tab128[u]='G3') OR (Tab128[u]='G03') OR
         (Tab128[u]='G0') OR (Tab128[u]='G00') OR (Tab128[u]='M6') OR
         (Tab128[u]='M06') OR (Tab128[u]='G45') OR (Tab128[u]='G59') OR
         (Tab128[u]='G81') OR (Tab128[u]='G')   OR (Tab128[u]='G54')
       Then
       begin
          if (Tab128[u]='G00') OR (Tab128[u]='G') Then Tab128[u]:='G0'
          else
          if Tab128[u]='G01' Then Tab128[u]:='G1'
          else
          if Tab128[u]='G02' Then Tab128[u]:='G2'
          else
          if Tab128[u]='G03' Then Tab128[u]:='G3'
          else
          if Tab128[u]='M06' Then Tab128[u]:='M6';
          if (Tab128[U]='G0') OR (Tab128[u]='G1') OR (Tab128[u]='G59') OR
             (Tab128[U]='G54') Then
           begin
             cc:=2;A:=0;
             While (cc<20) And (A<1) And (Tab128[cc]<>'') DO
             begin
                if (Pos('X',Tab128[cc])>0) OR (Pos('Y',Tab128[cc])>0) Then
                 Inc(A);
                Inc(cc);
             end;
             if A>0 Then C^[lig].CG:=Tab128[u];
          End
          else
          C^[lig].CG:=Tab128[u];
       End
      else
      if Tab128[u][1]='M' Then C^[Lig].CR:=Tab128[u]
      else
      if (Tab128[u]='G40') OR (Tab128[u]='G41') OR (Tab128[u]='G42') Then
       C^[lig].CX:=Tab128[u]
      else
      if (Tab128[u]='G90') OR (Tab128[u]='G91')  OR (Tab128[u][1]='S') Then
       C^[lig].CS:=Tab128[u]
      else
      if (Tab128[u][1]='F') Then
       C^[lig].CF:=Tab128[u]
{*a1*} else
       begin
          if (Pos('EB',Tab128[u])>0) OR (Pos('EX',Tab128[u])>0) OR
             (Pos('EY',Tab128[u])>0) OR (Pos('ER',Tab128[u])>0) OR
             (Pos('EP',Tab128[u])>0) OR (Pos('EQ',Tab128[u])>0) OR
             (Pos('ED',Tab128[u])>0)
           Then
             StrVar:=Copy(Tab128[u],3,Length(Tab128[u]))
           else
            StrVar:=Copy(Tab128[u],2,Length(Tab128[u]));

           if POS('L',Tab128[U])>0 Then   {Variables}
            begin
               if Length(Tab128[u])<=Long_Formule Then
               begin
               i:=Pos('L',Tab128[U]);
               if (i>1) And (Tab128[U][1] In['X','Y','R','I','J']) And
                  (Controle_Formule(Copy(Tab128[u],2,Length(Tab128[U])),i)) Then
                 begin
                    Case Tab128[U][1] Of
                     'X': begin
                             New(C^[Lig].LX);
                             C^[Lig].LX^:=Copy(Tab128[u],2,Length(Tab128[U]));
                          end;
                     'Y': begin
                           New(C^[Lig].LY);
                           C^[Lig].LY^:=Copy(Tab128[u],2,Length(Tab128[U]));
                          end;
                     'R': begin
                           New(C^[Lig].LR);
                           C^[Lig].LR^:=Copy(Tab128[u],2,Length(Tab128[U]));
                          end;
                     'I': begin
                           New(C^[Lig].LI);
                           C^[Lig].LI^:=Copy(Tab128[u],2,Length(Tab128[U]));
                          end;
                     'J': begin
                           New(C^[Lig].LJ);
                           C^[Lig].LJ^:=Copy(Tab128[u],2,Length(Tab128[U]));
                          end;
                    end;
                    DElete(Tab128[U],2,Length(Tab128[U]));
                    Insert('-30000',Tab128[U],2);
                    StrVar:=Copy(Tab128[u],2,Length(Tab128[u]));
                 End
                else
                if (i=1) And (Tab128[U][1]='L') And
                  (Controle_Formule(Copy(Tab128[u],2,Length(Tab128[U])),i)) Then
                  begin
                   New(C^[Lig].LA);
                   C^[Lig].LA^:=Tab128[u];
                   Tab128[u]:='$-40000';
                   StrVar:=Copy(Tab128[u],2,Length(Tab128[u]));
                  End
                 else
                  begin
                    Erreur_Formule(1,Formule_Erreur,Tab128[1]);
                    Decode_Ligne:=False;
                    Goto Finis;
                  end;
               End
                else
                 begin
                   Erreur_Formule(6,0,Tab128[1]);
                   Decode_Ligne:=False;
                   Goto Finis;
                 end;
            end;  {formule}

           {$R-}
           Val(StrVar,Valeur,Err);
           {$R+}

           if (Err<>0) OR (Valeur>99999.999) Then
           begin
            {Efface_Mesaje;}
            Erreur_Formule(3,0,Tab128[1]);
            Decode_Ligne:=False;
            Exit;
           End
           else
{*a2*}      begin
               Case Tab128[u][1] Of
               'X': W^[lig].X:=Valeur;
               'Y': W^[lig].Y:=Valeur;
               'Z': W^[lig].Z:=Valeur;
               'R': W^[lig].R:=Valeur;
               'I': W^[lig].I:=Valeur;
               'J': W^[lig].J:=Valeur;
               'D': if Round(Valeur) In[1..Max_Outils] Then W^[lig].D:=Round(Valeur);
               'T': if Round(Valeur) In[0..32] Then W^[lig].T:=Round(Valeur);

               'E': begin
                       if Pos('EB',Tab128[u])>0 Then W^[lig].R:=Valeur
                        else
                       if Pos('EX',Tab128[u])>0 Then W^[lig].I:=Valeur
                        else
                       if Pos('EY',Tab128[u])>0 Then W^[lig].J:=Valeur
                        else
                       if Pos('ER',Tab128[u])>0 Then W^[lig].K:=Valeur
                       else
                       if Pos('ED',Tab128[u])>0 Then
                        begin
                           if (Valeur>=0) And (Valeur<=360) Then
                            W^[lig].ED:=Round(Valeur);
                           if C^[Lig].CED<>'ED' Then C^[Lig].CED:='ED';
                        end;
                    end;

               end; { ** case **}
{*a2*}     end;
           Valeur:=0;
{*a1*} end;

      Inc(u);
    end; {**While**}


   if Tab128[1]<>'' Then Inc(Lig);
   Decode_Ligne:=True;
   Finis:
end;



Function SuprimeCommentaires(S:String):String;
 var ch:Char;
    i,nc1,Nc2:Integer;
begin
   nc1:=0;nc2:=0;
   For I:=1 To Length(S) Do
    begin
     if S[i]='(' Then Inc(nc1);
     if S[i]=')' Then Inc(nc2);
   end;
   if nc1<>nc2 Then
   begin
     if nc1>nc2 Then ch:=')'
      else ch:='(';
     SuprimeCommentaires:=Ch;
   End
   else
   begin
   Repeat
      nc1:=Pos('(',S);
      nc2:=Pos(')',S);
      if nc2-nc1>39 Then
      begin
         SuprimeCommentaires:='>40';
         ch:='#';
         nc1:=0;
      End
      else
      if nc1>0 Then Delete(S,nc1,(nc2-nc1)+1);
   Until (nc1=0);
   if ch<>'#' Then
   begin
     I:=Length(S);
     While (S[i]=#32) And (i>0) DO Dec(i);
     if i>0 Then S:=Copy(S,1,i)
      else S:='';
     SuprimeCommentaires:=S;
   end;
   end;
end;


Function VerifyLetreIso(SSS:String):Boolean;
 Var i,LongSSS:Integer;
    Trouve:Boolean;
begin
   LongSSS:=Length(SSS);i:=1;Trouve:=False;
   While (i<=LongSSS) And (Not Trouve) DO
    begin
       if SSS[i] In LetreNotISO Then Trouve:=True
       else
       Inc(i);
    end;
   VerifyLetreISO:=Trouve;
end;


Procedure Lire_Index;
Var SC,ST  : String;
    Lire   : Boolean;
    S      : String;
    kk     : Byte;
    Err,NNN: Integer;
    SN     : String[6];

    Compare, Block:Boolean;

begin
   Scommand:='G1';
   Modale:=TRUE;
   ErreurFile:=0;
   S:='';Err:=1;
   Block:=False;
   N_Number:=0;  {**control denumeration de lignes**}
   TextRec(Fictex).BufPos:=0;
   While (Not Eof(FicTex)) And (Not Block )  Do
    begin
       {$i-}
       Read(Fictex,S);
       {$I+}

       if (S[1]='%') Then
        begin
           S:=Copy(S,2,Length(S));
           if (Pos('(',S)>0)  OR (Pos(')',S)>0) Then
            begin
               S:=SuprimeCommentaires(S+' ');
               if (S='(') OR (S=')') OR (S='>40') then
                begin
                  Efface_Mesaje;
                  if S='>40' Then
                  Mesaje('Error - the commentaire max 40 carct. Stop line: '+
                         '% prog')
                  else
                  Mesaje('Error not "'+S+'" the commentaire.  Line: % prog');
                  KK:=keyBoard;
                  Efface_Mesaje;
                  ErreurFile:=2;
                  Exit;
                end;
            end;

         if S<>'' Then
          begin
           if VerifyLetreISO(S) Then
            begin
               Efface_Mesaje;
               Mesaje('Error - not ISO character.  Stop line: % prog');
               KK:=keyBoard;
               Efface_Mesaje;
               ErreurFile:=2;
               Exit;
            End
          end;

           {$R-}
           Val(S,nnn,Err);
           {$R+}
           
           if (Err=0) Then
            begin
             if (nnn>0) And (nnn<=9999) Then Block:=True
              else Err:=2;
              {$I-}
              ReadLN(FicTex);
              {$I+}
            end;
        end
        else
         begin
            {$I-}
            Readln(FicTex);
            {$I+}
         end;
    end;

   if Err<>0 Then
    begin
       ErreurFile:=12;
       Efface_Mesaje;
       Str(ErreurFile,S);
       Mesaje('ERRR -- Number programm not correct: '+S);
       KK:=KeyBoard;
       Efface_Mesaje;
       Exit;
    end;

   if Block Then
    begin
      Lire:=True;
      Nbr:=1;
     While (Not Eof(FicTex)) And (Lire) And (ErreurFile=0) Do
        begin
           {$I-}
           Readln(Fictex,St);
           {$I+}
           if (Pos('(',ST)>0) OR (Pos(')',ST)>0)  Then
            begin
               St:=SuprimeCommentaires(ST+' ');
               if (ST='(') OR (ST=')') OR (ST='>40') then
                begin
                  if (Nbr>1) And (C^[Nbr-1].CN<>'') Then
                   Sn:=C^[Nbr-1].CN
                  else Str(Nbr,Sn);
                  Efface_Mesaje;
                  if ST='>40' Then
                  Mesaje('Error - the commentaire max 40 carct. Stop line: '+Sn)
                  else
                  Mesaje('Error not "'+ST+'" the commentaire.  Stop line: '+Sn);
                  KK:=keyBoard;
                  Efface_Mesaje;
                  ErreurFile:=2;
                  Exit;
                end;
            end;

           if St<>'' Then
            begin
              if VerifyLetreISO(St) Then
               begin
                 if (Nbr>1) And (C^[Nbr-1].CN<>'') Then
                   Sn:=C^[Nbr-1].CN
                  else Str(Nbr,Sn);
                 Efface_Mesaje;
                 Mesaje('Error - not ISO character.  Stop line: '+Sn);
                 KK:=keyBoard;
                 Efface_Mesaje;
                 ErreurFile:=2;
                 Exit;
               End
            end;

           if St<>'' Then
            begin
             if (Nbr<MaxLig) Then
              begin
               {*Modale:=TRUE;}
               St:=St+' ';
               if Not Decode_Ligne(Nbr,ST) Then Exit;
               {*Modale:=FALSE;}
              End
               else
                begin
                 ErreurFile:=7;
                 Str(MaxLig,SC);
                 Mesaje('Error: Too much lines [maximum:'+Sc+']');
                 ChKey:=keyBoard;
                 Chkey:=27;
                 Efface_Mesaje;
                end;
            end;
        end; { while }
   End
    else ErreurFile:=1;
    Circle_Percage:=False;
   Modale:=FALSE;
end;



Procedure Control(Max:integer);
var i           : Integer;
    X_Max,X_Min : Real;
    Y_Max,Y_Min : Real;

begin
   X_Max:=0;
   X_Min:=0;
   Y_Max:=0;
   Y_Min:=0;
   ECHELLE:=1;
   Echelle2:=False;
   MaxiX:=0;
   MaxiY:=0;
   MiniX:=0;
   MiniY:=0;

   for i:=1 To max Do
    begin
       if W^[i].X>X_Max Then X_Max:=W^[i].X;
       if W^[i].Y>Y_Max Then Y_Max:=W^[i].Y;

       if (W^[i].X>-30000) And (W^[i].X<X_Min) Then
        begin
         if (C^[i].CG<>'G59') And (C^[i].CG<>'G54') Then X_Min:=W^[i].X;
        end;
       if (W^[i].Y>-30000) And (W^[i].Y<Y_Min)  Then
       begin
         if (C^[i].CG<>'G59') And (C^[i].CG<>'G54') Then Y_Min:=W^[i].Y;
       end;
    end;

    MaxiX:=X_Max;MaxiY:=Y_Max;
    MiniX:=X_Min;MiniY:=Y_Min;

    if (ABS(X_Min)+X_Max)>MAX_X-60 Then  Echelle2:=True;
    if (ABS(Y_Min)+Y_Max)>MAX_Y-60 Then  Echelle2:=True;
    if Echelle2 Then
     begin
       ECHELLE:=(ABS(Y_Min)+Y_Max)/(MAX_Y-60);
       if (ABS(X_Min)+X_Max)/(MAX_X-40)>ECHELLE Then
        ECHELLE:=(ABS(X_Min)+X_Max)/(MAX_X-60);

        For i:=1 To max Do
         begin
           if W^[i].X>-30000 Then W^[i].X:=W^[i].X / ECHELLE;
           if W^[i].Y>-30000 Then W^[i].Y:=W^[i].Y / ECHELLE;
           if W^[i].R>-30000 Then W^[i].R:=W^[i].R / ECHELLE;
           if W^[i].I>-30000 Then W^[i].I:=W^[i].I / ECHELLE;
           if W^[i].J>-30000 Then W^[i].J:=W^[i].J / ECHELLE;
          { if W^[i].K>-30000 Then W^[i].K:=W^[i].K / ECHELLE;}


        (***=== anule ==============================================
         * if C^[i].CG='G45' Then
         *   begin
         *      i:=i;
         *      if W^[i].I>-30000 Then W^[i].I:=W^[i].I / ECHELLE;
         *      if W^[i].J>-30000 Then W^[i].J:=W^[i].J / ECHELLE;
         *      if W^[i].K>-30000 Then W^[i].K:=W^[i].K / ECHELLE;
         *   end;
         ****====================================================***)

         end;
     end;
end;



Procedure Open_Fic(Reperto,Neime:String);
begin
    if FileOpen Then
     begin
        {$i-}
        Close(FicTex);
        {$i+}
     end;

    FileOpen:=False;
    FillChar(BufTexte^,SizeOf(Buf___Ptr),#32);
    Assign(FicTex,Reperto+Neime);
    SetTextBuf(FicTex,BufTexte^);
    {$I-}
    Reset(FicTex);
    {$I+}
    if Ioresult= 0 Then
     begin
        Read(Fictex,BufTexte^[1]);
        FileOpen:=TRUE;
     End
      else FileOpen:=False;
end;


Procedure GO_Programme;
Label Pase,Fin_Error;

Var WW,G77_Nbr1,JJ  : integer;
    TXX,TYY,TRR     : Real;
    N1,N2,S,S2      : String;

begin
   if FileOpen Then
    begin
        Graph.SetColor(14);
        Circle(PmX,PmY,4);
        line(PmX+2,PmY,Pmx+2,Pmy+2);
        line(PmX-2,PmY,Pmx+2,Pmy);
        PosX:=0;PosY:=0;
        Graph.SetColor(15);
        MiroirX:=1;
        MiroirY:=1;
        ED_Rotation:=False;
        Angle_ED:=0;
        Reyon_Util:=4;
        Init_Variables;
        Mode:=True;  {* Par defut Mode est G90 *}
        Valeur_de_Z(Haut_Z);
        Fin_M2:=False;
        JJ:=1;
        PosX:=0;PosY:=0;
        Chkey:=0;

        {$IFDEF __Type_M100__}
           Serrage_Piece:=False;
        {$ENDIF}

        While (jj<=Nbr) And (Not Fin_M2) DO
         begin
            Affiche_Line(C^[jj].CN,W^[jj].X,W^[jj].Y);
            Delay(TempoOK);
            {Inc(DeplacementBlocs);}

            if C^[jj].CS<>'' Then
             begin
              if (C^[jj].CS='G90') Then
              begin
                 Mode:=True;
                 Affiche_Mode;
              End
              else
              if C^[jj].CS='G91' Then
               begin
                  Mode:=False;
                  Affiche_Mode;
               end;
             end;

            {$IFDEF __Type_M100__}
            
               if C^[jj].CG='M100' Then Serrage_Piece:=True;
               if C^[jj].CG='M101' Then Serrage_Piece:=False;
            
            {$ENDIF}


            if C^[jj].CG='M6' Then
             begin

               {$IFDEF __Type_M100__}

               if (Not Serrage_Piece) Then
                begin
                  ERREUR_Execution(COTEZ,15,Pos_line,0,0);
                  Goto Fin_Error;
                end;

               {$ENDIF}

               CoteZ:=Haut_Z;
               M6(C^[jj].CN,W^[jj].T,W^[jj].D);
               Valeur_de_Z(Haut_Z);
             End
            else
            if (W^[jj].Z>-30000) And (W^[jj].Z<>CoteZ) Then
              Valeur_de_Z(Round(W^[jj].Z));

            if ((C^[jj].Cx='G41') OR
                (C^[jj].Cx='G42') OR
                (C^[jj].Cx='G40')) Then Decale(C^[jj].Cx);

            if C^[jj].LA <>NIL Then
             begin
               if Controle_Formule(C^[jj].LA^,1) Then
               else ERREUR_Execution(COTEZ,5,Pos_line,Formule_Erreur,0);
               if Calcule_Formule(C^[jj].LA^,1) Then
               else ERREUR_Execution(COTEZ,6,Pos_line,Formule_Erreur,0);
               if (Debugger) And (DebugCode='V') Then
                Debuger_Valeur(Debug_Var,C^[JJ].CN);
             end;

            if C^[jj].LX <>NIL Then
             begin
               if Controle_Formule(C^[jj].LX^,2) Then
               else ERREUR_Execution(COTEZ,5,Pos_line,Formule_Erreur,0);
               if Calcule_Formule(C^[jj].LX^,2) Then
               else ERREUR_Execution(COTEZ,6,Pos_line,Formule_Erreur,0);
               TXX:=Valeur_Variable / ECHELLE;
               if (Debugger) And (DebugCode='V') Then
                Debuger_Valeur(Debug_Var,C^[JJ].CN);
             End
            else
            TXX:=W^[jj].X;

            if C^[jj].LY<>NIL Then
             begin
               if Controle_Formule(C^[jj].LY^,2) Then
               else ERREUR_Execution(COTEZ,5,Pos_line,Formule_Erreur,0);
               if Calcule_Formule(C^[jj].LY^,2) Then
               else ERREUR_Execution(COTEZ,6,Pos_line,Formule_Erreur,0);
               TYY:=Valeur_Variable / ECHELLE;
               if (Debugger) And (DebugCode='V') Then
                Debuger_Valeur(Debug_Var,C^[JJ].CN);
             End
              else
                TYY:=W^[jj].Y;

         TRR:=-30000;

         if (C^[jj].LR<>NIL) And ((C^[jj].CG='G2') OR (C^[jj].CG='G3')) Then
          begin
             if Controle_Formule(C^[jj].LR^,2) Then
              else ERREUR_Execution(COTEZ,5,Pos_line,Formule_Erreur,0);
             if Calcule_Formule(C^[jj].LR^,2) Then
              else ERREUR_Execution(COTEZ,6,Pos_line,Formule_Erreur,0);
             TRR:=Valeur_Variable / ECHELLE;
             if (Debugger) And (DebugCode='V') Then
              Debuger_Valeur(Debug_Var,C^[JJ].CN);
          end
            else
              TRR:=W^[jj].R;

            if (TXX<=-30000) Then TXX:=PosX;
            if (TYY<=-30000) Then TYY:=PosY;

            if (C^[jj].CG<>'G59') And (C^[jj].CG<>'G54')  Then
             begin
              if (Not Mode) And (W^[jj].X>-30000) Then TXX:=PosX+TXX;
              if (Not Mode) And (W^[jj].Y>-30000) Then TYY:=PosY+TYY;
            end;

            if (C^[jj].CED='ED') Then
             begin
                if C^[jj].LED<>NIL Then
                 begin
                  if Controle_Formule(C^[jj].LED^,2) Then
                  else ERREUR_Execution(COTEZ,5,Pos_line,Formule_Erreur,0);
                  if Calcule_Formule(C^[jj].LED^,2) Then
                  else ERREUR_Execution(COTEZ,6,Pos_line,Formule_Erreur,0);
                  if (Valeur_Variable>=0) And (Valeur_Variable<=360) Then
                   begin
                    if mode Then  Angle_ED:=Valeur_Variable
                    else
                    Angle_ED:=Angle_ED+Valeur_Variable;
                    if (Angle_ED>=0) And (Angle_ED<=360) Then
                    ED_Rotation:=TRUE
                    else
                    begin
                    if (W^[jj].ED<>0) Then ERREUR_Execution(COTEZ,4,Pos_line,0,0);
                    ED_Rotation:=False;
                    ED_Rotation:=False;
                    Angle_ED:=0;
                    end;
                   End
                   else
                    ERREUR_Execution(COTEZ,4,Pos_line,0,0);
                 if (Debugger) And (DebugCode='V') Then
                  Debuger_Valeur(Debug_Var,C^[JJ].CN);
                 End   {end -50000}
                else
                if (W^[jj].ED>=0) And (W^[jj].ED<=360) Then
                 begin
                  ED_Rotation:=TRUE;
                  if mode Then  Angle_ED:=W^[jj].ED
                  else
                  Angle_ED:=Angle_ED+W^[jj].ED;
                End
                else
                 begin
                    if (W^[jj].ED<>0) Then ERREUR_Execution(COTEZ,4,Pos_line,0,0);
                    ED_Rotation:=False;
                    ED_Rotation:=False;
                    Angle_ED:=0;
                 end;
             end;


            if (Angle_ED>0) And (Angle_ED<=360) Then
             begin
                if (C^[jj].CG<>'G59') And (C^[jj].CG<>'G54') Then
                 Rotation_SUR_G3(TXX,TYY,Angle_ED)
                else
                 begin
                    Angle_ED:=0;
                    ED_Rotation:=False;
                 end;
             end;


            (*******************************************************************
            * if C^[jj].CG='G59' Then
            * Voir(TXX,TYY,'  '+C^[jj].CN+'  '+C^[jj].CG+' --> Fin Angle');
            *******************************************************************)


            if ((MiroirX=-1) And (W^[jj].X>-30000)) Then TXX:=(TXX * -1);

            if ((MiroirY=-1) And (W^[jj].Y>-30000)) Then TYY:=(TYY * -1);


            if C^[jj].CG='G59' Then
             begin
                 PosX:=0;
                 PosY:=0;
                 G59(TXX,TYY);
                 Goto Pase;
             End
            else
            if C^[jj].CG='G0' Then G0(PosX,PosY,TXX,TYY,C^[jj].CX)
             else
            if C^[jj].CG='G1' Then G1(PosX,PosY,TXX,TYY,C^[jj].CX)
             else
            if (C^[jj].CG='G2') And (MiroirX=1) And (MiroirY=1) Then
              G2(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J)
            else
            if (C^[jj].CG='G3')  And (MiroirX=1) And (MiroirY=1) Then
             begin
              G3(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J)
             End
            else
            if (C^[jj].CG='G2') And ((MiroirX=-1) OR (MiroirY=-1)) Then
             begin
              if (MiroirX=-1) And (MiroirY=-1) Then
               G2(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J)
              else
               G3(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J);
             End
            else
            if (C^[jj].CG='G3')  And ((MiroirX=-1) OR (MiroirY=-1)) Then
             begin
              if (MiroirX=-1) And (MiroirY=-1) Then
               G3(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J)
              else
              G2(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J);
             End
            else
            if C^[jj].CG='M3' Then
             begin
                {$IFDEF __Type_M100__}
                  if (Not Serrage_Piece) Then
                   begin
                     ERREUR_Execution(COTEZ,15,Pos_line,0,0);
                     Goto Fin_Error;
                   end;
                {$ENDIF}
              M3(C^[jj].CN,C^[jj].CX,C^[jj].CY)
             End
            else
            if C^[jj].CG='M4' Then
             begin

                {$IFDEF __Type_M100__}

                  if (Not Serrage_Piece) Then
                   ERREUR_Execution(COTEZ,15,Pos_line,0,0);
                  Goto Fin_Error;

                {$ENDIF}

                M4(C^[jj].CN,C^[jj].CX,C^[jj].CY);
             End
            else
            if C^[jj].CG='M5' Then M5(C^[jj].CN,C^[jj].CX,C^[jj].CY)
            else
            if C^[jj].CG='G45' Then
             begin
                ReserveZ:=CoteZ;
                Valeur_de_Z(0);
                G0(PosX,PosY,TXX,TYY,'');
                Valeur_de_Z(ReserveZ);
                G45(Round(TXX),Round(TYY),Round(W^[jj].I),Round(W^[jj].J),Round(W^[jj].R));
                Valeur_de_Z(Round(W^[jj].K*ECHELLE));
             End
            else
            if C^[jj].CG='G77' Then
             begin
               G77_Nbr1:=0;
               if Affiche_G77(C^[jj].CN,C^[jj].CX,C^[jj].CY,C^[jj].CR,G77_Nbr1) Then
                begin
                  N1:=C^[jj].CX;
                  N2:=C^[jj].CY;
                  if G77_Nbr1>0 Then
                   begin
                     if Formule_Erreur=0 Then
                      begin
                        ww:=1;
                        While (ww<=G77_Nbr1) And (ChKey<>27) DO
                         begin
                            Repeter_Bloc(N1,N2);
                            inc(ww);
                         end;
                      end;
                    End
                   else
                    Repeter_Bloc(N1,N2);
                end;
             End
            else
            if C^[jj].CG='G54' Then G54(TXX,TYY)
            else
          if ((C^[jj].CG='G81') OR (C^[jj].CG='G82') OR (C^[jj].CG='G83') OR
             (C^[jj].CG='G84') OR (C^[jj].CG='G85') OR (C^[jj].CG='G86') OR
             (C^[jj].CG='G87') OR (C^[jj].CG='G88') OR (C^[jj].CG='G89'))
           Then
            begin
              ReserveZ:=CoteZ;
              Valeur_de_Z(0);
              Valeur_de_Z(ReserveZ);
              G81(TXX,TYY, W^[jj].K, C^[jj].CG, C^[jj].CF);
            End
            else
            if C^[jj].CG='G80' Then G80
            else
            if (C^[jj].CN='M2') OR (C^[jj].CG='M2') Then
             begin

                {$IFDEF __Type_M100__}

                 if (Serrage_Piece) Then
                  begin
                   ERREUR_Execution(COTEZ,16,Pos_line,0,0);
                   Goto Fin_Error;
                  end;

                {$ENDIF}

                Fin_M2:=True;
             End
            else
            if C^[jj].CR[1]='M' Then
             begin
                if C^[jj].CR='M2' Then
                 begin

                    {$IFDEF __Type_M100__}

                     if (Serrage_Piece) Then
                      begin
                       ERREUR_Execution(COTEZ,16,Pos_line,0,0);
                       Goto Fin_Error;
                      end;

                    {$ENDIF}

                    Fin_M2:=True;
                 End
                else MMM(C^[jj].CN,C^[jj].CR);
             End
            else
{Miroir}    if C^[jj].CG='G51' Then G51(C^[jj].CN,C^[jj].CX,C^[jj].CY)
            else
            if C^[jj].CG='G79' Then
             begin
                G79(jj,C^[jj].CN,C^[jj].CX,C^[jj].CY);
             end;


            {$IFDEF __Type_M100__}

            if (C^[jj].CG='M101') And (Serrage_Piece) Then
             begin
                Serrage_Piece:=False;
             end;

            {$ENDIF}

            pase:

            ChKey:=GetKeyDelay(Opertion_Tempo);

            if ChKey in [27,62,68] Then
             begin
                case ChKey of
                 27: begin
                       ChKey:=27;
                       Fin_M2:=True;
                     end;
                 62: if Key_Code Then
                     begin
                       Cadriage;
                       ChKey:=0;
                       Inc(jj);
                     end;

                 68: if Key_Code Then
                     begin
                       ERREUR_Execution(CoteZ,14,Pos_Line,0,0);
                       if ChKey = 27 Then
                        begin
                           ChKey:=27;
                           Fin_M2:=True;
                        End
                         else
                           begin
                              Chkey:=0;
                              Inc(jj);
                           end;
                     end;
                end;
             End                 {****if Type_Key <> 0****}
              else Inc(jj);

            if Not ChKey in [27,62,68] Then chKey:=0;



        end; {** while - for **}


        Fin_Error:

    if (ChKey = 27) Then
     begin
        if jj>1 Then N1:=C^[jj].CN
         else N1:='0';
        ERREUR_Execution(COTEZ,13,N1,0,0);
     End
    else
    if ((CoteZ<0) AND (CoteZ>-30000)) OR (BROCHE) Then
     begin
       if Nbr>1 Then N1:=C^[Nbr-1].CN
       else N1:='0';
       ERREUR_Execution(COTEZ,1,N1,0,0);
     end;

    Mode:=True;

    SetTextJustify(CenterText, TopText);
    SetTextStyle(0,0,1);

    OutTextXY(MAX_X div 2, MAX_Y-15, 'End Programm');
    Beep;

    ChKey:=KeyBoard;
    ChKey:=0;
    SetTextJustify(0,0);
    SetTextStyle(0, HorizDir, 0);

  end;
end;


{$I NC_NUM3.PAS}  (*** ficier a inclure***)
  

Function File_Premier(Rep,Nom:String):Boolean;
Var File_OK:Boolean;
begin
    File_OK:=False;
    Init_Table(1);
    Neime:=Nom;
    Init_Table(1);
    if (Nom<>'') Then Open_Fic(Rep,Nom);

    if FileOpen Then
     begin
          DG41:=False;
          DG42:=False;
          DG40:=False;
          PosX:=0.0;
          PosY:=0.0;
          Choix:=6;
          Nom:=Neime;
          File_OK:=True;
     End
     else
      begin
          DG41:=False;
          DG42:=False;
          DG40:=False;
          PosX:=0.0;
          PosY:=0.0;
          Choix:=1;
          Nom:='';
          Neime:='';
          Nom:='';
          File_OK:=False;
      end;
    File_Premier:=File_OK;
end;


Procedure GraPhique_Numeriqe(RepertoireFile1,NomFile1:String);
begin
    BotonX:=1;
    Choix:=1;
    End_Programm_Num:=False;
    ErreurFile:=0;
    Nbr:=0;
    MiroirX:=1;
    MiroirY:=1;
    Circle_Percage:=False;
    Z_G81:='';
    ERG81:='';
    ECHELLE:=1;
    BROCHE:=False;
    Chkey:=0;
    MiniX:=0;
    MiniY:=0;
    MaxiX:=0;
    MaxiY:=0;
    DG41:=False;
    DG42:=False;
    DG40:=True;

    {** Opertion_Tempo et Tempo son initialises sur Ednum.pas **}
    {** Tempo:=50; **}
    {** Opertion_Tempo:=8000;**}
    {**TempoOK:=10; **}

    Marke_Outil:=False;
    Mode:=True;
    Neime:='';
    Nom:='';
    PosX:=0.0;
    PosY:=0.0;
    Outil_Courant:='T0 > D0';
    FileOpen:=False;

    ED_Rotation:=False;
    Angle_ED:=0;
    if NomFile1<>'' then
     begin
         if File_Premier(RepertoireFile1,NomFile1) Then MENUXX(True)
         else
         MENUXX(False);
     End
    else MENUXX(False);
end;

Procedure Init_Table_Ouverture;
Var i:Byte;
begin
    For ix:=1 To MaxLig DO
     begin
       W^[ix].X:=-30000;
       W^[ix].Y:=-30000;
       W^[ix].Z:=-30000;
       W^[ix].R:=-30000;
       W^[ix].I:=-30000;;
       W^[ix].J:=-30000;;
       W^[ix].K:=-30000;;
       W^[ix].D:=255;
       W^[ix].ED:=400;
       W^[ix].T:=255;

       C^[ix].CN:='';
       C^[ix].CG:='';
       C^[ix].CX:='';
       C^[ix].CY:='';
       C^[ix].CR:='';
       C^[ix].CED:='';
       C^[ix].CF:='';
       C^[ix].CS:='';
       C^[ix].LA:=NIL;
       C^[ix].LX:=NIL;
       C^[ix].LY:=NIL;
       C^[ix].LR:=NIL;
       C^[ix].LI:=NIL;
       C^[ix].LJ:=NIL;
       C^[ix].LED:=NIL;
     end;
   Init_Variables;
   CoteZ:=-30000;
   For i:=1 To NumBars DO TabB[i]:=0;
end;

Procedure Numerical;
Var u,i,XX,YY,PPMY:integer;
        PPMX:Integer;
        ColorTT:Byte;
begin
    PPMY:=GetMaxY+120;
    PPMX:=50;
    ColorTT:=15;
    {SetBox(15,4,66,8,3,15,7);}
    SetBox(10,4,71,9,3,15,7);
    SetBox(4,12,79,27,8,15,7);
    SetColor(12);
    SetTextStyle(2,0,4);
    Outtextxy(500,460,'programming: A.ARA');
    SetTextStyle(1,0,1);
    SetTextJustify(0, TopText);
    SetColor(4);
    SetTextStyle(0,0,3);
    Outtextxy(120,68,'NUMERICAL CONTROL');
    Outtextxy(130,105,'      2001');

    SetTextStyle(0,0,0);
    SetViewPort(0,0,GetMAXX,GetMAXy,clipON);
    SetColor(Colortt);

    SetFillStyle(1,3);

    Bar(PPMX+311,PPMY-308,PPMX+327,PPMY-388);
    Bar(PPMX+327,PPMY-374,PPMX+352,PPMY-328);
    Bar(PPMX+327,PPMY-328,PPMX+401,PPMY-315);
    Rectangle(PPMX+311,PPMY-308,PPMX+327,PPMY-388);

    Line(PPMX+206,PPMY-357,PPMX+311,PPMY-357);
    Line(PPMX+327,PPMY-374,PPMX+352,PPMY-374);

    Line(PPMX+352,PPMY-374,PPMX+352,PPMY-328);

    Line(PPMX+352,PPMY-357,PPMX+486,PPMY-357);
    Line(PPMX+486,PPMY-347,PPMX+373,PPMY-347);

    Line(PPMX+486,PPMY-339,PPMX+396,PPMY-339);

    Line(PPMX+327,PPMY-328,PPMX+401,PPMY-328);
    Line(PPMX+401,PPMY-315,PPMX+327,PPMY-315);

    Line(PPMX+401,PPMY-315,PPMX+401,PPMY-328);

    Line(PPMX+206,PPMY-315,PPMX+311,PPMY-315);
    Line(PPMX+206,PPMY-344,PPMX+293,PPMY-344);

    Line(PPMX+486,PPMY-323,PPMX+401,PPMY-323);

    SetColor(Colortt);
    Line(PPMX+242,PPMY-297,PPMX+437,PPMY-297);

    Line(PPMX+178,PPMY-265,PPMX+243,PPMY-297);
    Line(PPMX+374,PPMY-265,PPMX+437,PPMY-296);
    Line(PPMX+374,PPMY-258,PPMX+437,PPMY-290);

    Line(PPMX+178,PPMY-265,PPMX+374,PPMY-265);
    Line(PPMX+374,PPMY-258,PPMX+178,PPMY-258);

    Line(PPMX+374,PPMY-248,PPMX+178,PPMY-248);
    Line(PPMX+374,PPMY-238,PPMX+178,PPMY-238);
    Line(PPMX+374,PPMY-228,PPMX+178,PPMY-228);
    Line(PPMX+374,PPMY-248,PPMX+438,PPMY-280);
    Line(PPMX+374,PPMY-238,PPMX+438,PPMY-270);
    Line(PPMX+374,PPMY-228,PPMX+438,PPMY-260);

    SetColor(14);
    Line(PPMX+319,PPMY-295,PPMX+325,PPMY-308);
    Line(PPMX+319,PPMY-295,PPMX+313,PPMY-308);
    Line(PPMX+319,PPMY-308,PPMX+319,PPMY-295);

    Line(PPMX+321,PPMY-308,PPMX+319,PPMY-295);
    Line(PPMX+323,PPMY-308,PPMX+319,PPMY-295);
    SetColor(3);
    u:=2;
    For i:=1 to 4 DO
    begin
       Line(PPMX+374,PPMY-258+u,PPMX+178,PPMY-258+u);
       Line(PPMX+374,PPMY-258+u,PPMX+438,PPMY-290+u);
       Inc(u,10);
    end;

    SetColor(ColorTT);
    Bar(PPMX+486,PPMY-200,PPMX+521,PPMY-381);
    Line(PPMX+486,PPMY-381,PPMX+506,PPMY-391);
    Line(PPMX+521,PPMY-381,PPMX+541,PPMY-391);
    Line(PPMX+506,PPMY-391,PPMX+541,PPMY-391);
    Line(PPMX+541,PPMY-391,PPMX+541,PPMY-210);

    Rectangle(PPMX+486,PPMY-200,PPMX+521,PPMY-381);
    SetColor(8);
    Rectangle(PPMX+493,PPMY-376,PPMX+516,PPMY-207);
    SetColor(ColorTT);
    Rectangle(PPMX+491,PPMY-376,PPMX+516,PPMY-205);

    PPMY:=GetMaxY-30;
    PPMX:=28;
    u:=0;
    For i:=0 To 10 Do
    begin
       Circle(PPMX+357+u,PPMY-163,2);
       Inc(u,6);
    end;

    XX:=PPMX;
    YY:=PPMY;
    Dec(PPMX,45);
    DEC(PPMY,15);
    {ORDINA}
    SetColor(11);
    REctangle(PPMX+69,PPMY-171,PPMX+176,PPMY-192);

    Line(PPMX+176,PPMY-192,PPMX+202,PPMY-201);
    Line(PPMX+202,PPMY-184,PPMX+176,PPMY-171);
    Line(PPMX+202,PPMY-201,PPMX+202,PPMY-184);
    Line(PPMX+202,PPMY-201,PPMX+181,PPMY-201);

    SetColor(4);
    SetFillStyle(1,7);

    Bar(PPMX+102,PPMY-200,PPMX+160,PPMY-237);
    REctangle(PPMX+102,PPMY-200,PPMX+160,PPMY-237);
    SetFillStyle(1,3);
    SetColor(11);
    REctangle(PPMX+100,PPMY-199,PPMX+160,PPMY-237);
    REctangle(PPMX+97,PPMY-195,PPMX+165,PPMY-242);

    Line(PPMX+116,PPMY-245,PPMX+181,PPMY-245);
    Line(PPMX+181,PPMY-200,PPMX+181,PPMY-245);
    Line(PPMX+97,PPMY-242,PPMX+116,PPMY-245);
    Line(PPMX+165,PPMY-242,PPMX+181,PPMY-245);
    Line(PPMX+165,PPMY-195,PPMX+181,PPMY-200);
    Line(PPMX+69,PPMY-192,PPMX+97,PPMY-199);

    REctangle(PPMX+76,PPMY-177,PPMX+112,PPMY-180);
    REctangle(PPMX+76,PPMY-184,PPMX+112,PPMY-188);

    REctangle(PPMX+55,PPMY-150,PPMX+135,PPMY-152);

    Line(PPMX+80,PPMY-168,PPMX+163,PPMY-168);

    Line(PPMX+55,PPMY-152,PPMX+80,PPMY-168);
    Line(PPMX+135,PPMY-152,PPMX+163,PPMY-168);
    {***}
    Line(PPMX+135,PPMY-150,PPMX+163,PPMY-166);
    u:=0;

    For i:=0 To 9 Do
    begin
       Line(PPMX+140+u,PPMY-188,PPMX+140+u,PPMY-176);
       Inc(u,3);
    end;
    SetColor(1);
    u:=0;
    For i:=0 To 5 Do
    begin
       Circle(PPMX+107+u,PPMY-230,1);
       Circle(PPMX+107+u,PPMY-225,1);
       Circle(PPMX+107+u,PPMY-220,1);
       Circle(PPMX+107+u,PPMY-215,1);
       Circle(PPMX+107+u,PPMY-210,1);
       Circle(PPMX+107+u,PPMY-205,1);
       Inc(u,4);
    end;
    SetColor(11);
    u:=0;
    For i:=0 To 10 Do
    begin
       Circle(PPMX+85+u,PPMY-164,1);
       Circle(PPMX+78+u,PPMY-160,1);
       Circle(PPMX+71+u,PPMY-156,1);
       Inc(u,6);
    end;
    SetColor(15);
    Inc(PPMX,30);
    Inc(PPMY,35);

    SetBox(7,21,21,26,3,15,7);
    SetFillStyle(1,7);
    Bar(PPMX+45,PPMY-140,PPMX+88,PPMY-110);
    SetFillStyle(1,3);
    SetColor(14);
    Outtextxy(180,210,#27);
    Line(185,213,195,213);
    Outtextxy(180,350,#27);
    Line(195,214,195,353);
    Outtextxy(220,280,#26);
    Line(185,353,195,353);
    Line(195,283,220,283);

    SetColor(15);
    Rectangle(PPMX+43,PPMY-142,PPMX+90,PPMY-108);
    Rectangle(PPMX+45,PPMY-140,PPMX+88,PPMY-110);
    u:=0;
    For i:=0 To 7 Do
    begin
       Circle(PPMX+45+u,PPMY-98,2);
       Circle(PPMX+45+u,PPMY-88,2);
       Circle(PPMX+45+u,PPMY-78,2);
       Circle(PPMX+45+u,PPMY-68,2);
       Inc(u,6);
    end;
    u:=0;
    For i:=0 To 6 Do
    begin
       Circle(PPMX+107+u,PPMY-130,2);
       Circle(PPMX+107+u,PPMY-120,2);
       Circle(PPMX+107+u,PPMY-100,2);

       Circle(PPMX+107+u,PPMY-80,2);
       Circle(PPMX+107+u,PPMY-70,2);
       Inc(u,6);
    end;

end; {numerical}


PROCEDURE InitGraphique;
begin
  Initialise_Graphique;
  Debugger:=False;
  N_Number:=0;
  FIN_M2:=True;
  ED_Rotation:=False;
  Angle_ED:=0;
  Reyon_Util:=4;
  ZX:=0; ZY:=0; ZZ0:=0;
  C:=Nil;
  W:=Nil;
  GetMem(BufTexte,SizeOf(Buf___Ptr));
  New(W);
  New(C);
  Init_Table_Ouverture;
  if (BufTexte<>Nil) And (W<>Nil) And (C<>Nil)  Then
   begin
      Size_Menu_Buf:=ImageSize(1,1,30,30);
      GetMeM(Menu_Buf,Size_Menu_Buf);
      SetLineStyle(0,0,0);
      Numerical;
      ix:=KeyBoard;
      {ix:=GetKeyDelay(32000);}
      REstoreCRTMODE;
   End
  else
   begin
       Writeln('Error: Pas asez de Memoire vive.');
       Writeln('Liberer la memoire ou retirer les les programmes r‚sidents.');
       Writeln('Pressez une touche');
       ch:=Readkey;
       Halt(1);
   end;
end; { De Proc‚dure Init}


Procedure Metre_un_Veille;
Const
  Seed   = 1958; { Valeur semence du g‚n‚rateur al‚atoire }
  NumPts = 2100; { Quantit‚ de pixels … traiter           }
  PPP    = 4;
Var
  III,XXX, YYY, Color : WORD;
  XXMax, YYMax  : INTEGER;
  _ViewInfo     : ViewPortType;
  ColorPoint    : Integer;
  Max__Color    : WORD;

begin
  Randomize;                { Init g‚n‚rateur de nombres al‚atoire     }
  Max__Color := Graph.GetMaxColor;  { R‚cup + grand num‚ro de couleur de trac‚ }
  GetViewSettings(_ViewInfo);
  WITH _ViewInfo DO
  begin
    XXMax := (x2-x1-1);
    YYMax := (y2-y1-1);
  end;

  WHILE NOT KeyPressed DO
  begin
    {** Pose pixels al‚atoires **}
    RandSeed := Seed;
    III := 0;
    WHILE (NOT KeyPressed) AND (III < NumPts) DO
    begin
      Color:=Random(Max__Color)+1;
      if  Color>0 Then
       begin
          Inc(III);
          Graph.PutPixel(Random(XXMax), Random(YYMax), Color);
       end;
    end;

    {** Efface pixels **}

    RandSeed := Seed;
    III := 0;
    WHILE (NOT KeyPressed) DO
    begin
      XXX     := Random(XXMax)+1;
      YYY     := Random(YYMax)+1;
      Color := Random(Max__Color)+1;
      ColorPoint := Graph.GetPixel(XXX, YYY);

      if  (Graph.GetPixel(XXX, YYY)<>0) And (Color>0) And
          (Color<>ColorPoint) Then
       begin
          if (iii=0) And (XXX-PPP>0) And (XXX-PPP<XXMax) And (YYY-PPP>0) And
             (YYY-PPP<YYMax) Then
           begin
            Graph.PutPixel(XXX, YYY, 0);
            Graph.PutPixel(XXX-PPP, YYY-PPP, Color);
            iii:=1;
           End
          else
          if (iii=1) And (XXX+PPP>0) And (XXX+PPP<XXMax) And (YYY+PPP>0) And
             (YYY+PPP<YYMax) Then
           begin
            Graph.PutPixel(XXX, YYY, 0);
            Graph.PutPixel(XXX+PPP, YYY+PPP, Color);
            iii:=0;
           end;
       end;
    end;
  end;
end;    {** Metre_un_Veille **}

End.

©® document original sources pascal
  
Page Last Updated: Juin 27, 2011 | Page Editor: A. Ara | SiteMap Dans Une Autre Galaxie
Cet emplacement web non-commercial, et totalement libre & indépendant de tout les parti politique ou d'organisme officiel de toute nature. Nous réflexions sont exclusivement l'avis de personnes qui rejettent le massacre que la société fait aux animaux pour tout motif.