La Commande Numérique sur la Production Bois

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

{$O+,F+}

Unit H_CALCUL;

Interface

Type ST5 =string[5];


Function  HexStr(Number: WORD): ST5;
Procedure Calculatrice(X1,Y1:Byte;SS2,SS3:string;Tot,TotM:extended);
Procedure DONNE_ROTATION_G3(X1,Y1:Byte);
Procedure Cherche_Rayon(X1,Y1:Byte);
Procedure Calcul_Centre_ARC(X1,Y1:Byte);


Var
    Calculatrice_Total  : extended;
    Calculatrice_TotalM : extended;
    Calculatrice_S2     : string;
    Calculatrice_S3     : string;


Implementation

Uses Crt,Box13,Mathes,Get_Key;


Const
      Sqr_Limit = 1E2466;

 var  Error_Real:Integer;


Procedure Printnum(x,y:Byte;NN:Real);
var s:string[10];

begin
    Putxy(x,y,'           ');
    Str(NN:5:3,s);
    Putxy(x,y,s);
end;




Function HexStr(Number: WORD): ST5;

     Function HexChar(Number: Word): Char;
      begin
       if Number<10 Then HexChar:=Char(Number+48)
       else
       HexChar:=Char(Number+55);
      end; {*HexChar*}


VAR  s: ST5;

begin
   s:= '';
   if Number>255 Then
    begin
       S      := HexChar( (Number SHR 1) div 2048);
       Number := ( ((Number SHR 1) MOD 2048) SHL 1)+(Number and 1);
       S      := S+HexChar(Number div 256);
       Number := Number MOD 256;
    end;

   S      := S+HexChar(Number DIV 16);
   Number := Number MOD 16;
   S      := S+HexChar(Number);

   HexStr:=S+'h';

end;{*ends HexStr*}




{================================================}
{ Calculatrice position sur X1 et Y1             }
{================================================}

Procedure Calculatrice(X1,Y1:Byte;SS2,SS3:string;Tot,TotM:extended);
Const 
      Eff='                       ';
      N=10;
      bac:Array[1..10] OF Word =(1,2,4,8,16,32,64,128,256,512);
      MaxReal=9999999999999999.0;
      MinReal=-9999999999999999.0;

Var Total,TotalM      : extended;    {***Real;****}
    aff_3,S           : string;
    aff_2             : string;
    Keyy,Xc,Yc        : byte;
    Worde             : Longint;
    Err               : integer;
    Rnn,nn            : Extended;
    Nstr              : string[10];
    Ch                : Char;
    i,nc              : byte;
    y,X               : byte;
    Ecran             : byte;
    ColorAttr         : byte;
    Mode              : Char;


Function Control_Valeur(num:extended):string;
Var SN2,Sn:string[20];

begin
   if (NUM>999999999999999.0) or (NUM<-99999999999999.0) Then
    begin
       Sn:='';
       Sn2:='';
       Str(NUM,Sn);
       SN2:=Copy(Sn,Pos('E',Sn),Length(Sn));
       Sn:=Copy(sn,1,9)+Sn2;
       Control_Valeur:=Sn;
       Error_Real:=0;
    end
   else
    begin
       Str(Num:9:3,Sn);
       Error_Real:=0;
       Control_Valeur:=Sn;
    end;
end;





Function Bin(n:Word):string;
var ss,s : string;
    S1   : string[1];
    nx   : Word;

begin
   s:='';
   ss:='';

   While n>1 Do
    begin
       Nx:=n Mod 2;
       Str(nx,S1);
       S:=S+S1;
       n:=n div 2;
    end;

   Str(n,S1);
   S:=S+S1;

   if Length(S)>8  Then Insert(' ',S,9);
   if Length(S)>4  Then Insert(' ',S,5);

   for nx:=Length(s) Downto 1  DO SS:=SS+S[nx];
   Bin:=SS;

end;


