La Commande Numérique sur la Production Bois

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

{$O+,F+}

Unit C_Read;

Interface

Procedure Marque_Box (var XX1,YY1,XX2,YY2:byte;Color:byte);
Procedure ReadBufCopy (Poss:Word;X1,Y1,X2,Y2:byte);
Function Erreur_Critique (N:Integer;Diske:string):boolean;


Implementation

Uses crt,Box13,Var_1,Type_buf,Buffs,Get_Key;


Procedure Marque_Box(Var XX1,YY1,XX2,YY2:Byte;Color:Byte);
 var Ymax,Key,x,y    : byte;
     CadreX1,CadreY1 : byte;
     CadreX2,CadreY2 : byte;
     Fin             : boolean;
     Sy,Sx           : string[2];
     Cursor          : word;

begin
    Ymax:=YY2;
    Cursor:=GetCursor;
    X:=WhereX+1;
    Y:=WhereY+3;
  
    if (X In[XX1..XX2]) And (Y In[YY1..YY2]) Then
     begin
     end
    else
     begin
         X:=XX1;
		 Y:=YY1;
     end;

    Fin:=False;
    ReadBuf(1,1,80,1,LinePtr^);
    TextAttr:=Block_Color;
    Putxy(1,1,'                                        '+
              '                                        ');
    Putxy(2,1,'To mark the box mini:');
    CadreX1:=0;
	CadreY1:=0;
    Setcursor(InsCursorSmall);
    Posxy(x,Y);
    
    Repeat
      
        Key:=KeyBoard;
      
        if Key_Code Then
         begin
            if (CadreX1>0) And (X>=CadreX1) And (Y>=CadreY1) Then
              HighBox(CadreX1,CadreY1,X,Y,Bx);

            if (Key=77) And (X<XX2) Then Inc(X)
            else
            if (Key=80) And (Y<Ymax) Then Inc(Y)
            else
            if (Key=75) And (X>XX1) Then Dec(X)
            else
            if (Key=72) And (Y>YY1) Then Dec(Y);

            if (CadreX1>0) And (CadreX1<=X) And (CadreY1<=Y) Then
              HighBox(CadreX1,CadreY1,X,Y,Bx);
         end;

        Posxy(x,y);
        if Key=13 Then
         begin
            Str(X-XX1+1:2,Sx);
            Str(Y-YY1+1:2,Sy);
            if CadreX1=0 Then
             begin
                CadreX1:=X;
                CadreY1:=Y;
                Putxy(24,1,Sx+','+sy);
                HighBox(CadreX1,CadreY1,X,Y,Bx);
                Beep;
             end
            else
             begin
                CadreX2:=X;
                CadreY2:=Y;
                if (CadreX2<CadreX1) OR (CadreY2<CadreY1) Then
                 begin
                    CadreX1:=X;
                    CadreY1:=Y;
                    CadreX2:=0;
                    CadreY2:=0;
                    Putxy(24,1,Sx+','+sy);
                    Beep;
                    HighBox(CadreX1,CadreY1,X,Y,Bx);
                    Posxy(x,y);
                 end
                else
                 begin
                    Putxy(31,1,'max: '+Sx+','+Sy);
                    Putxy(43,1,'= Please confirmed Enter  -  ESC null');
					
                    Repeat
                       Key:=KeyBoard;
                    Until Key in[13,27];
					
                    if Key =13  Then
                     begin
                        Fin:=True;
                        XX2:=CadreX2-XX1+1;YY2:=CadreY2-YY1+1;
                        XX1:=CadreX1-XX1+1;YY1:=cadreY1-YY1+1;
                     end;
                 end
             end;
         end; {*key=13*}

    Until (Key = 27) OR (Fin);
    WriteBuf(1,1,80,1,LinePtr^);
    Setcursor(Cursor);
    TextAttr:=Color;

    if CadreX1>0 Then HighBox(CadreX1,CadreY1,X,Y,Bx);
   
    if Key=27 Then
     begin
         XX1:=0;YY1:=0;XX2:=0;YY2:=0;
         Copy_Exemples:=False;
     end
    else
     begin    {*Calcule les cordonees avec le deplacement de l'ecran*}
         XX1:=XX1+(X_curseur-E_curseurX);
         XX2:=XX2+(X_curseur-E_curseurX);
     end;

end;  {*end Marque_Box*}



{=================================================}
{ copy le rectangle marque par les cordones       }
{ de l'ecran dans le buffer de blocs              }
{ sauf les blans de fin de ligne                  }
{ poss: position ou doit etre copie sur le buffer }
{=================================================}

Procedure ReadBufCopy(Poss:Word;X1,Y1,X2,Y2:Byte);
 var Conter,i,X : Word;

begin
   if (X2 < X1) or (Y2 > Y1) then
    begin
       Copy_Exemples:=False;
       DebutDAF     :=0;
       FinDAF       :=0;
       BlockDAF     :=0;
       Exit;
    end;
   
   i:=Poss;
   for Conter := 0 to Y2 - Y1 do
    begin
       for X:=Succ(X1) To Succ(X2) DO
        begin
           inc(i);
           Copy__Buffer^[i]:=ScreenPtr^[Y1+3+Conter,x].data;
        end;

       While Copy__Buffer^[i]=#32 DO Dec(i);
       inc(i);
       Copy__Buffer^[i]:=#13;
       inc(i);
       Copy__Buffer^[i]:=#10;
    end;

   BlockDAF :=i;
   FinDAF   :=i;

   Copy__Buffer^[Succ(i)]:=#32;

   Copy_Exemples:=True;
   DebutDAF     :=1;

end;




Function Erreur_Critique(N:Integer;Diske:String):Boolean;
 var Serr  : string;
     Car1  : byte;
     Color : byte;
     Code  : boolean;
     shh   : string[5];

begin
    Code:=True;
    Serr:='';
    Car1:=0;
    Color:=TextAttr;
    
    Case N OF
       18,2: Serr:='File not found.';
       3: Serr:='Path not Found.';
       4: Serr:='Too many open files.';
       5: Serr:='File access denied.';
       6: Serr:='Invalid file handle.';
      12: Serr:='Invalid file access code.';
      15: Serr:='Invalid drive number.';
      16: Serr:='Cannot remove current directory';
      17: Serr:='cannot rename across drives.';
     100: Serr:='Disk read error.';
     101: Serr:='Disk write error.';
     102: Serr:='File not assigned.';
     103: Serr:='File not open.';
     104: Serr:='File not open for input.';
     105: Serr:='File not open for output.';
     106: Serr:='Invalid numeric format.';
     150: Serr:='Disk is write-protected.';
     151: Serr:='Unknown unit.';
     152: Serr:='Disk is not ready';
     153: Serr:='Unknown command.';
     154: Serr:='Crt error in data.';
     155: Serr:='Bad drive request structure length.';
     156: Serr:='Disk seek error.';
     157: Serr:='Unknown media type.';
     158: Serr:='Sector not found.';
     159: Serr:='Printer ouf of paper.';
     160: Serr:='Device write fault.';
     161: Serr:='Device read fault.';
     162: Serr:='Hardware failure.';
     254: Serr:='File too Large';
     300: Serr:='Insuffisant de m‚moire op‚ration nulle.';
     255: Serr:='Bad file request structure.';
     500: Serr:='Erreur Non Save code Ascii non autorise dans le buffet.';
    end;

   if Serr='' then
    begin
       Str(N,shh);
       Serr:='Error unknown... '+shh;
    end;

   if (N in[2..6,12..17,100..106,151,155..158,254]) OR (Serr='') Then
    begin
       Serr:=Serr+' in drive '+Diske+'  Press [ ESC ]';
       code:=False;
    end
   else
   
   if (N=300) OR (N=500) Then
    begin  
       Serr:=Serr+' press (ESC)';
       Code:=False;
    end
   else
    begin
       Serr:=Serr+' in drive '+Diske+' (R)etry or (A)bort?';
       Code:=True;
    end;

   ReadBuf(2,16,Max_CurseurX,18,Sub_Buf^);
   TextAttr:=Error_Color;
   BoxFill(4,16,7+Length(Serr),18,' ');
   Rectangle(4,16,7+Length(Serr),18,Double);
   Putxy((Length(Serr) div 2)-2,16,' Critical Error ');
   Putxy(6,17,Serr);
   Csoff;

   Repeat
       Car1:=KeyBoard;
   Until ((Not Key_Code) And (Car1 in[114,82,65,97,27]));

   TextAttr:=Color;
   WriteBuf(2,16,Max_CurseurX,18,Sub_Buf^);
   if Car1 In[114,82] Then Erreur_Critique:=True
   else Erreur_Critique:=False;
   if N in[2..6,12..17,100..106,151,155..158] Then Erreur_Critique:=False;
end;

end.