Unit ED13FNUM;
Interface
Const Serrage_Piece:Boolean=False;
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');
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));
Val(StrVar,Valeur,Err);
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]));
Val(StrVar,NN_Ligne,Err);
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
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
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
begin
C^[Lig].CG:=Tab128[U];
C^[Lig].CX:=Tab128[U+1];
C^[Lig].CY:=Tab128[U+2];
end;
if (POS('ED',Tab128[U])=1) Then
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
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];
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
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
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;
end;
End
else
if Tab128[U]='G45' Then
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));
Val(StrVar1,_z,Err);
End
else
if (Pos('ER',Tab128[cc])>0) Then
begin
StrVar1:=Tab128[cc];
StrVar1:=Copy(StrVar1,3,Length(StrVar1));
Val(StrVar1,_ER,Err);
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));
Val(StrVar1,_P,Err);
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));
Val(StrVar1,Vii,Err);
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));
Val(StrVar1,Vii,Err);
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));
Val(StrVar1,Vii,Err);
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));
Val(StrVar1,Vii,Err);
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));
Val(StrVar1,Vii,Err);
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));
Val(StrVar1,Vii,Err);
if (Err=0) And (Vii<=0.0) then Err:=-1;
end;
Inc(cc);
end;
if (Err=0) Then
begin
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;
if (Tab128[U]='M100') OR (Tab128[U]='M101') Then
begin
C^[Lig].CG:=Tab128[U];
end;
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]
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
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;
Val(StrVar,Valeur,Err);
if (Err<>0) OR (Valeur>99999.999) Then
begin
Erreur_Formule(3,0,Tab128[1]);
Decode_Ligne:=False;
Exit;
End
else
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;
end;
Valeur:=0;
end;
Inc(u);
end;
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;
TextRec(Fictex).BufPos:=0;
While (Not Eof(FicTex)) And (Not Block ) Do
begin
Read(Fictex,S);
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;
Val(S,nnn,Err);
if (Err=0) Then
begin
if (nnn>0) And (nnn<=9999) Then Block:=True
else Err:=2;
ReadLN(FicTex);
end;
end
else
begin
Readln(FicTex);
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
Readln(Fictex,St);
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
St:=St+' ';
if Not Decode_Ligne(Nbr,ST) Then Exit;
End
else
begin
ErreurFile:=7;
Str(MaxLig,SC);
Mesaje('Error: Too much lines [maximum:'+Sc+']');
ChKey:=keyBoard;
Chkey:=27;
Efface_Mesaje;
end;
end;
end;
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;
end;
end;
end;
Procedure Open_Fic(Reperto,Neime:String);
begin
if FileOpen Then
begin
Close(FicTex);
end;
FileOpen:=False;
FillChar(BufTexte^,SizeOf(Buf___Ptr),#32);
Assign(FicTex,Reperto+Neime);
SetTextBuf(FicTex,BufTexte^);
Reset(FicTex);
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;
Valeur_de_Z(Haut_Z);
Fin_M2:=False;
JJ:=1;
PosX:=0;PosY:=0;
Chkey:=0;
Serrage_Piece:=False;
While (jj<=Nbr) And (Not Fin_M2) DO
begin
Affiche_Line(C^[jj].CN,W^[jj].X,W^[jj].Y);
Delay(TempoOK);
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;
if C^[jj].CG='M100' Then Serrage_Piece:=True;
if C^[jj].CG='M101' Then Serrage_Piece:=False;
if C^[jj].CG='M6' Then
begin
if (Not Serrage_Piece) Then
begin
ERREUR_Execution(COTEZ,15,Pos_line,0,0);
Goto Fin_Error;
end;
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
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 ((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
if (Not Serrage_Piece) Then
begin
ERREUR_Execution(COTEZ,15,Pos_line,0,0);
Goto Fin_Error;
end;
M3(C^[jj].CN,C^[jj].CX,C^[jj].CY)
End
else
if C^[jj].CG='M4' Then
begin
if (Not Serrage_Piece) Then
ERREUR_Execution(COTEZ,15,Pos_line,0,0);
Goto Fin_Error;
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
if (Serrage_Piece) Then
begin
ERREUR_Execution(COTEZ,16,Pos_line,0,0);
Goto Fin_Error;
end;
Fin_M2:=True;
End
else
if C^[jj].CR[1]='M' Then
begin
if C^[jj].CR='M2' Then
begin
if (Serrage_Piece) Then
begin
ERREUR_Execution(COTEZ,16,Pos_line,0,0);
Goto Fin_Error;
end;
Fin_M2:=True;
End
else MMM(C^[jj].CN,C^[jj].CR);
End
else
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;
if (C^[jj].CG='M101') And (Serrage_Piece) Then
begin
Serrage_Piece:=False;
end;
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
else Inc(jj);
if Not ChKey in [27,62,68] Then chKey:=0;
end;
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;
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;
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(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);
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;
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;
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;
Procedure Metre_un_Veille;
Const
Seed = 1958;
NumPts = 2100;
PPP = 4;
Var
III,XXX, YYY, Color : WORD;
XXMax, YYMax : INTEGER;
_ViewInfo : ViewPortType;
ColorPoint : Integer;
Max__Color : WORD;
begin
Randomize;
Max__Color := Graph.GetMaxColor;
GetViewSettings(_ViewInfo);
WITH _ViewInfo DO
begin
XXMax := (x2-x1-1);
YYMax := (y2-y1-1);
end;
WHILE NOT KeyPressed DO
begin
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;
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;
End.