begin
    Ecran      :=Lo(WindMin);
    Total      :=Tot;              {*Calculatrice*}
    TotalM     :=TotM;             {*Calculatrice*}
    NN:=0;Rnn  :=0;
    ColorAttr  :=TextAttr;
    textAttr   :=Menu_Color;

    BoxFill(X1,Y1,X1+26,Y1+11,' ');
    textAttr:=116;
    Rectangle(X1,Y1,X1+26,Y1+11,Double);
    Putxy(X1+8,Y1,' Calculator ');
    Rectangle(X1+1,Y1+5,X1+25,Y1+7,Simple);
    textAttr:=Menu_Color;
    Putxy(X1+2,Y1+8,' +   -  Hex  M+ Dec  AC');
    Putxy(X1+2,Y1+9,' *   /  Bin  M-  =   MC');
    Putxy(X1+2,Y1+10,'Sin Cos Tan Rac  Xý  PI');

    Str(total:8:3,S);
 
    Putxy(X1+24-Length(S),Y1+2,S);
    BoxFill(X1+1,Y1+5,X1+25,Y1+7,' ');
    Rectangle(X1+1,Y1+5,X1+25,Y1+7,Simple);
   
    Xc:=X1+18;
    Yc:=Y1+9;
   
    HighBox(xc,yc,xc+2,yc,BX);
   
    {------------------------}
    
    X:=X1+3;
    Y:=Y1+6; 
    Err:=1; 
    nn:=0; 
    Nc:=1;

    Posxy(x,y);
    Nstr   :='';
    Mode   :='D';
    KeyNum(On);

    if totalM <> 0 Then
     begin
        Putxy(X1+2,Y1+1,'M                      ');
        Str(TotalM:10:3,S);
        Putxy(X1+4,Y1+1,S);
     end;

    Putxy(X1+24-Length(SS2),Y1+2,SS2);
    Aff_2:=SS2;
    Putxy(X1+24-Length(SS3),Y1+3,SS3);
    aff_3:=SS3;

    S:=Control_Valeur(Total);
    S:='= '+S;
    Putxy(X1+24-Length(S),Y1+4,S);

    Repeat

       Ch:=ReadKey;

