IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

La Commande Numérique sur la Production Bois

Date de publication : 06/03/2010. Date de mise à jour : 03/07/2011.


   

 


Unité Graphe Trace.PAS


Unité Graphe Trace.PAS


{==============  FICHIER DE EDNUM  =====================}
{ Unite Graphe Trace.pas  Usinage machines a c.n.       }
{ programmation Pascal                                  }
{ Copyright (S) 1997-2011                               }
{ programmeur du programme A.Ara                        }
{ 64150 Mourenx ville France.                           }
{ Licence d'utilisation accord dans un but démonstratif }
{ Unite Graphe Trace.pas: graphiques EDnum c.n du bois  }
{=======================================================}

{=======================================================}
{                                                       }
{ ED9FNUM  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 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.

{**========end file unite ========**}

   

 

 

Valid XHTML 1.0 TransitionalValid CSS!

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2011 A. Ara. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.