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
.