{Del}  if (Ord(Ch)=8) and (nc>1) Then
        begin
           NStr:=Copy(NStr,1,LengTh(NStr)-1);
           Posxy(Ecran+WhereX-1,Y);             {**Wherex = position curseur +1 du cadre**}
           Write(' ');
           Posxy(Ecran+WhereX-1,Y);
           Nc:=Nc-1;
        end
       else
{Hex}  if (Yc=Y1+8) and (Xc=X1+10) and (Ord(Ch)<>13) and (Nc<=N) and (Ch in['A'..'F','a'..'f','0'..'9']) then
        begin
           if Mode<>'H' Then
            begin
               Nstr:='';
               Putxy(X1+2,Y1+6,eff);
               X:=X1+3;
               Posxy(x,Y);
               Nc:=1;
               Mode:='H';
            end;
           NStr:=NStr+Ch;
           Write(Ch);
           Nc:=nc+1;
        end
       else
{Bin}  if (Yc=Y1+9) and (Xc=X1+10) and (Ord(Ch)<>13) and (Nc<=N) and (Ch in['0','1']) then
        begin
           if Mode<>'B' Then
            begin
               Nstr:='';
               Putxy(X1+2,Y1+6,eff);
               X:=X1+3;
               Posxy(x,Y);
               Nc:=1;
               Mode:='B';
            end;
 
          NStr:=NStr+Ch;
          Write(Ch);
          Nc:=nc+1;
        end
       else
{Ent}  if (Ord(Ch)<>13) and (Nc<=N) and (Ch in['0'..'9','-','.']) and
            (((Yc-Y1=8) and (XC-X1 In[2,6]))   or
            ((Yc-Y1=9) and (XC-X1 In[2,6,18])) or
            ((Yc-Y1=10) and (XC-X1 In[2,6,10,14,18])))  then
         begin
            if Mode<>'D' Then
             begin
                Nstr:='';
                Putxy(X1+2,Y1+6,eff);
                X:=X1+3;
                Posxy(x,Y);
                Nc:=1;
                Mode:='D';
             end;

            NStr:=NStr+Ch;
            Write(Ch);
            Nc:=nc+1;
         end
       else
{->}   if (ORD(CH)=77) and ( (Xc-X1<22)) Then  
        begin
           HighBox(xc,yc,xc+2,yc,BX);
           inc(xc,4);
           HighBox(xc,yc,xc+2,yc,BX);
        end
       else
{<-}  if (ORd(CH)=75) and  ((Xc-X1)>2) Then
        begin
           HighBox(xc,yc,xc+2,yc,BX);
           dec(xc,4);
           HighBox(xc,yc,xc+2,yc,BX);
        end
       else
{F/B} if (Ord(CH)=80) and (Yc<Y1+10)  Then
        begin
           HighBox(xc,yc,xc+2,yc,BX);
           inc(Yc);
           HighBox(xc,yc,xc+2,yc,BX);
        end
       else
{F/H} if (ORd(CH)=72) and (yc>Y1+8) Then
        begin
           HighBox(xc,yc,xc+2,yc,BX);
           dec(Yc);
           HighBox(xc,yc,xc+2,yc,BX);
        end
       else

      if ORD(Ch)=13 Then
       begin
          Putxy(X1+2,Y1+6,eff);
          Str(Total:10:3,S);
          Putxy(X1+3,Y1+2,eff);
          Putxy(X1+24-Length(S),Y1+2,S);

          Aff_2:=S;
          X:=X1+3;
          Posxy(x,Y);
          Nc:=1;
{+-*/}
          if ((Nstr<>'') and ((xc-X1) in[2,6]) and (Yc<=Y1+9)) OR
             ((Yc-Y1=10) and (XC-X1 In[2,6,10,14,18,22]))  Then
           begin
              if ((Yc-Y1=10) and (XC-X1 In[2,6,10,14,18,22])) and (Nstr='') Then Nstr:='0';
 
             {$R-}
               Val(Nstr,nn,Err);
             {$R+}

             if Err<>0 Then
              begin
                  Ch:=' ';
                  NStr:='';
              end
             else
              begin
                 if (NN=0) and (Yc-Y1=10) Then
                   Case (Xc-X1) of
                     2,6,10: if (Total>0.3) and (total<=360) Then Str(Total:10:3,S)
                             else S:='        NUL';
     
                         14: if (Total>0) Then Str(Abs(Total):10:3,S)
                             else S:='        NUL';

                         18: Str(Total:10:3,S);

                         22: begin
                                {$R-}
                                  Str(PI:2:6,S);
                                {$R+}           
                                S:='   '+S;
                             end;
                   end {case}

                  else
                    S:=Control_Valeur(nn);

                  if Yc=Y1+8 Then
                    Case (Xc-X1) OF
                      2: S:='+ '+S;
                      6: S:='- '+S;
                    end
                   else

                   if Yc=Y1+9 Then
                    Case (Xc-X1) OF
                      2: S:='* '+S;
                      6: S:='/ '+S;
                    end
                   else

                   if Yc=Y1+10 Then
                    Case (Xc-X1) OF
                       2: S:='Sin'+S;
                       6: S:='Cos'+S;
                      10: S:='Tan'+S;
                      14: S:='Rac'+S;
                      18: S:='Xý'+S;
                      22: S:='PI'+S;
                    end;

                   if (Yc=Y1+8) Then
                    Case (xc-X1) OF
                      2: if ((Total+nn)<MaxReal) and ((Total+nn)>MinReal) Then Total:=Total+nn
                         else Error_Real:=1;
                      6: if ((Total-nn)<MaxReal) and ((Total-nn)>MinReal) Then Total:=Total-nn
                         else Error_Real:=1;
                    end
                    else

                    if (Yc=Y1+9) Then
                     Case (Xc-X1) OF
                       2: if ((Total*nn)<MaxReal) and ((Total*nn)>MinReal) Then
                          Total:=Total*nn
                          else Error_Real:=1;
                       6: if (NN <>0) and ((Total*nn)<MaxReal) and ((Total*nn)>MinReal) Then
                            Total:=Total/nn
                          else Error_Real:=1;
                    end
                    else

                    if (Yc=Y1+10) Then
                     Case (Xc-X1) OF
                      2: if (NN>0) and (NN<=360) Then Total:=Sinu(nn)
                         else
                         if (total>0) and (total<=360) Then Total:=Sinu(total)
                         else Total:=0;

                      6: if (NN>0) and (NN<=360) Then Total:=Cosi(nn)
                         else
                         if (total>0) and (total<=360) Then Total:=Cosi(total)
                         else Total:= 0;

                      10: if (NN>0) and (NN<=360) Then Total:=Tang(nn)
                         else
                         if (total>0) and (total<=360) Then Total:=Tang(total)
                         else Total:= 0;
                      14: if (NN>0) Then
                           begin
                              {$R-}
                              Total:=SQRT(ABS(nn));
                              {$R+}
                              if Ioresult<> 0 Then
                               begin
                                   Error_Real:=1;
                                   Total:=0;
                                end;
                           end
                           else
                           if Total>0 Then
                            begin
                                {$R-}
                                Total:=SQRT(ABS(Total));
                                {$R+}
                                if Ioresult <> 0 Then
                                 begin
                                    Error_Real:=1;
                                    Total:=0;
                                 end;
                             end
                            else  begin
                                     Error_Real:=1;
                                     Total:=0;
                                  end;

                      18: begin
                           if (nn = 0) Then nn:=Total;
                           if (nn < -SQR_LIMIT) or (nn > SQR_LIMIT) then
                            begin
	                       Error_Real:=1;
                               Total:=0;
                            end
                           else
                            begin
                              if ((nn*nn)<MaxReal) and ((nn*nn)>MinReal) Then
                               begin
                                 {$R-}
                                   Total:=Sqr(NN);
                                 {$R+}

                                 if Ioresult<> 0 Then
                                  begin
                                     Error_Real:=1;
                                     Total:=0;
                                  end;
                               end
                                else begin
                                        Error_Real:=1;
                                        Total:=0;
                                      end;
                            end;
                          end;

                      22: begin
                            {$R-}
                              Total:=PI;
                            {$R+}

                            if Ioresult <> 0 Then
                             begin
                                Error_Real:=1;
                                Total:=0;
                             end
                            else Error_Real:=0;
                          end;
                     end;{*case*}


                    if Error_Real = 0 Then
                     begin
                        Putxy(X1+3,Y1+3,eff);
                        Putxy(X1+24-Length(S),Y1+3,S);
                        aff_3:=S;
                        Putxy(X1+1,Y1+4,Eff);
                        S:=Control_Valeur(Total);
                        S:='= '+S;
                        Putxy(X1+24-Length(S),Y1+4,S);
                     end
                    else
                      begin
                         Putxy(X1+1,Y1+4,Eff);
                         S:='Error';
                         Putxy(X1+24-Length(S),Y1+4,S);
                      end;

                    NStr:='';
                    RNN:=NN;
                    NN:=0;
                    Error_Real:=0;
                 end;
           end
          else

{AC}      if (xc-X1=22) and (yc=Y1+8)  Then
           begin
              Putxy(X1+1,Y1+2,eff);
              Putxy(X1+1,Y1+3,eff);
              Putxy(X1+1,Y1+4,eff);
              Aff_2:='';
              Aff_3:='';
              Total:=0;
              Str(Total:10:3,S);
              Putxy(X1+24-Length(S),Y1+4,S);
              NStr:='';
              NN:=0;
              RNN:=0;
              HighBox(xc,yc,xc+2,yc,BX);
              xc:=X1+18;
              yc:=Y1+9;
              HighBox(xc,yc,xc+2,yc,BX);
              Mode:='D';
           end
          else

{hex}     if (xc-X1=10) and (yc=Y1+8) Then
           begin
              if (Nstr<>'') Then
               begin
                  if Mode='H' Then Nstr:='$'+Nstr;
                  {$R-}
                    Val(Nstr,Worde,Err);
                  {$R+}

                  if (Err=0) and (Worde>=0) and (Worde<=65535) Then S:=HexStr(Worde)
                  else
                    begin
                        S:='Error';
                        Worde:=0;
                    end;
 
                  Putxy(X1+1,Y1+3,eff);
                  Putxy(X1+1,Y1+4,eff);
                  Putxy(X1+24-Length(S),Y1+3,S);
 
                  aff_3:=S;

                  Str(Worde,S);
                  total:=Worde;
                  S:=Control_Valeur(Total);
                  S:='= '+S;

                  Putxy(X1+24-Length(S),Y1+4,S);
                  NStr:='';
                  Rnn:=Worde;
                  Worde:=0;
               end
              else

              if ((Rnn <= 65535) and (Rnn >= 0)) Then
                begin
                   Putxy(X1+1,Y1+3,eff);
                   Putxy(X1+1,Y1+4,eff);
                   S:=HexStr(Trunc(RNN));
                   Putxy(X1+24-Length(S),Y1+3,S);
                   aff_3:=S;
                   Str(Rnn:10:3,S);
                   total:=Rnn;
                   S:=Control_Valeur(Total);
                   S:='= '+S;
                   Putxy(X1+24-Length(S),Y1+4,S);
                end;
           end
          else

{ = }     if (xc-X1=18) and (yc=Y1+9) Then
           begin
              {$R-}
                Val(Nstr,nn,Err);
              {$R+}

              if Err <> 0 Then
               begin
                  Ch  :=' ';
                  X   :=X1+3;
                  Nstr:='';
               end
              else
               begin
                  Putxy(X1+3,Y1+2,eff);
                  Putxy(X1+3,Y1+3,eff);
                  S:=Control_Valeur(NN);
                  Putxy(X1+3,Y1+4,eff);
                  Putxy(X1+24-Length(S),Y1+2,S);
                  Aff_2:=S;
                  Putxy(X1+24-Length(S),Y1+3,S);
                  aff_3:=S;
                  Putxy(X1+24-Length(S),Y1+4,S);
                  NStr:='';
                  Total:=NN;
                  RNN:=NN;
                  NN:=0;
               end;
           end
          else

{M+}      if (xc-X1=14) and (yc=Y1+8) Then
           begin
              if ((Total+TotalM)<=MaxReal) and ((Total+TotalM)>=MinReal)  Then
               begin
                  TotalM:=TotalM+Total;
                  Putxy(X1+2,Y1+1,'M                      ');
                  Str(TotalM:10:3,S);
                  Putxy(X1+4,Y1+1,S);
               end;
           end
          else

{M-}      if (xc-X1=14) and (yc=Y1+9) Then
           begin
              if ((Total-TotalM)<=MaxReal) and ((Total-TotalM)>=MinReal)  Then
               begin
                  TotalM:=TotalM-Total;
                  Putxy(X1+2,Y1+1,'M                      ');
                  Str(TotalM:10:3,S);
                  Putxy(X1+4,Y1+1,S);
               end;
           end
          else

{C}       if (xc-X1=22) and (yc=Y1+9) Then
           begin
              TotalM:=0;
              Putxy(X1+1,Y1+1,eff+' ');
              HighBox(xc,yc,xc+2,yc,BX);
              xc:=X1+18;
              yc:=Y1+9;
              HighBox(xc,yc,xc+2,yc,BX);
           end
          else

{Bin}     if (xc-X1=10) and (yc=Y1+9) Then
           begin
              if Nstr<>''  Then
               begin
                  RNN:=0;
                  Nc:=1;
                  For i:=Length(Nstr) Downto 1 DO
                   begin
                      if Nstr[i]='1' Then Rnn:=Rnn+Bac[Nc];
                      Inc(Nc);
                   end;
                  S:=Bin(Trunc(Rnn))+' b';
                  Nc:=1;
               end
              else
               begin
                   if (RNN<64000) and (RNN>0) Then S:=Bin(Trunc(RNN))+' b'
                   else S:='Error';
               end;

              Putxy(X1+1,Y1+3,eff);
              Putxy(X1+1,Y1+4,eff);
              Putxy(X1+24-Length(S),Y1+3,S);

              aff_3:=S;
              total:=Rnn;
              S:=Control_Valeur(Total);
              S:='= '+S;
              Putxy(X1+24-Length(S),Y1+4,S);

              NStr:='';
              NN:=0;
           end
          else

{Dec}     if (xc-X1=18) and (yc=Y1+8) Then
           begin
              Str(Rnn:10:3,S);
              Putxy(X1+1,Y1+3,eff);
              Putxy(X1+1,Y1+4,eff);
              Putxy(X1+24-Length(S),Y1+3,S);
              aff_3:=S;

              S:=Control_Valeur(Total);
              S:='= '+S;
              Putxy(X1+24-Length(S),Y1+4,S);
           end;
       end; {*end = 13*}

    Until ORd(Ch)=27;

    Calculatrice_Total  :=Total;
    Calculatrice_TotalM:=TotalM;
    Calculatrice_S2     :=aff_2;
    Calculatrice_S3     :=aff_3;
    textAttr:=ColorAttr;

end;{*ends Calculatrice*}






Procedure G3_XY2(Var X,y:Real;Rayon:Real;grd:Integer);
Var X1,Y1:Real;
begin
    Y1:=(Sin(Pi*grd/180)*Rayon);
    X1:=SQRT(SQR(Rayon)-SQR(Y1));
    if (grd<91) OR (grd>270) Then x:=Round(X1)+X
    else
    x:=X-Round(X1);
    Y:=Round(Y1)+Y;

end;{*G3_XY2*}




{=========================================}
{ Rotation sens G3 valeur de angle        }
{=========================================}
Procedure Rotation_SUR_G3(Var X,Y:Real;Angle:REAL);
Var XX,YY:Real;

begin
   if (Angle>=0) and (Angle<=360) Then
    begin
       XX:= (X*Cosi(Angle)) - (Y*Sinu(Angle));
       YY:= (X*Sinu(Angle)) + (Y*cosi(Angle));
       X:=XX;
       Y:=YY;
    end;
end;{*Rotation_SUR_G3*}




Procedure DONNE_ROTATION_G3(X1,Y1:Byte);
Var Key,Y,Chois : Byte;
    n,DX1,DY1,
    CENX,CENY,
    RX,RY       :REAL;
    Ang         :Real;
    Snx,snY     :string[9];
    ColorAttr   :byte;

begin
   DX1 :=0.0;
   DY1 :=0.0;
   Rx  :=0.0;
   Ry  :=0.0;
   CenX:=0.0;
   CenY:=0.0;
   Ang :=0.0;

   ColorAttr:=textAttr;
   textAttr:=Menu_Color;

   BoxFill(X1,Y1,X1+30,Y1+8,' ');
   Rectangle(X1,Y1,X1+30,Y1+8,Double);
   Putxy(X1+10,Y1,' Rotation G3 ');
   Putxy(X1+10,Y1+8,' F1 = Calcul ');

   Putxy(X1+3,Y1+1,'Centre X     :');
   Putxy(X1+3,Y1+2,'Centre Y     :');
   Putxy(X1+3,Y1+3,'Angle        :');
   Putxy(X1+3,Y1+4,'Coordinate X :');
   Putxy(X1+3,Y1+5,'Coordinate Y :');
   
   Y:=1;
   HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
   
   Repeat

      CSOFF;
      Key:=KeyBoard;
      if (Key=80) and (Y<5)  Then
       begin
          HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
          inc(Y);
          HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
       end
      else
      if (Key=72) and (Y>1)  Then
       begin
          HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
          Dec(Y);
          HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
       end
      else
      if (Not Key_Code) and ((Key=13) OR (Key In[45,48..57])) Then
       begin
          HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
          N:=0;
          N:=READREAL(X1+19,Y+Y1,10,key);

          if (N>100000) OR (N<-100000) Then Key:=27;
   
          Case y Of
            1: if Key=27 Then Printnum(X1+19,Y+Y1,CenX)
               else cenX:=N;
            2: if Key=27 Then Printnum(X1+19,Y+Y1,CenY)
               else CenY:=N;
            3: if (Key=27) OR ((N<=0) OR (N>360)) Then Printnum(X1+19,Y+Y1,Ang)
               else Ang:=N;
            4: if Key=27 Then Printnum(X1+19,Y+Y1,DX1)
               else DX1:=N;
            5: if Key=27 Then Printnum(X1+19,Y+Y1,DY1)
               else DY1:=N;
          end;

          if Y<5 Then Inc(Y)
          else Y:=1;
          HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
          Key:=0;
       end;

      if (Key_Code) and (Key=59) Then
       begin
          RX:=DX1-CenX;RY:=DY1-CenY;
          Rotation_SUR_G3(RX,RY,Ang);
          Str(RX+CenX:5:3,Snx);
          Str(RY+CenY:5:3,Sny);
          textAttr:=116;
          Putxy(X1+3,Y1+6,'Rotation   X : '); Putxy(X1+19,Y1+6,Snx);
          Putxy(X1+3,Y1+7,'Rotation   Y : '); Putxy(X1+19,Y1+7,Sny);
          textAttr:=Menu_Color;
       end;
   Until Key=27;

   textAttr:=ColorAttr;

end;{*ends donne rotation*}





Function Angle__G3(XX1,YY1,CXX,CYY,RR:REal):Integer;
var Angle:Real;

begin
   Angle:=400;

   {*depar position 0*}

   if YY1>CYY Then
    begin
       if XX1>CXX Then
         Angle:=Radian_Degre(ArcSin((YY1-CYY)/RR))
       else
       if XX1<CXX Then
         Angle:=Radian_Degre(ArcSin((CXX-XX1)/RR))+90
       else
       if (Round((YY1-RR))=Round(CYY)) and (Round(XX1)=Round(CXX)) Then
         Angle:=90;
    end
   else

   if (CYY>YY1) Then
    begin
       if (Round(CYY-RR)=Round(YY1)) and (Round(CXX)=Round(XX1)) Then
         Angle:=270
       else
       if CXX>XX1 Then
         Angle:=180+Radian_Degre(ArcSin((CYY-YY1)/RR))
       else
       if CXX<XX1 Then
         Angle:=270+Radian_Degre(ArcSin((XX1-CXX)/RR));
    end
   else

   if (Round(CYY)=Round(YY1)) and (Round(CXX+RR)=Round(XX1)) Then Angle:=0
   else
   if (Round(YY1)=Round(CYY)) and (Round(CXX)=Round(XX1+RR)) Then Angle:=180;

   if (Angle>=0) and (Angle<=360) Then Angle__G3:=Round(Angle)
   else 
      Angle__G3:=400;

end;  {end Angle__G3}







Function Calcul_Rayon(Cx,Cy,X,Y:Real;Var Angle:Real):Real;
Var R,c,b,AG:Real;

begin
    C:=ABS(cx-X);
    B:=ABS(cy-Y);

    if C=0 Then C:=0.00001;
    if B=0 Then B:=0.00001;

    R:=SQRT(Abs(Sqr(C))+Abs(Sqr(B)));
    Ag:=Angle__G3(X,Y,Cx,Cy,R);

    if Ag=400 Then Ag:=-1;
    Angle:=Ag;
    Calcul_Rayon:=R;
end;






Procedure Cherche_Rayon(X1,Y1:Byte);
Var Key,Y,Chois : byte;
    n,DX1,DY1,
    CENX,CENY,
    Ray         : REAL;
    Ang         : Real;
    Snx,snY     : string[9];
    ColorAttr   : byte;

begin
   DX1:=0.0;
   DY1:=0.0;
   CenX:=0.0;
   CenY:=0.0;
   Ang:=0.0;
   Ray:=0.0;
   
   ColorAttr:=TextAttr;
   TextAttr:=Menu_Color;

   BoxFill(X1,Y1,X1+30,Y1+7,' ');
   Rectangle(X1,Y1,X1+30,Y1+7,Double);
   Putxy(X1+10,Y1,' Distance ');
   Putxy(X1+10,Y1+7,' F1 = Calcul ');

   Putxy(X1+3,Y1+1,'begin  X   :');
   Putxy(X1+3,Y1+2,'begin  Y   :');
   Putxy(X1+3,Y1+3,'end    X   :');
   Putxy(X1+3,Y1+4,'end    Y   :');
   Y:=1;
   HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);

   Repeat
       CsOff;
       Key:=KeyBoard;

       if (Key=80) and (Y<4)  Then
        begin
           HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
           inc(Y);
           HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
        end
       else

       if (Key=72) and (Y>1)  Then
        begin
           HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
           dec(Y);
           HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
        end
       else

       if (Not Key_Code) and ((Key=13) OR (Key In[45,48..57])) Then
        begin
           HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
           N:=0;
           N:=READREAL(X1+16,Y+Y1,10,key);

           if (N>100000) OR (N<-100000) Then Key:=27;
            Case y Of
               1: if Key=27 Then Printnum(X1+16,Y+Y1,CenX)
                  else cenX:=N;
               2: if Key=27 Then Printnum(X1+16,Y+Y1,CenY)
                  else CenY:=N;
               3: if Key=27 Then Printnum(X1+16,Y+Y1,DX1)
                  else DX1:=N;
               4: if Key=27 Then Printnum(X1+16,Y+Y1,DY1)
                  else DY1:=N;
            end;

           if Y<4 Then Inc(Y)
           else Y:=1;

           HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
           Key:=0;
        end;

       if (Key_Code) and (Key=59) Then
        begin
           snx:='';
           sny:='';
           Ang:=0.0;
           Ray:=Calcul_Rayon(CENX,CenY,DX1,DY1,Ang);
           Str(Ray:5:3,Snx);
           Str(Ang:5:3,Sny);
           textAttr:=116;
           Putxy(X1+3,Y1+5,'Rayon      : ');Putxy(X1+16,Y1+5,Snx);
           Putxy(X1+3,Y1+6,'Angle    ¦ : ');Putxy(X1+16,Y1+6,Sny+#167);
           textAttr:=Menu_Color;
        end;
   Until Key=27;
   textAttr:=ColorAttr;

end;{*ends cherche rayon*}





Procedure CentreG3(XX1,YY1,XX2,YY2,RR:Real;Var CX,Cy,Ray,Ang,Flech:Real);
var 
    a,b,aa,MM,MM2,AB,RF,MT,XO,YO,QQ1 : Real;

begin
   if XX1=XX2 Then a:=70000.00075
   else a:=(YY2-YY1)/(XX1-XX2);

   b:=-YY1-(a*XX2);

   if a=0 Then aa:=99999.99525
   else aa:=1/a;

   MM :=ABS((XX1-XX2)/2);
   MM2:=ABS((YY1-YY2)/2);
   QQ1:=Sqr(XX1-XX2)+Sqr(YY1-YY2);
   AB :=Sqrt(ABS(QQ1));
   QQ1:=Sqr(RR);
   QQ1:=QQ1-Sqr(AB)/4;
   RF :=Sqrt(ABS(QQ1));
   QQ1:=sqr(RF);
   QQ1:=QQ1/(Sqr(aa)+1);
   MT :=Sqrt(Abs(QQ1));

   if (YY2<YY1) OR ((YY2=YY1) and (XX1<XX2)) Then
    begin
       if XX1<=XX2 Then QQ1:=XX1 
       else 
         QQ1:=XX2;
   
       CX:=MM+MT+QQ1;

       if YY1<=YY2 Then QQ1:=YY1 
       else 
         QQ1:=YY2;

       CY:=(aa*MT)+MM2+QQ1;
    end
   else

   if (YY2>YY1) OR ((YY2=YY1) and (XX1>XX2)) Then
    begin
       if XX1<=XX2 Then QQ1:=XX1 
       else 
         QQ1:=XX2;

       CX:=MM-MT+QQ1;

       if YY1<=YY2 Then QQ1:=YY1 
       else 
         QQ1:=YY2;

       CY:=-(aa*MT)+MM2+QQ1;
    end;
 
   {**control**}

   QQ1:=AB/2;
   QQ1:=Sqr(QQ1);
   QQ1:=QQ1+Sqr(RF);
   QQ1:=Sqrt(Abs(QQ1));
   Ray:=QQ1;

   {*Calcul de Angle*}

   QQ1:=(AB/2)/Ray;

{Angle/2}  if QQ1=1 Then Ang:=90
           else
           Ang:=Radian_Degre(ArcSin(QQ1));

{corde}    a:=2*Ray*Sinu(Ang);
           if Round(AB)=Round(a) Then
            begin
{Ang Reel}     Ang:=Ang*2;
               Flech:=Ray-RF;
            end
           else
            begin
               Ang:=0;
               Flech:=0;
            end;

end;{*CentreG3*}






Procedure Calcul_Centre_ARC(X1,Y1:Byte);
Var 
    Key,Y,Chois : byte;
    N,DX1,DY1,
    CENX,CENY,
    DX2,DY2     : REAL;
    RC,Ray,
    Angl,fle    : Real;
    Snx,snY     : string[9];
    ColorAttr   : byte;

begin
    DX1 :=0.0;
    DY1 :=0.0;
    DX2 :=0.0;
    DY2 :=0.0;
    Ray :=0.0;
    RC  :=0.0;
    CenX:=0.0;
    CenY:=0.0;
    Angl:=0.0;
    Fle :=0.0;
   
    ColorAttr:=TextAttr;
    textAttr:=Menu_Color;

    BoxFill(X1,Y1,X1+30,Y1+11,' ');
    Rectangle(X1,Y1,X1+30,Y1+11,Double);
    Putxy(X1+8,Y1,' Arc Centre G3 ');
    Putxy(X1+10,Y1+10,' F1 = Calcul ');

    Putxy(X1+3,Y1+1,'Coordinate X1 :');
    Putxy(X1+3,Y1+2,'Coordinate Y1 :');
    Putxy(X1+3,Y1+3,'Coordinate X2 :');
    Putxy(X1+3,Y1+4,'Coordinate Y2 :');
    Putxy(X1+3,Y1+5,'Rayon         :');

    Y:=1;
    HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
  
    Repeat
        CSOFF;
     
        Key:=KeyBoard;

        if (Key=80) and (Y<5)  Then
         begin
            HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
            inc(Y);
            HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
         end
        else

       if (Key=72) and (Y>1)  Then
        begin
           HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
           dec(Y);
           HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
        end
       else

       if (Not Key_Code) and ((Key=13) OR (Key In[45,48..57])) Then
        begin
           HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
           N:=0;
           N:=READREAL(X1+19,Y+Y1,10,key);

           if (N>100000) OR (N<-100000) Then Key:=27;
            Case y Of
              1: if Key=27 Then Printnum(X1+19,Y+Y1,DX1)
                 else DX1:=N;
              2: if Key=27 Then Printnum(X1+19,Y+Y1,DY1)
                 else DY1:=N;
              3: if Key=27 Then Printnum(X1+19,Y+Y1,DX2)
                 else DX2:=N;
              4: if Key=27 Then Printnum(X1+19,Y+Y1,DY2)
                 else DY2:=N;
              5: if Key=27 Then Printnum(X1+19,Y+Y1,Ray)
                 else Ray:=N;
            end;

           if Y<5 Then inc(Y)
           else Y:=1;

           HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
           Key:=0;
        end;

       if (Key_Code) and (Key=59) Then
        begin
           CENX:=0;
           CENY:=0;
           RC:=0.0;

           CentreG3(DX1,DY1,DX2,DY2,Ray,CENX,CENY,RC,Angl,fle);

           Str(CenX:5:3,Snx);
           Str(CenY:5:3,Sny);
           textAttr:=116;

           Putxy(X1+3,Y1+6,'Centre      X : '); Putxy(X1+19,Y1+6,Snx);
           Putxy(X1+3,Y1+7,'Centre      Y : '); Putxy(X1+19,Y1+7,Sny);
           Str(RC:5:3,Sny);

           if Angl=0 Then Snx:='Err'
           else
             Str(Angl:5:3,Snx);

           Putxy(X1+3,Y1+8,'Rayon         : ');  Putxy(X1+19,Y1+8,Sny);
           Str(Fle:5:3,Sny);
           Putxy(X1+3,Y1+9,'Fleche        : ');  Putxy(X1+19,Y1+9,Sny);
           Putxy(X1+3,Y1+10,'Angle         : '); Putxy(X1+19,Y1+10,Snx);
        
           if (Round(RC)=Round(Ray)) Then
            begin
               RC:=Abs((Frac(RC)-Frac(Ray)));
               if (RC>=0) and (RC<=0.5)  Then Putxy(X1+11,Y1+8,#241+'0.5')
               else 
                 Putxy(X1+11,Y1+8,#63+#63+#63);
            end
           else
           Putxy(X1+11,Y1+8,'error');
           textAttr:=Menu_Color;
        end;

    Until Key=27;

    textAttr:=ColorAttr;

end;{*ends Calcul centre*}

end.