La Commande Numérique sur la Production Bois

A. Ara

- Titre : La Commande Numérique sur la Production Bois

- Auteur : A. Ara

- Parution : 6 mars 2010

- Mise à jour : 3 juin 2011

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

Sommaire

- Bienvenue

- L'auteur

- Elaboration d'un programme en CNC

- Commande numérique

- La programmation en commande numérique

- La programmation

- Stockage et transfert de l'information

- Le logiciel EDnum

- Logiciel EDnum - Editeur de programmes

- Logiciel EDnum - Graphe Trace

- Exécution de Graphe Trace

- Clavier NUM 750

- Logiciel EDnum - Licence et téléchargement

- Services

- Format général des données et définition des blocs pour EDnum

- Les variables

- Les calculs des opérations

- Opérateurs reconnus

- Cycles de perçage

- Fonctions de poches

- Fonction miroir

- Erreurs sur les formules et variables

- Aide-mémoire d'EDnum

- Emploi de la souris

- Programmation avec EDnum

- Format général des données et définition des adresses

- Définition des fonctions ISO en tournage

- Sous-programmes et sauts en code ISO

- Programmation des poches

- Vitesses d'usinage

- Usinage d'une poche rectangulaire avec congés

- Interpolation circulaire et fonction miroir

- Correction de rayon d'outil

- Mode d'avance (tournage)

- Interpolation circulaire

- Fonctions d'arrêt

- Fonctions M de mise en position ou serrage

- Mode de programmation G90 - G91

- Déplacement linéaire G00 - G01

- Perçage de trous en interpolation circulaire

- Règles d'utilisation des décalages

- POM prise des origines machine intervention manuelle

- 0rdre des opérations sur le calculateur

- Informations d'EDnum

- L'éditeur

- Menu File

- Menu Edit

- Menu Options

- Menu Lang

- Menu Graph Trace

- Menu Maths

- Sources

- Principaux fichiers sources

- Unité BOX13.PAS

- Win_Box.ASM

- Miniscul.ASM

- Uppers.ASM

- Screen.ASM

- Unité Get_key7.PAS

- Unité Graphe Trace.PAS

- Le dictionnaire

Bienvenue

Amélioration de la qualité de vie

L'élévation du niveau de vie de la grande majorité des travailleurs des pays industrialisés, qui s'est avant tout traduite par la croissance du pouvoir d'achat, est d'abord due à une meilleure productivité du travail.
Celle-ci n'est pas la conséquence d'un effort plus important de travail, mais bien davantage la résultante de l'utilisation de techniques de production plus efficaces.
Ce progrès technique est avant tout le résultat des avancées scientifiques qui ont permis l'automatisation.
Cette évolution qui s'est considérablement accélérée au début de ce siècle, et plus encore durant les quarante années qui viennent de s'écouler, dont personne ne conteste les effets bénéfiques sur la nature du travail, a cependant pu être critiquée sur certains points.

Incidence sur l'emploi

La progression du taux de chômage demeure aujourd'hui la principale critique formulée contre le développement des tâches automatisées.
L'introduction de nouvelles techniques de production reposant sur l'automatisation a une incidence sur le niveau de l'emploi. En permettant une croissance de la production à un moindre coùt, l'introduction d'une machine à la place d'un ou de plusieurs postes de travail, s'il réduit la pénibilité des tâches exécutées, supprime nécessairement, dans un premier temps du moins, des emplois. Face à ce constat, un contre-argument est fréquemment avancé : en permettant de créer de nouveaux produits, l'automatisation et le progrès technique engendrent l'apparition d'activités nouvelles, elles-mêmes génératrices d'emplois.
Ceci est certes vrai, toutefois, il faut constater que l'évolution technique est, aujourd'hui, globalement destructrice d'emploi. La raison en est simple : l'automatisation ne recrée pas au niveau de son utilisation le niveau d'emploi qu'elle crée du fait de son introduction.
Substituer une machine qui remplit les tâches nécessitant l'intervention de dix salariés, n'aboutit pas mécaniquement à la création de dix emplois nouveaux.
Si cette évolution est génératrice de nouveaux emplois (par exemple en employant un technicien afin de contrôler l'exécution du travail réalisé par la machine nouvelle), la nouveauté tient davantage à la nature de l'emploi (qui par définition est plus qualifié) qu'à son volume.
C'est cette distorsion qui est cause de chômage.
Cela montre par ailleurs que les compétences et le niveau de formation de la main-d'oeuvre joue dans ce phénomène un rôle important.
À terme et la question fait aujourd'hui l'objet de débats passionnés, il semble que ce soit la relation de l'Homme au travail qui devra être repensée.
L'association de techniques toujours plus productives et élaborées, nécessite pour mise en 'uvre un volume d'emploi toujours plus faible à mesure qu'il devient de plus en plus intellectuel.

1Â° Comment occuper ceux qui ne peuvent alors s'insérer sur ce nouveau marché du travail !?
La réponse à cette question, simple à formuler, excessivement complexe à résoudre, orientera dans un futur proche l'évolution des sociétés industrielles du siècle prochain.

2Â° Que faire des pays peu développés que les structures économiques et sociales ne permettent pas de satisfaire les besoins fondamentaux des populations et qui se caractérisent principalement par une pauvreté massive ainsi qu'une faible insertion dans l'économie mondiale ?
La mondialisation ne peut pas actuellement réponse à cette question excessivement complexe à résoudre, la réponse dans les siècles prochains si l'homme n'a pas détruit la planète avant !

L'auteur

A. Ara a fait l'école de Techniciens de production bois et machines à commande numérique à Limoges. Il a également étudié la programmation à l'Université de Limoges, tout en étant déjà technicien en câblage et créateur de prototypes en électronique, travaillant en bureaux d'études civils et militaires.

Il a voyagé un peu partout en Europe, en Asie jusque en Inde et un peu en Afrique. Musicien à ses heures, il joue de la guitare, du sitar et du banjo américain.

Elaboration d'un programme en CNC

Commande numérique

L'usinage sur les machines à commande numérique contraint l'utilisateur à se servir de langages de programmation.
Le dialogue homme-machine s'établit grâce à ces langages, mais précédant la rédaction de programme proprement dit, la phase d'analyse offre une activité fructueuse car elle permet de développer des aptitudes transférables en programmation: analyse de la situation initiale ( énonce du problème à traiter ); analyse de la situation finale ( résultat obtenu );
- Analyse descendante par décomposition successive du problème en difficultés élémentaires;
- Analyse ascendante ou l'on commence par résoudre des problème simples dont on sait qu'ils vont contribuer à la résolution du problème initial.

Une analyse structurée cherche à énoncer le problème, à le décomposer en parties élémentaires afin que la solution soit exprimée comme une suite d'actions faciles à appréhender.
S'il n'existe heureusement pas de dogme, l'analyse structurée permet un apprentissage plus cohérent de la programmation, indépendamment de tout langage utilisé.

L'équipement des entreprises en machines-outils à commande numérique suppose, bien entendu, une formation adaptée des futurs techniciens et techniciens supérieurs appelés à les utiliser.

La programmation en commande numérique

Une Machine-outil à Commande Numérique par Calculateur (MO CNC ou plus simplement CNC) est capable de commander ses propres mouvements suivant deux ou trois axes (voire davantage), et de mesurer avec précision les déplacements des organes mobiles (porte-pièces et/ou porte-outils).
Ces automatismes sont gérés par un système électronique qui garde en mémoire la description des différentes opérations à effectuer, le programme.

La programmation

La programmation consiste à décrire les opérations prévues dans un langage codé assimilable par le calculateur de la machine.
Ce travail peut être manuel ou partiellement automatisé grâce à des dispositifs d'aide à la programmation (logiciels intégrés ou externes).

Les logiciels d'aide à la programmation (logiciels de Fabrication Assistée par Ordinateur, F.A.O.) permettent d'éviter de fastidieux calculs de points. A partir du dessin de la pièce à usiner, ils calculent puis traduisent en ordres compréhensibles par la machine les déplacements à réaliser.
Le programmeur en commande numérique reste responsable de l'analyse et de la structuration du programme.

Stockage et transfert de l'information

La description du programme est matérialisée par un support (bande perforée ou support magnétique de micro-ordinateur).
Le stockage sur support magnétique offre des avantages certains par rapport au stockage sur bande.
Le volume et le coùt du support sont très inférieurs ; les modifications d'un programme sont rapides et ne nécessitent pas la création d'une nouvelle bande; l'écriture d'un programme n'immobilise pas le clavier de la machine.
Le transfert micro-ordinateur - CNC s'effectue par un logiciel spécialisé, ce qui est plus fiable et plus rapide qu'un transfert par lecture optique de bande perforée.

Le logiciel EDnum

Logiciel EDnum - Editeur de programmes

Logiciel EDnum - Graphe Trace

Exécution de Graphe Trace

Voir le programme

Voir le programme

Voir le programme

Clavier NUM 750

Logiciel EDnum - Licence et téléchargement

La licence du logiciel EDNUM pour la commande numérique sur bois est accordée seulement dans un but démonstratif et éducatif.
La vente du logiciel est interdite.

EDnum version 3.001e
Programmation sur les machines à Commande Numérique Num 750/760F
Copyright (S) 1995-2010 programmeur du logiciel A. Ara 64150 Mourenx ville France.
Licence d'utilisation accordée dans un but démonstratif, vente interdite.
Numéro de série 00-331-7431-A1133071e

Téléchargement

Services

Format général des données et définition des blocs pour EDnum

L'écriture de blocs pour que EDNUM puise tester correctement le programme.

Les variables

N10 L0=100 (L0 vaut 100) N20 L1=L0+R144 (L1 vaut 100 + Racine Carre de 144 = 112=) N30 L0=L0+5 (incrément de 5 L0 )

Les calculs des opérations

Les opérations ont effectuées dans l'ordre où elles sont écrites. Variables reconnues par EDNUM : L0 à L19.

Opérateurs reconnus

+

Plus

-

Moins

*

Multiplication

/

Division

.

Point décimal

R

Racine carrée

S

Sinus

C

Cosinus

T

Troncature

A

Arc Tangente

Notes

Pas d'espaces dans les formules. Tout espace génère une erreur.
Les parenthèses sont interdites dans les formules.

L9=L1+L3*L4/R144*S45 : correct.
L9 = L1 + L3 * L4/R144*S45 : erreur.
XL2 : X vaut la valeur de L2.
YL0 : Y vaut la valeur de L0.
EDL3 : Angle vaut la valeur de L3.

Les variables sont testées.

La syntaxe dans le test du programme.
Les valeurs dans l'exécution du programme.

Attention

- La racine carrée doit être un nombre positif;
- La division par 0 génère une erreur;
- Angles de 0 à 360 positifs.

Sauts

N109 G79 L2<=0 N111 : Saut conditionnel à N111 Si L2 plus petit ou égal à 0.
N109 G79 N111 : Saut inconditionnel à N111.
N120 G77 N100 N300 : N100 début N300 fin.
N120 G77 N100 N300 S10 : S nombre de fois à répéter.

Broche

N500 M3 M44 Snnnnn : 5 chiffres maximum pour S mise en route de broche.
N500 M4 M44 Snnnnn : 5 chiffres maximum pour S

Machine

N600 M6 T0 : pose d'outil en cours avant fin programme arrêt de broche.
N600 M6 T0 D0 : pose d'outil en cours avant fin programme.

Déplacements

N800 G00 X100 Y300 G40inline> (ou G41 ou G42)
N800 G0 X100 Y300 G40inline> (ou G41 ou G42)
N800 G0 X100 Y300
N900 G01 X100 Y300 G40inline> (ou G41 ou G42)
N900 G1 X100 Y300 G40inline> (ou G41 ou G42)
N900 G1 X100 Y300 Z10
N900 G1 XL4 YL2+L3
N900 G0 Z10
N900 G Z10
N900 Z10
N900 G02 X100 Y300 R50
N900 G2 X100 Y300 R50
N900 G03 X100 Y300 R50
N900 G3 X100 Y300 R50

Programmation

N910 G90
N910 G91

Rotation

N920 ED30 (Angle de 0 à 360)
N920 EDL3
N920 EDL1*C30

Cycles de perçage

G81

Couleur bleu clair

G82

Couleur rouge

G83

Couleur orange (rouge vif)

G84

Couleur jaune

G85

Couleur verte

G86

Couleur bleu foncé

G87

Couleur violette

G88

Couleur grise

G89

Couleur blanche

N930 G81 X100 Y200 ER5 Z-4 F1000
N930 G81 ER5 Z-4 F1000
N931 X100 Y200
N932 X100 Y250
N933 G80 (annule cycle de perçage)

Fonctions de poches

N940 G45 X244.989 Y275.819 Z-8 ER2 EX230.2 EY56.981 P10 Q8 EP5000 EQ1200inline>
N941 G45 X120.888 Y215.012 Z-8 ER2 EB15.905 P10 Q8 EP5000 EQ1200inline>

Fonction miroir

N750 G51 Y-
N760 G59 X245 Y-170
N770 G77 N510 N740

Miroir sur axe X

N780 G51 X-
N790 G59 X-245 Y-170
N800 G77 N510 N740

Miroir sur axe Y

N810 G51 Y+
N820 G59 X-245 Y170
N830 G77 N510 N740

X devient X+

N840 G51 X+
N850 G59 X0 Y0

Fin de programme

N900 M2 (Fin programme, arrête le test à N900).
M2 (Fin programme, arrête le test, les blocs qui suivent sont ignorés).
Outils

Les rayons des outils supérieurs à 13 millimètres seront considérés à 13 millimètres.
Par défaut rayon outil 4 millimètres.
Outils de 0 à 32.
Casiers de 1 à 32.

Information

Numéros de Blocs de 1 à 37000 toujours incrémentés les aux autres.
Commentaires maximum 40 caractères, les lettres minuscules sont autorisées dans les commentaires.
Les lettres minuscules sont interdites dans l'écriture des blocs. Tout caractère non-ISO génère une erreur.
Un programme doit commencer par le symbole % suivi d'un numéro de 1 à 9999.

Débogueur

Avec le débogueur, vous pouvez suivre l'évolution d'une variable de L0 à L19. Une fois le programme testé, appuyez sur F8; le message suivant s'affiche : L0..L19 DEBUGGER:
Si vous tapez L1 le débogueur affichera la valeur de L1. Chaque fois qu'une variable sera calculée dans le programme, appuyez sur une touche pour continuer. La touche ECHAP (ESC) met fin à l'exécution.
Vous pouvez examiner toutes sortes de formules.

Exemple :

L1+L2 ou L2+L4/5 ou RL5 (racine carre de L5)
Ignore : L2=L0+1 ont ne peut pas modifier une valeur.
Si vous tapez: G ou g, à chaque fois que le programme exécute un G2 ou G3 il donne l'information du centre X et Y.
Angles : Arc, angle départ et de fin. La corde et la flèche de l'arc.
Pour annulation du débogueur tapez F8 puis Entrée seulement.

Erreurs sur les formules et variables

1

Formule trop longue

2

Caractère non autorisé dans la formule

3

Fin de formule incorrecte

4

Début de formule incorrecte

5

Variable inconnue ou non reconnue

6

Suite de variable incorrecte

7

Affectation incorrecte ou double

8

Constante de fonction incorrecte

9

Suite d'opération non autorisée

10

Erreur dans le calcul

11

Opérateur manquant devant la variable

12

Division par zéro

14

Racine carrée de nombre négatif

17

Erreur d'opérateur

18

Expression mathématique de R T S C A

19

Erreur de L

20

Erreur virgule-décimal

21

Erreur point-décimal

22

Erreur d'opérateur

Notes

EDnum teste la présence en mémoire du gestionnaire de mémoire étendue à la norme LIM (EMM, Extended Memory Manager). Si le gestionnaire existe, le fichier est chargé. L'exécution est plus rapide.
Une souris doit être installée.
Vidéo nécessaire : VGA. 640Ko. RAM.
La touche Echappe (ESC) annule ou finit une opération un cours. Sur Graphe trace, arrête un programme en exécution.
Tolérance de cotation circulaire : 0.05.

Lancement sur SYS

SYS-DOS, WINDOWS.

Aide-mémoire d'EDnum

Mouvements du curseur

Caractère à droite Ctrl-D ou Flèche droite
Mot à gauche Ctrl-A ou Ctrl-Flèche G.
Mot à droite Ctrl-F ou Ctrl-Flèche D.
Ligne précédente Ctrl-E ou Flèche Haut
Ligne suivante Ctrl-X ou Flèche Bas
Défilement arrière Ctrl-W
Défilement avant Ctrl-Z
Page précédente Ctrl-R ou PgUp
Page suivante Ctrl-C ou PgDn
Début fichier Ctrl-Q R ou Ctrl-PgUp
Fin fichier Ctrl-Q C ou Ctrl-PgDn

Insertion et Suppression

Insertion Oui/Non Ctrl-V ou Inser
Suppression 1 ligne Ctrl-Y
Suppr.Carac. à gauche Ctrl-H ou Backspace
Suppr.carac. à curseur Ctrl-G ou Suppr
Suppr. Bloc Ctrl-K Y

Commandes de blocs de texte

Marque début de bloc Ctrl-K B
Marque fin de bloc Ctrl-K K
Option Début Bloc Shift + @ ou
Définir le Bloc Shift + curseur
Copie du bloc Ctrl-K C
Suppression de bloc Ctri-K Y
Lecture Bloc disque Ctrl-K R
Ecriture Bloc disque Crtl-K W
Montre/Cache Bloc Ctrl-K H

Souris dans le menus

Depuis l'éditeur, cliquez sur le bouton droit de la
souris pour sélectionner le menu choisi.
Sélection dans le menu avec la souris
Sélectionnez une commande avec le clic de gauche.
Pour ouvrir la sélection, positionnez-y la flèche,
puis cliquez sur le bouton droit.
La sélection ne pourra s'ouvrir que si la souris se
trouve sur la ligne en surbrillance.
Pour fermer la sélection en cours avec la souris,
appuyez sur le bouton gauche + plus le bouton droit.

Raccourci Action

F1 Active le système d'aide
F1 sur aide index d'aide
F2 Sauvegarde le fichier en cours
F3 Charger un nouveau fichier
F5 Touche Auto de numérotation lignes

F6 Traduction d'un bloc Anglais - Français
F7 Traduction Anglais Français
F8 Traduction Français Anglais

F9 Aide suggestion numérique
F10 Menu général sur l?éditeur.
Ctrl-F1 Place disponible dans l'éditeur
Alt-F2 Change couleur du texte sur Edit
Alt-F3 Chargement d'un des 8 derniers Fichiers (liste Pick)
Alt-F5 Conversion des Tabulations
ALT-F6 Alterne entre les deux derniers Fichiers édit
Alt-F7 Calculateur
Alt-F8 Numérique Graphique Trace
Alt-F9 Clavier NUM 750
Alt-F1O Calculatrice.
Ctrl-F5 passe en mode 25/50 lignes
Ctrl-F8 copie de formule Evaluate
Ctrl-F9 Correction Outils.
Ctrl-F4 Actionner l'écran de veille
Ctrl-F1O Evaluate formule.

Alt-F Menu FILE
Alt-E Menu EDIT
Alt-O Menu OPTIONS
Alt-L Menu LANG
Alt-G Menu GRAPH TRACE
Alt-M Menu MATHES
Alt-X Sortie vers le DOS (Fin)

Souris dans l'éditeur

Vous ne trouverez pas de barre de défilement haut/bas et droite/gauche.
Cette fonction est assumée par les bordures de l'éditeur elles-mêmes.
Positionnez la souris sur la ligne et :
La ligne Haut remonte le curseur
La ligne droite déplace le curseur à droite
La ligne bas descend le curseur
La ligne gauche déplace le curseur a gauche.

Calculateur

Fonctions mathématiques

PI(0) égale à 3.141592654

ABS(nombre) Valeur absolue
TAN(nombre) Tangente
ATAN(nombre)
COS(nombre)
EXP(nombre) Exponentielle de nombre
LN(nombre) Logarithme de nombre
ROUND(nombre) Arrondi le réel le plus proche
SIN(nombre)
SQRT(nombre) Racine carrée de nombre.
SQR(nombre) Carré de nombre.
TRUNC(nombre) Enlève la partie décimale
RADIA(nombre) Transforme en radians
ARSIN(nombre)
ARCOS(nombre)

INT(nombre) retourne la partie entière.
FRAC(nombre) retourne la partie fractionnaire.
F1 Help
F2 Save évaluâtes 1
F3 Save évaluâtes 2
F4 Save évaluâtes 3
F5 Evaluâtes 1
F6 Evaluâtes 2
F7 Evaluâtes 3

F8 Imprimer évaluâtes 1 2 3

F1O Calculatrice.
Ctrl F1 Nombre de décimales.
ESC Fin où termine.

Numerical Graphic Trace

F8 Débuguer.
F4 affiche une grille sur graphique
F10 fait une Pause sur graphique.

Emploi de la souris

Depuis l'éditeur, cliquez sur le bouton droit de la souris pour sélectionner le menu choisi.

Sélection dans le menu avec la souris

Sélectionnez une commande avec le clic de gauche. Pour ouvrir la sélection, positionnez-y la flèche, puis cliquez sur le bouton droit. La sélection ne pourra s'ouvrir que si la souris se trouve sur la ligne en surbrillance. Pour fermer la sélection en cours avec la souris, appuyez sur le bouton gauche + plus le bouton droit.
Note : "Appuyer le bouton gauche+le bouton droit de la souris" est équivalent à appuyer sur Echap ou ESC ou Ascii = 27.
Dans certaines parties des menus la souris ne fonctionne pas. Servez-vous de touches du clavier.
la touche [Echap ou ESC] annule toujours l'opération.
La touche [Entrée] valide toujours l'opération.
Les touches du curseur pour se déplacer.
La touche F10 ouvre toujours les menus.

Dans l'éditeur

Vous ne trouverez pas de barre de défilement haut/bas et droite/gauche. Cette fonction est assumée par les bordures de l'éditeur elles-mêmes. Positionnez la souris sur la ligne et : la ligne Haut remonte le curseur la ligne droite déplace le curseur à droite la ligne bas descend le curseur la ligne gauche déplace le curseur a gauche.

Programmation avec EDnum

Format général des données et définition des adresses

%nnnn

Numéro de programme 4 chiffres maxi

Nnnnnn

Numéro de séquences ou de ligne 5 chiffres maxi de N0 à N32767

Gnn

Fonction préparatoire 2 chiffres maxi 6 fonctions maximum dans un bloc

Hnnnn

Numéro d'appel de sous-programmes dans une séquence comportant un G77 4 chiffres maxi

Xnnnnn,nnn
Ynnnnn,nnn
Znnnnn,nnn

Mouvements principaux sur les axes.
8 chiffres maxi

Innnnn,nnn
Jnnnnn,nnn
Knnnnn,nnn

Coordonnées du centre en interpolation circulaire en G2 et G3 ou pas de l'hélice en interpolation hélicoïdale ou pas du filet en filetage au gain

Innnnn,nnn
Jnnnnn,nnn

Prise de passe axiale et latérale en G45

Unnnnn,nnn
Vnnnnn,nnn
Wnnnnn,nnn

Mouvements parallèles aux axes X, Y et Z

Annnnn,nnn
Bnnnnn,nnn
Cnnnnn,nnn

Coordonnées angulaires autour des axes X, Y et Z

Pnnnnn,nnn

Valeur de la première pénétration en G83 ou G87, ou sens de l'outil suivant X ou U en G16

Pnnnn,nnn

Prise de passe axiale en ébauche en G45 (7 chiffres maxi)

Qnnnnn,nnn

Valeur de la dernière pénétration en G83 ou G87 ou sens de l'outil suivant Y ou V en G16

Qnnnn,nnn

Prise de passe latérale en ébauche en G45

Rnnnnn,nnn

Rayon du cercle en interpolation circulaire ou hélicoïdale 8 chiffres maxi. Ou sens de outil suivant Z ou W en G16

Fnnn,nn

Vitesse d'avance en mm/tr en G95 , 5 chiffres maxi

Fnnnnn,nnn

Vitesse d'avance en mm/min en G94 , 7 chiffres maxi

Fnn,nn

Valeur de la temporisation en secondes en G4 (4 chiffres maxi durée maxi 99.99s)

Fn

Nombre de files en G33 (1 chiffre - 9 filets maxi)

Mnnn

Fonction auxiliaire (3 chiffres maxi - 32 décodées, 224 codées)

Snnnn

Fréquence de rotation de la broche en tr/min en G97 (4 chiffres maxi) ou nombre de répétition d'un sous-programme en G77

Tnnnnn

Numéro d'outil (5 chiffres maxi - de 0 à 65535)

Dnnn

Numéro de correcteur (3 chiffres maxi - de 0 à 255)

Lnnn

Variable programme (3 chiffres maxi - 0 à 19 et de 100 à 199)

Ennnnn

Paramètres externes (5 chiffres)

Définition des fonctions ISO en tournage

Fonctions initialisées à la mise sous tension ou à la suite d'une remise à zéro.

G00

Interpolation linéaire en rapide

G01*

Interpolation linéaire à la vitesse programme

G02

Interpolation circulaire à la vitesse tangentielle programmée sens trigonométrique

G03

Identique à G02 mais en sens trigonométrique

G04

Temporisation programmable avec l'adresse F

G09

Arrêt précis en fin de bloc avant enchaînement sur le bloc suivant

G10

Arrêt d'usinage sur acquisition du signal "Butée fin de bloc" ou sur détection d'un seuil mesuré, en saut à un autre bloc ou enchaînement sur le bloc suivant

G12

Survitesse par manivelle

G16*

Définition de l'axe de l'outil à l'aide des adresses PQR

G20*

Programmation en X et Z

G21

Programmation cartésienne sur le couple d'axes rotatif (C) et rectiligne (X)

G33

Cycle de filetage à pas constant

G38

Filetage enchaîné sur cône

G40*

Annulation de correction d'outil suivant le rayon

G41

Correction de rayon d'outil à gauche du profil

G42

Correction de rayon d'outil à droite du profil

G45

Cycles de poche

G51 G52

Programmation absolue des cotes par rapport à l'origine mesure

G53

Suspension du zéro programme par rapport au zéro machine

G54*

Validation du zéro programme par rapport au zéro machine

G59

Décalage d'origine programme. S'ajoute au décalage. Validé par G54

G64

Cycle d'ébauche paraxial

G65

Cycle d'ébauche de gorge

G66

Cycle de défonçage

G70

Entrée des données en pouce

G71*

Entrée des données en métrique

G75

Validation d'un sous-programme de dégagement d'urgence

G76

Transfert des valeurs courantes des paramètres dans le programme pièce

G77

Appel inconditionnel d'un sous-programme ou d'une suite de séquence avec retour

G79

Saut conditionnel ou inconditionnel à une séquence sans retour

G80*

Annulation de cycle d'usinage

G83

Cycle de débourrage

G87

Cycle de brise-copeaux

G90*

Programmation absolue par rapport à origine programme

G91

Programmation relative par rapport au point de départ du bloc

G92

Limitation de la vitesse de broche. Sxxxx

G92

Présélection de origine programme. X ou Z

G94*

Vitesse d'avance exprimée en mm/min

G95

Vitesse d'avance exprimée en mm/tour

G96

Vitesse de coupe constante

G97*

Vitesse de broche en tour/min. (choix automatique de gamme)

G98

Définition du rayon ou du diamètre de départ lors de l'usage d'un plateau interpolé avec X et Z ou seul pour le calcul de la vitesse de rotation

Remarques :

Seule la fonction M6 n'est pas modale (1). Elle est remise à zéro dès la détection par la CNC du compte rendu de M. Plusieurs fonctions M décodés peuvent être programmées dans un bloc.

Des fonctions M codées peuvent être définies par le constructeur. Ce sont des fonctions "APRES". Une seule de ces fonctions est autorise par bloc.

(1)Modale : une fonction est dite modale lorsqu'elle reste active jusqu'à sa révocation.

Exemple :

Si G1 est programmée dans un bloc, cette fonction est active - tous les déplacement suivants seront en G1 jusqu'a la rencontre d'un G0, G2, G3...

Avant CODE Apres DESIGNATION

M00

Arrêt programmé

M01

Arrêt optionnel

M02

Fin programme pièce

M03

Rotation de broche ses anti-trigonométrique

M04

Rotation de broche senstrigonométrique

M05*

Arrêt de broche

M06

Changement d'outil

M07

Arrosage nø2

M08

Arrosage nø1

M09*

Arrêt des arrosages

M10

Blocage d'axe

M11

Déblocage d'axe

M19

Indexation broche

M40

6 gammes de broches

M45

( suivant CNC )

M48*

Validation des potentiomètres de broche et avance

M49

Inhibition des potentiomètres de broche et avance

M64*

Commande broche 1

M65

Commande broche 2

M66*

Utilisation mesure broche 1

M67

Utilisation mesure broche 2

M998*

Mode MODIF, IMD et appel de sous-programme par l'automate autorisé

M999

Masquage par programmation des modes MODIF, IMD et appel de sous-programme par l'automate

Sous-programmes et sauts en code ISO

Les fonctions G77 et G79 permettent de réaliser des appels de séquences ou de programmes, de façon conditionnelle ou inconditionnelle.

G77 évite de programmer des séquences ou des suites de séquences identiques dans un même programme. Les sous-programme et les sauts peuvent se situer dans un programme, dans un autre programme ou sous-programme. N100 G77 N.. appel de séquence.
Un sous-programme dans le programme principal es défini par les séquences de début et fin. Il peut être situé entre % et M2 ou au-delà de M2.
Le parcours d'un sous-programme défini par deux numéros de séquence ne s'effectue que dans l'ordre croissant des numéros. Pour G77 N200 N10, le système parcourt le programme de N10 à N200 sans signaler une erreur.

Exemples :

- Appel d'un bloc : G77 N10 N10. Seul le bloc N10 est appelé.
- Appel d'un bloc et répétions : G77 N10 N10 S4. Le bloc N10 et appelé 4 fois.
- Appel de séquences : G77 N10 N250. Appel des blocs 10 à 250 inclus.
- Appel de séquences et répétition : G77 N20 N60 S3. Blocs N20 à N60 appelés 3 fois.
- Appel d'un Sous-programme (S/P) : G77 H20.
- Appel et répétions d'un S/P : G77 H20 S5.
- Appel de séquences dans un S/P : G77 H20 N30 N150.
Exemple :

%30
.....
N200 ....
N210 G77 H100 (saut inconditionnel programme   %100, puis retour à la ligne N220 de %30)
N220 ....

G79 : Saut de séquences sans retour.

Le saut de séquences est conditionnel ou inconditionnel, et permet de passer directement à la séquence appelée, qui doit être située dans le même programme.

Saut inconditionnel :
G79 N280 : saut à la séquence 280 qui peut être située avant ou après la séquence d'appel.

Saut conditionnel :
Utilise une variable programme ou un paramètre externe dans le bloc de saut, et d'une condition < ou = ou <, ou de deux simultanément.
G79 L2 >= 3 N280 : si L2 est supérieur ou égal à 3, saut à la séquence 280, sinon enchaînement sur le bloc suivant.

Programmation des poches

La fonction G45 permet d'usiner des poches de forme simple : poches circulaires, oblongues, rectangulaires et rectangulaires avec congés aux quatre coins.

G45 : fonction préparatoire (non modale).
X Y Z : cotes du centre de la poche (en relatif ou absolu).
U V W : cotes du fond de trou (relatif ou absolu).

EB EX EY EZ : cotes en relatif définissant les dimensions de la poche finie (rayon inclus).
EB : rayon.
EX : côté suivant X (ou U).
EY : côté suivant Y (ou V).
EZ : côté suivant Z (ou W).

Vitesses d'usinage

EP : vitesse axiale d'ébauche.
EQ : vitesse latérale d'ébauche.
EI : vitesse axiale de finition.
EJ : vitesse latérale de finition.

Il est possible de programmer quatre vitesse différentes, mais deux vitesses seulement sont obligatoires : une vitesse axiale et une vitesse latérale.

ER : cote du plan de remontée (facultative).

Exemples :

EB programme seul correspond à une poche circulaire (EB=10).
EB et EX programmes correspondent à une poche oblongue ( EB = 10 EX = 40 ).

EX = 40 EY =30 : EX et EY correspondent à une poche carrée ou rectangulaire.
EX = 50 EY =30 EB =5 : EX,EY et EB correspondent à un poche carrée ou rectangulaire avec congés.

P J I Q : prises de passes définissant les ébauches et les finitions.
P : prise de passe axiale.
Q : prise de passe latérale (en ébauche).
I : prise de passe axiale.
J : prise de passe latérale (en finition).

Usinage d'une poche rectangulaire avec congés

Longueur L=100 Largueur I= 50 prof.=44.
Congés R=20 rayon outil D1 r=4

%100
N10 T1 D1 M6
N20 M3 M40 S2000
N30 G X Y Z50
N40 G45 X75 Y52 Z-44 ER2 EX100 EY50 EB20 P10 Q7 EP100 EQ500
N50 Z50
N60 X Y
N70 M2 (fin programme)

Interpolation circulaire et fonction miroir

En interpolation circulaire, le sens G2 et G3 est inversé en miroir X ou en miroir Y.
Pas en miroir XY.

Format : La fonction miroir est validée par G51 suivi du nom de l'axe où doit être appliqué le miroir et du signe -

La fonction miroir peut être appliquée aux axes X,Y et Z.
Elle permet de réaliser des usinages symétriques à partir d'un programme définissant la moitié ou le quart de la pièce.

La fonction miroir affecte :

- Les cotes programmées, qui sont inverses.

- Les décalages programmés en G59.

- La correction de rayon d'outil.

- Le sens de rotation en interpolation circulaire.

La fonction miroir n'affecte pas :

- L'origine pièce PREF.

- Le décalage entre l'origine pièce et le l'origine programme DEC1.

- L'excentration plateau DEC3.

- Les dimensions d'outils.

- La programmation en origine mesure G52.

Cette fonction doit être programmée dans un bloc seul, plusieurs axes pouvant être valides ou invalidés en miroir.

Particularité :

Lorsqu'un miroir est demandé sur l'axe correspondant à la direction d'outil, la direction d'outil doit être reprogrammée (G16) pour tenir compte des miroirs.

Par exemple :

G16 P-
X
Y
G51 X- ( miroir sur axe X )
G16 P+

En interpolation circulaire, le sens de G2, ou G3 est inversé en miroir X ou miroir Y.

Axes rotatifs : la fonction miroir sur axe rotatif inverse le sens de rotation et complémente la cote à 360Â°.

Exemple :

%30 (programme Miroir)
N5 G G90 G80 G40 G74 X-150 Y-150 Z M0
N10 S630 T1.1 M42 M3
N15 G0 X15 Y30 Z3 (1)
N20 G1 Z-5 F63 (1)
N25 X30 (2)
N30 Y15 (3)
N35 GZ3
N40 G51 X ( X+ devient X- )
N45 G77 N15 N35 ( Répéter bloc)
N50 G51 Y ( Y+ devient Y- X- ne change pas)
N55 G77 N1 N35 ( Répéter bloc)
N60 G50 X ( Annule miroir sur X- X deviens positif)
N65 G77 N15 N35 ( Répéter bloc )
N70 G50 Y ( Annule miroir sur Y- Y revient positif)
N75 G77 N5 ( Répéter bloc)
N80 M2

Note :

Remarques :

La fonction miroir s'écrit sans signe.
Avec un correcteur de rayon d'outil, annulez le correcteur avant d'appeler la fonction miroir.
G74 ignore mais n'annule pas la fonction miroir modale.
Les signes des cotes X, Y, Z, et du décalage d'origine G92 sont définis par rapport à l'origine programme.
Toutes les valeurs sont inversées après l'ordre d'inversion G51.

Correction de rayon d'outil

G40

Annulation de correction d'outil suivant le rayon

G41

Correction de rayon d'outil à gauche du profil

G42

Correction de rayon d'outil à droite du profil

Le système calcule le décalage normal au profil et les intersections des trajectoires parallèles aux éléments programmés (droite et cercles). Il applique le décalage en fonction du sens de parcours (G41 ou G42).

Engagement / dégagement

Le premier bloc dans lequel apparaît l'appel de correction (G41 ou G42) est corrigé à son point d'arrivée, suivant la normale élevée au point de départ de la trajectoire exprimée dans le bloc suivant. L'annulation de la correction de rayon (G40) affecte le point programmé du bloc.

Limites d'utilisation de la correction plane

La correction plane (G41 ou G42) implique que le rayon d'outil introduit dans le système soit inférieur ou égale au plus petit rayon de courbure programmé.

Profil extérieur rectangulaire avec congés

Programme exemple :

( Cotation )
L0=....( Rayon fraise +2 )
L1=....    ( 1er cote )
L2=....    ( 2eme cote )
L3=....    ( Profondeur en Z )
L8=....    ( Rayon congé )

( Outil et conditions technologiques )
L4=....    ( NÂ° outil )
L5=....    ( NÂ° correcteur )
L6=....    ( V broche )
L7=....    ( V avance )

( Calculs paramètres )
L10=L1/2-L0 ( x1 )
L11=L1/2 ( x2 )
L12=L1-L8 ( x3 x6 )
L13=L2-L8 ( y5 y8 )
L14=L1/2+L0 ( x11 )

( usinage profil )
N10 TL4 DL5 M6
N20 M3 M40 SL6 FL7
N30 G XL10 Y-L0
N40 Z-L3
N50 G42 G1 XL10 Y-L0 (1)
N60 G2 XL11 Y RL0 (2)
N70 G1 YL12 (3)
N80 G3 XL1 YL0 RL8 (4)
N90 G1 YL13 (5)
N100 G3 XL2 YL12 RL8 (6)
N110 G1 XL0 (7)
N120 G3 X YL13 RL8 (8)
N130 G1 YL0 (9)
N140 G3 XL0 Y RL8 (10)
N150 G1 XL11 (11)
N160 G2 XL14 Y-L0 RL8 (12)
N170 G40 G Z100
N180 M2 ( Fin programme )

Mode d'avance (tournage)

G94 - G95

Avance mm / tr G95.
Avance mm / min G94

Sens de rotation

Le sens est défini, vu du dessus de la broche.
M03 rotation sens horaire (M3).
M04 rotation sens trigonométrique (M4).

Interpolation circulaire

G02 - GO3

Mouvement sens :
- Antitrigométrique G02 a Â» b
- Trigonométrique a Â« b G03.

Fonctions d'arrêt

M00 : arrêt total.
M01 : arrêt optionnel (M1).
M1 a la même valeur que M10 lors qu'il est validé.
M02 : arrêt et fin de programme.
M2 : RAZ du système.
Seul, Départ Cycle (D Cy) permet la continuité après M2.
M05 : arrêt de broche (M5).
M06 Changement d'outil (M6).

Remarque

Après M ou M1 validé, il faut M3 ou M4 pour la remise en mouvement de la broche.
M2 doit être suivie impérativement de X OFF (ISO).

Fonctions M de mise en position ou serrage

Exemples de fonctions définies par le constructeur de M0 :

G40

Annulation de correction d'outil suivant le rayon

M17

Avance du fourreau de la contre-pointe

M18

Recul du fourreau de la contre-pointe

M26

Serrage de la pièce

M27

Desserrage de la pièce (mandrin ou porte-pince hydraulique ou pneumatique)

M36

Verrouillage de la contre-pointe en position

M37

Déverrouillage de la contre-pointe

Appel de palette :

M60

Sortie M61 entrée de la palette gauche

M62

Sortie M63 entrée de la palette droite

Mode de programmation G90 - G91

Ces fonctions précisent les références d'usinage

G90

Toutes les valeurs sont définies depuis l'origine-pièce (ou une même origine)

G91

La référence est la position précédente

Programmation ABSOLUE : G90.
Programmation RELATIVE : G91.

En programmation absolue G90, la cote est repérée par rapport à l'origine programme OP.

G59 : l'axe appelé et la valeur définissent le décalage appliqué à toutes les cotes suivantes.
Un nouveau G59 annule et remplace le précédent.

En programmation relative G91, la cote est repérée par rapport à la position précédente.

G59 : l'axe appelé et la valeur s'appliquent à la première cote suivant G59.
Un nouveau G59 modifie de la même manière la cote qui suivra. En valeur absolue, le décalage sera la somme des valeurs programmées.
G59 est modale.
Le premier déplacement programmé sur chaque axe doit obligatoirement se faire en G90 ou G52.
Pour annuler, programmez :
- Avec G90, G59 X Y Z (zéro).
- Avec G91, revenir en G90, puis programmer G59 X Y Z (zéro).

Rappel :

G59

Décalage d'origine programmé

G90

Programmation Absolue par rapport à OP

G91

Programmation Relative par rapport au point de départ du bloc

Déplacement linéaire G00 - G01

Mouvement rapide : G00
Mouvement programmé : G01

Exemple :

N50 G1 X4500 Y6350 F100

G04 : Temporisation.
Fonction G04.
Valeur 1s F...
G04 F... programmés seuls dans un bloc. Ne sont pas modales.

Exemple :

N10 F500
N20 G04 F2

Temporisation F2 = 2 secondes.
Programmation nécessaire lorsqu'il s'agit d'assurer la finition : d'un fond de gorge, d'alésage, d'épaulement.

Perçage de trous en interpolation circulaire

Fonctions : G81 - G80 - ED

Si une pièce comporte une géométrie déductible par rotation angulaire d'une figure élémentaire, telle que perçage sur circonférence, dentures, il est possible de ne programmer que la figure élémentaire de usinage et d'exécuter une rotation angulaire ED.

Exemples :
Perçages multiples
Décalage angulaire double
Rotation par évolution de ED
Rotation par décalage G59
Perçage de 8 trous 3 fois.

%11
N1 G0 X0 Y0 Z5
N2 G0 X600 Y (ligne de référence)
N3 GXY
N4 G0 X0 Y600 (ligne de référence)
N5 GXY
N6 L8=600*C45
N7 L9=600*S45
N8 G0 XL8 YL9 (ligne de référence)
N9 GXY

N10 M6 T1 D1 (outil)
N11 M3 S1200 D1 (marche en route)
N12 L3=0.01

N50 L1=300*CL3 (calcule valeurs de G59)
N60 L2=300*SL3
N70 L0=0
N80 G59 XL1 YL2
N90 G79 N200 (aller a N200)

N100 (G81 ER2 Z-10 F400) (trou centre)
N102 (G G80)

N105 EDL0 (début perçage)
N120 G81 X40 Y ER2 Z-10 F400
N125 G G80
N130 L0=L0+45
N140 G79 L0<360 N105
N150 G Z5 (fin de perçage)

N200 G77 N100 N150
N220 L3=L3+45
N230 G79 L3<=91 N50 (si condition aller au N50)
N240 G59 X0 Y0
N245 G Z30
N250 M6 T0
N260 M2 (fin de programme)

Règles d'utilisation des décalages

La mesure de position est toujours repérée par rapport à l'origine mesure.
Les cotes programmées peuvent être exprimées dans les formes suivantes :

- Programmation absolue (G90) : la cote est repérée par rapport à l'origine programme.

- Programmation relative (G91) : la cote est repérée par rapport à la position précédente.

- Programmation absolue par rapport à l'origine mesure (G52) : la cote est repérée par rapport à 1'origine mesure.

N10 G52 X ± 5.3 Y ± 5.3 Z ± 5.3

Les décalages et corrections d'outils ne sont pas pris en compte.
Cette fonction est révoquée en fin de bloc et doit être programmée avant les adresses des axes et sans correction de rayon (G41 - G42).

Cette programmation est utilisée pour amener le point piloté sur un point fixe (changement d'outil automatique par exemple).

Remarque

Le premier déplacement du programme sur chaque axe doit obligatoirement être programme en absolu (G90 hors G52 ou G53). Si ce n'était pas le cas, G91 serait interprété comme un G90 pour ce déplacement.
Les cotes programmées, affectées des divers décalages et des dimensions d'outils, sont comparées aux cotes extrêmes de la machine introduites à la mise en route. En cas de dépassement, le système génère un message d'erreur.

POM prise des origines machine intervention manuelle

1. Potentiomètre d'avance à 100%

2. MODE NEUTRE touche allume à la M.S.T

3. RAZ remise à l'état initial

4. MANUEL commande manuelle des axes

5. X- touche de commande manuelle des axes

6. Y- touche de commande manuelle des axes

7. Z- touche de commande manuelle des axes

8. 4+ touche de commande manuelle des axes

9. POM prise des origine machine

10. X+ touche de commande manuelle des axes

11. Y+ touche de commande manuelle des axes

12. Z+ touche de commande manuelle des axes

13. 4 - touche de commande manuelle des axes

Si touche défaut ? allumé : RAZ et recommencer ! ERREUR.
Si touche défaut ? éteint : l'opération POM a réussi.

0rdre des opérations sur le calculateur

Le calculateur effectue les opérations dans l'ordre où elles sont écrites.

L0+L1/2

1. L0+L1 = a

2. a/2 = résultat

L5/3+L1*5

1. L5/3 = a

2. a+L1 = b

3. b*5 = résultat

Il n'y a donc pas respect des règles mathématiques de priorité des opérations (pas d'opérateur prioritaire). Le calculateur n'accepte pas les parenthèses dans les calculs effectués car les parenthèses sont réservées aux commentaires.

Informations d'EDnum

L'éditeur

L'apprentissage de cet éditeur ne vous posera pas de problèmes si vous êtes habitué aux éditeurs dans le style de SideKick.

La ligne d'état de l'éditeur indique, la ligne et colonne courantes, l'état de la bascule Insertion / Recouvrement et le nom du fichier en cours d'édition.

La longueur de ligne maximale de l'éditeur est de 153 caractères, la largeur de la fenêtre d'édition est de 77 caractères. Si vous frappez au-delà, le texte à gauche est translaté.

Vous accédez au menu principal par F10, et passez à une autre option par Alt-initiale d'option. Le fichier contenu dans l'éditeur reste visible. Il suffit de frapper "E" depuis le menu ou ESC de tout autre point pour revenir à l'édition. F1 appelle l'aide intégrée. La frappe de Alt-E fait entrer dans l'éditeur - ESC suffit depuis le menu principal.
Après votre saisie vous êtes en mode Insertion par défaut, vous frappez F10 pour revenir au menu principal ou plus directement Alt-initiale pour activer une des autres options de ce menu. Alt-F6 alterne entre les deux derniers fichiers édités.

Lorsque vous terminez votre session d'édition frappez F10 pour revenir au menu principal. Le texte, bien que toujours visible, n'est plus accessible jusqu'à ce que vous retourniez dans l'éditeur.

Pour copier un bloc de texte

1. Sélectionnez les informations à copier, en marquant le début du bloc par Ctrl-K B. Déplacez le curseur vers le bas jusqu'à la fin du bloc, Ctrl-K K marque la fin de celui-ci.

2. Dans l'éditeur, placez le curseur là où vous voulez insérer les informations du bloc.

3. Ctrl-K C insère les informations du blocs au point d'insertion.

4. Si vous voulez insérer une autre copie des mêmes informations, répétez l'étape 2.

Pour copier des informations provenant d'un autre document, d'un autre module ou d'une autre application voir commandes de blocs Ctrl-K R et Ctrl-K W.

Aide suggestion numériqueF9, touche d'aide langage, fait partie des commandes de l'éditeur. Pour l'utiliser, il suffit, avant de la frapper, de placer le curseur sur un identificateur défini d'une fonction sur la commande numérique. Il fonctionne seulement si le programme et un programme numérique commençant par %nom_programme.

Imprimante

Pour imprimer un bloc sur l'imprimante, marquer le bloc à imprimer, avec Ctrl-K W pour l'écrire sur disque dans Write Bloc To File. Tapez "PRN" dans Vérifiez. A la question Overwrite PRM.xxx [ Y / N ], confirmez par "Y" et, si l'imprimante est disponible, le bloc sera imprimé.

Impression sur menu File

1Â°. Pour imprimer un document trop grand ne pouvant être chargé sur l'éditeur, écrivez sur un fichier Ascii la ligne suivante :

{$I Clients.DOC}

Sauvegardez sur le disque sur un nom, depuis le menu File faites le choix Printer..., tapez le nom du fichier sauvegardé et validez, le fichier Clients.doc sera imprimé.

2Â°. Ecrivez dans un fichier les lignes suivantes :

{$I Clients.DOC}
{$I Notes.DOC}
{$I Lettre.DOC}

Sauvegardez sur le disque sur un nom, depuis le menu File faites le choix Printer..., tapez le nom du fichier sauvegardé et validez, le fichier Clients.doc sera imprimé. Notes.doc et Lettre.doc seront imprimés dans l'ordre qui suit.

Menu File

Le menu déroulant File concerne les fichiers (chargement, création et sauvegarde). Le fichier choisi est automatiquement chargé dans l'éditeur. Vous pouvez réécrire un fichier dans un autre répertoire et/ou sous un autre nom.

Load (F3)

L'option Load permet de choisir le fichier de travail ASCII pour Edit. En face de l'invite, vous pouvez frapper tout nom valide pour le DOS en évitant les homonymes et les extensions .EXE, .BAT .COM. La frappe d'entrée ou de combinaisons avec caractères génériques (*) provoque l'ouverture de la boîte de choix de fichier.

Pick (Alt-F3)

L'option Pick permet de reprendre le travail dans un des huit derniers fichiers chargés dans l'éditeur. Le premier fichier de cette liste historique est celui en cours. Cette facilité vous permet de suspendre l'élaboration d'un fichier pour effectuer une autre action. Au retour dans le fichier, l'environnement d 'édition propre à ce fichier est restauré : position du curseur, marqueurs, paramètres d'édition.

New

L'option New indique un NOUVEAU fichier et l'extension NONAME.Â£Â£Â£ (SANSNOM.Â£Â£Â£) lui est attribuée. Vous donnerez un nom plus précis par les options Save (Sauvegarde) ou Write to (Ecriture vers).

Save (F2)

L'option Save écrit vers un fichier sur disque le contenu actuel de l'éditeur. F2 est équivalent. Si vous tentez de sauvegarder sous le nom NONAME.Â£Â£Â£, une boîte de confirmation s'ouvrira, en frappant Entrée, l'ouverture de la boîte de choix de fichier.

Write to

En fin de session d'édition, choisissez l'option Write to pour sauvegarder ce fichier sous un certain nom. Si le fichier spécifié existe déjà, une demande de confirmation d'écrasement est proposée.

Directory

L'option Directory affiche le contenu d'un répertoire spécifié. Vous pouvez passer d'un répertoire à l'autre. Utilisez les flèches du curseur pour vous déplacer au sein de la boîte de fichiers. Placez-vous sur un sous-répertoire et validez pour entrer dans celui-ci. Frappez l'initiale d'un fichier pour vous déplacer de fichier a fichier ayant cette initiale. Le principe est identique pour les sous-répertoires.
La touche PgDn place le pointeur à la fin de la boite, PgUp début boîte. La touche Echap ESC annule l'opération.
Vous sélectionnez en employant au besoin, les caractères génériques (*) du DOS. Utilisez les flèches du curseur pour vous déplacer au sein de la boîte de fichiers. Frappez l'initiale d'un fichier pour vous déplacer de fichier à fichier. Le principe est identique pour Load.

Change dir

Affiche le nom de l'unité et du répertoire courant et vous permet de changer ce paramètre. La spécification doit être conforme aux règles du DOS. Rappelez-vous qu'un nom de directoire finit toujours par ( \ ).

Printer

Impression des fichiers sur imprimante. Entrez le nom du fichier à imprimer répertoire nom fichier.ext, si le répertoire est omis le répertoire par défaut sera pris. Si le nom du fichier ne contient pas de extension l'extension par défaut sera prise.
La longueur de ligne maximum est de 150 caractères; si la ligne contiens plus ils serons ignorés. L'impression d'une ligne est de 78 caractères; si la ligne contient plus la ligne est coupe avec un saut de ligne.

Insertion d'un fichier dans le fichier à imprimer

Syntaxe : {$I NomFile.EXT} Le fichier NomFile... sera inséré sur cette ligne.

Quit (Alt-X)

L'option Quit provoque la sortie de l'éditeur. Une confirmation est demandée si un fichier non sauvegardé se trouve dans l'éditeur. La frappe de la séquence Alt-X depuis n'importe quel point de la structure produit les mêmes effets.

Menu Edit

Evaluate formule

Vous vous en servez comme d'une calculette : frappez des expressions ou formules telles que ((350 * 5) / 2) + Sqrt(144)i>. Le résultat apparaît au-dessous. Formule et résultat sont sauvegardés, vous pouvez les copier sur l'éditeur à la position du curseur.

Sur l'éditeur, tapez les touches Ctrl-F8. Si la variable formule est nulle pas de copie; résultat nul, pas de copie.

Fonctions mathématiques

- PI

- ABS(x)

- TAN(x)

- ATAN(x)

- COS(x)

- EXP(x)

- LN(x)

- ROUND(x)

- SIN(x)

- SQRT(x)

- SQR(x)

- TRUNC(x)

- RADIA(x)

- ARSIN(x)

- ARCOS(x)

Menu Options

Attributs de fichiers

Définit / Change les attributs d'un fichier :

- ReadOnly : Fichier en lecture seule.

- Hidden : Fichier caché.

- Archive : Indicateur d'archivé (ordinaire).

- Attr ... : Indique les attributs actuels, qu'il possède.

Si le fichier possède l'attribut Système, on ne peut pas changer l'attribut.

Screen size

Modes d'affichage d'écran. Deux modes sont possibles :

- Mode 25 lignes

- Mode VGA mode 50 lignes

Extension par défaut

Les fichiers chargés sur l'éditeur sont sauvegardés dans le fichier *.PCK et restitués au lancement de l'éditeur.

Menu Lang

Block of notes

Fichier de 99 pages de 12 lignes.
Il existe 3 fichiers :

- Anglais Notes

- Numérique Notes (NCN)

- Maths Notes

Ces fichiers peuvent être modifiés à la convenance de l'utilisateur, pour changer le fichier à consulter avec Change of notes.

Phrases and notes

Fichier de 99 pages de 12 lignes. Toutes les pages peuvent être modifiées.

Tables de verbes

Principaux verbes français.

Find examples Les exemples d'aide à la programmation peuvent être créés par l'utilisateur. Il faut respecter les règles suivantes.
Un exemple doit commencer par le code PAS: (langage Pascal) ou ADA: (langage Ada) ou C//: (langage C) ou INF: (fichiers Verbes ou fichiers NCN). Il doit toujours finir par END:.
La longueur d'une ligne est de 46 caractères.
Si la ligne commence par Â£ la ligne est de couleur et le caractère Â£ n'apparaît pas.
Une page comporte 20 lignes.

Notes

Les exemples commençant par INF: doivent être uniques dans un fichier. Quel que soit le langage choisi, le premier INF: sera pris par défaut.
Le volume d'un fichier ne doit pas dépasser 29 Ko maximum.

Langage disque

Définition du répertoire ou disque ou se trouvent les fichier *.Hlp.

Traduction Français/Anglais et Anglais/Français

Traduction d'une phrase.
Sur l'éditeur :

- F6 : Traduction d'un bloc marqué.

- F7 : Traduction d'un mot Anglais vers Français.

- F8 : Traduction d'un mot Français vers Anglais.

L'éditeur dispose de 2 modes de traduction.

Mode traduction d'un bloc marqué

La traduction se fait mot à mot; la Touche F10 met fin à la traduction du bloc.

Touches sur le texte à traduire :

- Flèche gauche : déplace le curseur à gauche.

- Flèche droite : déplace le curseur à droite.

- Touche début : déplace le curseur en début de texte.

- Touche fin : déplace le curseur à la fin du texte.

- Touche Del gauche : efface le caractère à gauche.

Mode traduction d'un mot ou d'une ligne

Tapez le texte à traduire en Anglais ou Français selon le choix. Laissez un espace de mot à mot, et validez avec Entrée pour exécuter la traduction. Les mots inconnus sur le dictionnaire figurent entre parenthèses (...) et ils sont ajoutés dans un fichier de mots inconnus visibles quand on ajoute de nouveaux mots.
Une fois la traduction faite :

- Touche flèche vers le haut : pour revenir au texte original et faire une correction éventuelle. La validation avec Entrée permet de recommencer un nouveau texte.

- Touche ESC : met fin à la traduction.

La traduction des phrases traduites peuvent être sauvegardées dans un bloc avec Alt-S ou retour sur l'éditeur; le bloc peut être copies sur l'éditeur à la position du curseur avec la commande Alt-C. Si on fait une nouvelle traduction, l'ancien bloc est effacé et remplacé par la dernière traduction faite.

- Commande F7 "Suggérer" : Affiche une liste de suggestions sur un mot français.

- Commande F8 "Suggérer" : Affiche une liste de suggestions sur un mot anglais.

Placez le curseur au point d'insertion là où vous voulez insérer le mot puis appuyez sur F7 ou F8. Une boîte de dialogue s'ouvre, tapez le début du mot ou le mot complet que vous voulez et validez. Dans la liste des suggestions, déplacez-vous avec les flèches du curseur vers le bas ou le haut, faites un choix et validez. Pour obtenir la traduction du mot, validez de nouveau. Si vous modifiez le mot, une nouvelle liste de suggestions est proposée.
Pour copier la traduction dans l'éditeur au point insertion, appuyez sur F4. Pour annuler, appuyez sur ESC. Pour mettre fin aux suggestions, appuyez sur ESC depuis la liste.

Menu Graph Trace

Permet de visualiser et teste un programme écrit pour la commande numérique. Graphe trace charge les programmes depuis le disque sur le répertoire de travail. Si le programme chargé sur l'éditeur est un programme écrit pour la commande numérique, à l'ouverture Graphe trace le prend par défaut fichier sans sauvegarde sur le disque. Un message vous demande si voulez le sauvegarder, répondez par Y / N.
Graphe trace chargera automatiquement le programme s'il le trouve sur le répertoire de travail actuel.

Note

Le programme doit avoir une extension *.NUM. La première ligne doit commencer par %numéro, numéro doit être dans la marge de 1 à 9999. Evitez de mettre des commentaires sur parenthèses dans cette ligne.

Help Graph num

Informations sur l'écriture des blocs sur la commande numérique.

Ligne Auto

Cette commande est activée par la touche F5. Entrez le numéro de ligne de commencement et l'incrémentation des lignes; par défaut, se fait d'un (10). Fonctionne seulement sur les programmes numériques.

Touches Auto (F6)

Avec ces touches, on peut programmer un test écrit. Chaque fois qu'elles sont frappées, le texte est inséré à la position du curseur. Leur contenu est sauvegardé à la sortie d'EDNUM; dans un nouveau démarrage, leur contenu est restitué.

Menu Maths

Calculatrice

Rotation en sens G3

Calcule les cordonnes d'une rotation X , Y dans le sens de G3.

Distance et Angle

Calcule la distance d'un point à un autre et donne la valeur d'angle par rapport au premier point.

G3 Centre Arc

Calcule le centre d'un arc et son angle.

Couleur d'Edit

Menu Blocs / Couleurs, vous pouvez changer les couleurs sans sortir de l'éditeur avec sauvegarde ou sans. Ces modifications sont portées dans le fichier EDNUM.INI exécutable lui-même au démarrage de l'éditeur.

Sources

Principaux fichiers sources

Voici les principaux fichiers sources du programme EDNUM. Ils ont été écrits avec Turbo Pascal et Turbo Assembler.

Unité BOX13.PAS

(*****************************************************
EDNUM version 3.001e
programmation commande numerique Num 750/760F
Copyright (S) 1997-2010
programmeur du logiciel A.Ara
64150 Mourenx ville France.
Licence d'utilisation accord dans un but démonstratif
la vente du logiciel et interdite.
Numero de serie 00-331-7431-A1133071e
******************************************************)
{==============  FICHIER DE EDNUM  =================}
{* Types publiques de Fuffers destines a l'editeur *}
{* Max_Buffer=64512;      63 Ko.                   *}
{* Max_Buffer_Copy=5120;  5  ko                    *}
{* Unite BOX13.PAS                                 *}
{***************************************************}

{============================================================}
{  ScrollText( Direction, X1, Y1, X2, Y2, Nbr, Color );      }
{  Translation du texte - le texte est translate             }
{  puis la zone non concernee  est remise ? blanc.           }
{============================================================}
{============================================================}
{  MoveText( X1, Y1, X2, Y2, NewX1, NewY1 );                 }
{  Deplace une zone de texte en une nouvelle position de     }
{ l'ecran                                                    }
{============================================================}
{============================================================}
{  ClearScreen(X1, Y1, X2, Y2, Attrib : Word);               }
{  Efface une zone de l'ecran                                }
{============================================================}

{$O+,F+}
Unit Box13;

Interface
Uses Crt,Dos;

{$L Win_Asm.OBJ}
{$L Miniscul.OBJ}
{$L Uppers.Obj}
{$L SCREEN.OBJ}

{== BOX13 constantes publiques ==}

Const
Titres_Color:Byte=48;
Menu_Color:Byte = 112;
Dir_Color :Byte = 112;
Edit_Color:Byte = 31;
Error_Color:Byte= 78;
Etat_Color:Byte = 23;
Help_Color:Byte = 48;
BX        :Byte= 3;
Block_Color :Byte = 75;
Marque_Color:Byte = 116;
Char_Color  :Byte = 4;

GetMaxEcranX = 80;
GetMaxEcranY = 50;

MinGetMaxEcranY = 25;
EGAInstalled:Boolean=False;
NoCursor = $2000;
InsCursorSmall = $0007;
InsCursorLarge = $000D;

TYPE  {Types publiques}

ScreenColoneRange = 1..GetMaxEcranX;
ScreenlineRange   = 1..GetMaxEcranY;
VideoTypes = (MDA, CGA, MCGA, EGA, VGA);

Direction  = (Up, Down, Left, Right);
ScreenChar = record
Data : Char;
Attrib : Byte;
end;
ScreenArray = array[ScreenLineRange, ScreenColoneRange] of ScreenChar;
ScreenPointer = ^ScreenArray;

EditColoneRange = 1..160;
EditlineRange   = 1..GetMaxEcranY;

ScreenPageXX  = array[EditLineRange, EditColoneRange] of ScreenChar;
ScreenPagePtr = ^ScreenPageXX;

CadreChars = Array[0..5] Of Char;
KeysType   = (On,Off);

Const Double:CadreChars ='ÉÍ»È¼º';
Simple:CadreChars ='ÚÄ¿ÀÙ³';

Var
ScreenPtr  : ScreenPointer;
ScreenPage :ScreenPagePtr;
Getpage    : Byte;
CrtGetMaxY    : ScreenLineRange;
CrtGetMaxX    : ScreenColoneRange;
VideoType  : VideoTypes;
RES_Cursor : Word;
InsCursor  : Word;
OldMode    : Word;
BaseEcran  : Pointer;
TailleEcran:Word;    {renvoie la taille de l'ecran}
Begin_heap :^Word;
DisqueVirtuel:String[40]; {*designe le disque virtuel actif*}

{=== Procedures et fonctions Publiques de BOX13 ==}

Function Filedate(F: String) : Longint;
Function FileMaxSize(F : String) :Longint;
Function  GetTexte:byte;
Function  GetFond:Byte;
Procedure SetColor(Texte,Fond:Byte);
Function  GetCursor : Word;            { Renvoie l'aspect du curseur }
Procedure SetCursor(NewCursor : Word); { Definit l'aspect du curseur }
Procedure ScreenLine25;
(**Procedure ScreenLine50;**)
Procedure CsOn(x,y:byte);
Procedure CsOff;
Procedure PosXY(X,Y:Byte);

Procedure Putxy(x,y:Byte;S:String);     {cordones sur 80x25 sans control}
Procedure Writexy(x,y:Byte;S:String);
Procedure WriteCn(y:Byte;S:String);
Procedure WriteChar(x,y,Count:Byte;Ch:Char);

Function ReadBox(X,Y:Byte;Var SS: String;Longeur,MaxCh:Byte):Boolean;
Function ReadStr(X,Y:Byte;Var S1:String;Longeur:Byte):Boolean;
Function ReadNum(x,y,N:Byte):Integer;
Function ReadReal(x,y,N:Byte;Var Ent:Byte):Real;
Function CrtSize(X1,Y1,X2,Y2:Byte):Word;
Procedure ReadBuf(X1,Y1,X2,Y2:Byte;Var Buf);
Procedure WriteBuf(X1,Y1,X2,Y2:Byte;Var Buf);

Procedure Rectangle(x1,y1,x2,y2:Byte;Var Cadre:CadreChars);
Procedure HighBox(x1,y1,x2,y2,Colori:Byte);
Procedure BoxColor(x1,y1,x2,y2,Colori:Byte);
Procedure BoxFill(x1,y1,X2,Y2:Byte;Ch:Char);

{=====================================================================}

Procedure MoveToScreen(var Source, Dest; Len : Word);
Procedure MoveFromScreen(var Source, Dest; Len : Word);
Procedure ClrscrFinLineXY(Col : ScreenColoneRange; Row : ScreenLineRange);
Procedure MoveText(OldX1, OldY1, OldX2, OldY2, NewX1, NewY1 : Word);

{ Deplace une zone de texte en une nouvelle position de l'ecran }

Procedure ScrollText(Dir : Direction; X1, Y1, X2, Y2, Amt, Attrib : Word);

{Translation du texte - le texte est translate puis la zone non concernee
est remise ? blanc.}

Procedure ClearScreen(X1, Y1, X2, Y2, Attrib : Word);
{ Efface une zone de l'ecran }

Procedure WriteCar(x,Y:Byte;Caractere:Char);
Procedure WriteClip(x,Y:Byte;Car:String;Clip:Byte);
{=========================================================================}
Function  Uppers(Str:String):String;
Function  Miniscul(Str:String):String;

Procedure KeyCaps(tipe:KeysType);

Procedure KeyNum (tipe:KeysType);
Function  GetPrn:Boolean;
Function  TestPrn:Byte;

Function  GetKeyByte:Byte;
Function  SegEcran:Word;
Function  OfsEcran(x,y:Byte):Word;
Procedure ClearBufKey;
Function Babi_Ti(NomA:String;U:Byte):String;
Function Code_Babi_Ti(NomA:String;U:Byte):String;

{**********************************************************************}

Implementation
Uses Get_Key7;

Type
Buf255 = Array[1..255] of Char;

Var Regg:Registers;
{Num_Disk_Save:Byte;}
ch:Char;

{***************************************************************************}
Function Filedate(F: String) : Longint;
{ Verifie la date enregitrement }
var
SR : SearchRec;
begin
FindFirst(F, AnyFile, SR);
If DosError = 0 Then Filedate:=SR.Time
Else Filedate:=0;
end; { FileDate }

Function FileMaxSize(F : String) :Longint;
{ Verifie l'existence du fichier et la Taille }
var
SR : SearchRec;
begin
FindFirst(F, AnyFile, SR);
If (DosError=0) Then FileMaxSize:=Sr.Size
Else FileMaxSize:=-1;
end; { FileMaxSize }

Function Miniscul(Str:String):String;
External {Miniscul};

Function GetTexte:byte; {**** Renvoie la couleur du texte ****}
External {Win_Box};

Function GetFond:Byte; {**** Remvoie la couleur du fond ****}
External {Win_Box};

Procedure SetColor(Texte,Fond:Byte); {Initialise la couleur texte et fond}
begin
textAttr:=(Fond Shl 4)+Texte;
End;

Function  GetKeyByte:Byte;
External {Win_Box};

Procedure KeyCaps(tipe:KeysType);
Begin
Case Tipe Of
On: If Mem[0:$417]<>(Mem[0:$417] OR  $40) Then Mem[0:$417]:=Mem[0:$417] OR  $40;
OFf: If Mem[0:$417]=(Mem[0:$417] OR  $40) Then Mem[0:$417]:=Mem[0:$417] And $BF;
End;
End;

Procedure KeyNum(tipe:KeysType);
Begin
Case Tipe Of
On: If  Mem[0:$417]<>(Mem[0:$417] OR  $20) Then Mem[0:$417]:=Mem[0:$417] OR  $20;
OFf: If  Mem[0:$417]=(Mem[0:$417] OR  $20) Then Mem[0:$417]:=Mem[0:$417] And $DF;
End;
End;

{****** Positione le curseur sur les cordonnes X et Y dans la page 0 *****}

Procedure PosXy(X,Y:Byte);
Const Page=0; {Page 0}
Var Reg:Registers; {Registres unite Dos}
Begin
Begin
Reg.Ax:=2 shl 8;              {Numero de fonction}
Reg.bx:=Page Shl 8;           {Page}
Reg.dx:=(Y-1) Shl 8 + (X-1);  {Cordones}
Intr($10,Dos.registers(Reg)); {Appel}
End;
End;

Function  SegEcran:Word;
External {Win_Box};

Function  OfsEcran(x,y:Byte):Word;
External {Win_Box};

Procedure ClearBufKey;
External {Win_Box};

{*********** converti un majuscules une chaine ***********}

Function Uppers(Str:String):String;
External {Uppers};

{*********************************************************}
{ Entre: x,y codonees, Chaine de caracteres MaxWindow     }
{        Longeur: = place dans la boite                   }
{        MaxCh : nombre de caracteres dans la chaine Max  }
{ cadre: X1= x-2, X2 = x+longeur+1                        }
{ Sortie: renvoit False si operation anule par ESC        }
{    sino renvoit True                                    }
{  ReadBox(x,y,Chaine,longeurBox,nombre de caracteres)    }
{*********************************************************}

Function ReadBox(X,Y:Byte;Var SS: String;Longeur,MaxCh:Byte):Boolean;
Var S:Buf255;
Bg,Key:Byte;
i,X1,X2:Byte;
debut,Pos:Byte;
FinBuf:Byte;

Function Copi(Deb,Nb:Byte):String;
Var p:String;
ii:Byte;
Begin
p:='';ii:=0;
While (ii<>^Z) DO
Begin
P:=P+S[Deb+ii];
Inc(ii);
End;
Copi:=p;
End;

Begin
X1:=X;
X2:=X1+Longeur;
For i:= 1 TO 255 DO S[i]:=' ';
Key:=0;
If SS<>'' Then
Begin
For i:=1 To Length(SS) DO
S[i]:=SS[i];
S[i+1]:=^Z;
Finbuf:=i;

If FinBuf>Longeur Then
Begin
Debut:=(FinBuf-Longeur)+1;
If FinBuf>=MaxCh Then
Begin
Pos:=FinBuf;
X:=(X1+longeur)-1;
End
Else
Begin
Pos:=FinBuf+1;
X:=X1+Longeur;
End;
Putxy(X1,y,Copi(Debut,longeur));
If Debut>1 Then Putxy(X1-1,Y,#17);
End
Else
Begin
Debut:=1;
Putxy(X1,y,Copi(1,FinBuf));
X:=Finbuf+X1;
pos:=Finbuf+1;
End;

If GetFond =0 Then Bg:=7
Else Bg:=GetFond;
HighBox(X1,Y,X,Y,Bg);

PosXy(X,Y);
Key:=KeyBoard;
If (Not Key_Code) And (Key<>13) And (Key in[32..255]) Then
Begin
For i:=0 TO Longeur DO Putxy(X1+i,Y,' ');
For i:=1 To 255 DO S[i]:=' ';
X:=X1;
S[1]:=^Z;
FinBuf:=0;
Debut:=1;
Pos:=1;
End
Else
HighBox(X1,Y,X,Y,Bg);
End  {* SS<>'' *}
Else
Begin
X:=X1;
S[1]:=^Z;
FinBuf:=0;
Debut:=1;
Pos:=1;
End;

PosXy(X,Y);
Repeat
If (Key<>27) And (Key<>13) Then
Begin
{* Del possition curseur droite ****************}
If (Key_Code) And (Key=83) and (Pos<=FinBuf) Then
Begin
For i:=Pos To FinBuf+1 DO
S[i]:=S[i+1];
S[i]:=' ';
Dec(FinBuf);
If Debut>1 Then  {* ramene le debut de un *}
Begin
Dec(Debut);
Putxy(X1,Y,Copi(Debut,Longeur));
Inc(X);
PosXy(x,Y);
End
Else            {* eface vers la droite *}
Putxy(X1,Y,Copi(Debut,Longeur)+' ');
End {* end del droite *}

Else
{* del gauche **********************************}
If ((Not Key_Code) And (Key=8) and (Pos>1)) Then
Begin
If (Debut>1)  then
Begin
Dec(pos);
Dec(Debut);
If Debut=1 Then Putxy(X1-1,Y,' ');
For i:=Pos To FinBuf+1 DO
S[i]:=S[i+1];
S[i]:=' ';
Dec(FinBuf);
Putxy(X1,Y,Copi(Debut,Longeur));
End
Else
If (Debut=1) And (Pos<=Finbuf)  Then
Begin
For i:=pos-1 To FinBuf DO
S[i]:=S[i+1];
S[i]:=' ';
Dec(FinBuf);
Dec(Pos);
Dec(X);
If FinBuf+X1-1FinBuf Then
Begin
Dec(Pos);
S[pos]:=^Z;
Dec(FinBuf);
Dec(X);
Putxy(X,Y,' ');
PosXy(X,Y);
End;
End {* end del gauche *}
Else
{**** fleche vers la quauche *}
{<-}    If (Key_Code) And (Key=75) And (pos>1) then
Begin
Dec(Pos);
If X>X1 Then
Begin
Dec(X);
PosXy(X,Y);
End
Else
Begin
Debut:=Pos;
Putxy(X1,Y,Copi(Pos,Longeur));
End;
If pos=1 Then Putxy(X1-1,Y,' ');
End {******** end fleche gauche *}
Else
{* ramene le curseur debut gauche *}
{<<}    If (Key_Code) And (Key=71) Then
Begin
Putxy(X1,Y,Copi(1,Longeur));
X:=X1;
Pos:=1;
Debut:=1;
PosXy(X,Y);
Putxy(X1-1,Y,' ');
End  {********* end debut gauche *}
Else
{** deplace fin droite >> ******}
{>>}    If (Key_Code) And (Key=79) Then
Begin
If FinBuf>Longeur Then
Begin
For i:=0 To Longeur Do Putxy(X1+i,Y,' ');
Debut:=(FinBuf-Longeur)+1;
Pos:=FinBuf+1;
Putxy(X1,y,Copi(Debut,longeur)+' ');
X:=X1+Longeur;
End
Else
Begin
Debut:=1;
X:=Finbuf+X1;
pos:=Finbuf+1;
End;
PosXy(X,y);
End  {*********** end Fin Droite *}
Else
{* deplace fleche droite une position **********}
{->}    If (Key_Code) And (Key=77) And (Pos<=FinBuf) And (pos<=FinBuf  Then
Begin
Inc(Debut);
Putxy(X1,Y,Copi(Debut,Longeur)+' ');
End
Else
If Pos<=MaxCh Then
Begin
Inc(Debut,1);
{Dec(X);}
Putxy(X1,Y,Copi(Debut,Longeur)+' ');
Putxy(X2-1,Y,'  ');
{ PosXy(X,y);}
End;
End
Else
Begin
Inc(X);
PosXy(X,y);
End;
End {* end fleche droite ****}
Else
{********** insere caractere *}
{inser} If (Not Key_Code) And (Key in[32..255]) And (FinBuf<>^Z) Then
Begin
For i:=FinBuf+1 Downto Pos DO
S[i+1]:=S[i];
S[pos]:=Chr(Key);
Inc(FinBuf);
Inc(pos);
Inc(X);
Putxy(X1,Y,Copi(Debut,Longeur));
PosXy(X,Y);
End
Else
If (S[Pos]=^Z) And (X<=X2) Then
Begin
S[pos]:=Chr(Key);
Inc(FinBuf);
Inc(Pos);
S[pos]:=^Z;
If X=X2 Then
Begin
Inc(Debut);
Putxy(X1,Y,Copi(Debut,Longeur));
End
Else
Begin
Putxy(x,Y,Chr(Key));
Inc(X);
PosXy(X,Y);
End;
End;
End; {**************** end inser ***}

{mark}  If MaxCh>Longeur Then
Begin
If Debut>1 Then Putxy(X1-1,Y,#17) Else  Putxy(X1-1,y,' ');
If FinBuf-Debut>=Longeur Then Putxy(X2,Y,#16)
Else  Putxy(X2,y,' ');
End;

{key}   Key:=KeyBoard;

End;  {*** end key<>27  And Key<>13 **********}

Until (Key=27) OR (Key=13);

If S[1]=^Z Then SS:=''
Else
Begin
i:=1;
While S[i]=#32 DO Inc(i);
SS:=Copi(i,FinBuf);
End;
If Key=13 Then ReadBox:=True
Else ReadBox:=False;
End;{**** << end ReadBox >> ****}

{*********************************************************}
{ Entrees: X,Y codones de affichage Rapor a l'ecran 80x25 }
{          S1  Chaine de caracteres                       }
{    Longueur  nombre de caracteres maximum de entree     }
{                                                         }
{ operations:  EXC,Entree  Revoit la chaine telle qui et  }
{              affichage sur l'ecran.                     }
{              Del-Fleche-gauche: efface caracteres       }
{              Fleche-droite reinsere caracteres effaces  }
{*********************************************************}

Function ReadStr(X,Y:Byte;Var S1:String;Longeur:Byte):Boolean;
Var S:String;
Long,N:Byte;
i,X1,Key:Byte;
Begin
X1:=X;
S:=S1;
N:=LengTh(S1);
Long:=N;
Putxy(X,y,S1);
X:=X+N;
PosXy(X,Y);

Key:=KeyBoard;

If (Not Key_Code) And (Key<>13) And (Key in[32..255]) Then
Begin
If N>0 Then
For i:=0 TO Length(S1) DO
Putxy(X1+i,Y,' ');
X:=X1;
Long:=0;
End;

Repeat
If (Key<>27) And (Key<>13) Then
Begin
If ((Key=8)  OR (Key_Code) And (Key=75)) and (Long>0) Then
Begin
Dec(X);
Putxy(X,Y,' ');
PosXy(X,Y);
Dec(Long);
End
Else
If (Key_Code) And (Key=77) And (LongLength(S1) Then
Begin
S1:=S1+Chr(Key);
S:=S1;
End
Else
Begin
S1[long+1]:=Chr(Key);
S[long+1]:=Chr(Key);
End;
Putxy(X,Y,Chr(Key));
Inc(X);
Inc(Long);
PosXy(X,Y);
If Long>N Then N:=Long;
End;

Key:=KeyBoard;
End;

Until (Key=27) OR (Key=13);
S1:=Copy(S,1,Long);
If Key=13 Then ReadStr:=True
Else ReadStr:=False;
End;{*** end ReadStr ***}

Procedure CsOn(x,y:Byte);
var reg:Registers;
begin
Reg.AX:=$200;
Reg.BH:=GetPage;
Reg.DH:=Y-1;
Reg.Dl:=X-1;
Intr($10,reg);
End;

Procedure CsOff; {*** etein le curseur ***}
var reg:Registers;
begin
Posxy(1,CrtGetmaXY+1);
(**Reg.AX:=$200;
Reg.BH:=GetPage;
Reg.DH:=GetmaxY+1;
Reg.Dl:=0;
Intr($10,reg);**)
END;

{*** Renvoie True si l'imprimante et un etat de imprimer ***}

Function GetPrn:Boolean;
External {Win_Box};

Function TestPrn:Byte;
External {Win_Box};

{*** Positione le curseur sur les cordonnes X et Y dans la page 0 ***}
{*** centre le texte dans le Ecran ou la fenetre active sur laligne Y ***}

Procedure WriteCn(y:Byte;S:String);
External {Win_Box};

{****** Ecrit un texte aux cordonnees X et Y ******}

Procedure Putxy(x,y:Byte;S:String); {sans control cordones 80x25}
External {Win_Box};

Procedure Writexy(x,y:Byte;S:String);
External {Win_Box};

Procedure WriteChar(x,y,Count:Byte;Ch:Char);
External {Win_Box};

{=======================================================================}
{ X,y :    Enplacement a ecrire dans la fenetre active                  }
{   N :    Nombre de caracteres a ecrire maximun                        }
{ note:    la fonction retourne un entier limite entre -32768..32767    }
{=======================================================================}

Function ReadNum(x,y,N:Byte):Integer;
Const Ligne='      ';
Var Err,nn:Integer;
Nstr:String[6];
Lig:String[6];
Ch:Char;
fin:Boolean;
Nc:Byte;
Begin
Err:=1;
nn:=0;
Nc:=1;
Lig:=Copy(Ligne,1,N);
Gotoxy(X-1,Y);
Write(' ',Lig);
GotoXy(x,y);
Nstr:='';
KeyCaps(On);
KeyNum(On);
Repeat
Ch:=ReadKey;
If (Ord(Ch)=8) And (nc>1) Then
Begin
NStr:=Copy(NStr,1,LengTh(NStr)-1);
Gotoxy(WhereX-1,Y);
Write(' ');
Gotoxy(WhereX-1,Y);
Nc:=Nc-1;
End
Else
If (Ord(Ch)<>13) And (Nc<=N) and (Ch in['0'..'9','-']) then
Begin
NStr:=NStr+Ch;
Write(Ch);
Nc:=nc+1;
End;

If ((Ord(Ch)=13) And (Nstr<>'')) OR (Nc>N)  Then
Begin
{$R-}
Val(Nstr,nn,Err);
{$R+}
If Err<>0 Then
Begin
Ch:=' ';
Gotoxy(x-1,y);
Write(' ',Lig);
GotoXy(x,y);
Nc:=1;NStr:='';
End;
End;

Until ((Nstr='') And (Ord(Ch)=13)) OR (Err=0);
KeyCaps(Off);
KeyNum(Off);
If Err=0 Then ReadNum:=nn
Else ReadNum:=0;
Beep;
End;

Function ReadReal(x,y,N:Byte;Var Ent:Byte):Real;
Const Ligne='           ';
Var Err:Integer;
nn:Real;
Nstr:String[11];
Lig:String[11];
Ch:Char;
nc:Byte;
fin:Boolean;
Begin
Err:=1;
nn:=0;
Nc:=1;
Lig:=Copy(Ligne,1,N);
Gotoxy(X-1,Y);
Write(' ',Lig);
GotoXy(x,y);
Nstr:='';
{KeyCaps(On);}
KeyNum(On);
If Ent In[45,48..57] Then Ch:=Chr(Ent)
Else Ch:='#';
Repeat
If (Ord(Ch)=8) And (nc>1) Then
Begin
NStr:=Copy(NStr,1,LengTh(NStr)-1);
Gotoxy(WhereX-1,Y);
Write(' ');
Gotoxy(WhereX-1,Y);
Nc:=Nc-1;
End
Else
If (Ord(Ch)<>13) And (Nc<=N) and (Ch in['0'..'9','-','.']) then
Begin
NStr:=NStr+Ch;
Write(Ch);
Nc:=nc+1;
End;
Ch:=ReadKey;
If ((Ord(Ch)=13) And (Nstr<>'')) OR (Nc>N)  Then
Begin
{$R-}
Val(Nstr,nn,Err);
{$R+}
If Err<>0 Then
Begin
Ch:=' ';
Gotoxy(x-1,y);
Write(' ',Lig);
GotoXy(x,y);
Nc:=1;NStr:='';
End;
End;

Until ((Nstr='') And (Ord(Ch)=13)) OR (Err=0) OR (Ord(ch)=27);
{KeyCaps(Off);}
If Err=0 Then ReadReal:=nn
Else ReadReal:=0;
Ent:=Ord(Ch);
Beep;
End;

{***** Renvoie le nombre d'octets necesaires ? la sauvegarde de la region
Rectangulaire de Ecran specifiee, le nombre et arrondi au kilo octects ****}

Function CrtSize(X1,Y1,X2,Y2:Byte):Word;
External {Win_Box};

{**** Effectue une sauvegarde par octets de la region delimite ******}

Procedure ReadBuf(X1,Y1,X2,Y2:Byte;Var Buf);
External {Win_Box};

{***** Dessine une image par octets sauvegardee par GetImage *******}

Procedure WriteBuf(X1,Y1,X2,Y2:Byte;Var Buf);
External {Win_Box};

{******* dessine un Rectangle sur les cordonees
avec une forme qui peut etre simple traze ou Double *********}

Procedure Rectangle(x1,y1,x2,y2:Byte;Var Cadre:CadreChars);
External {Win_Box};

{****** inverse la region de le ecran  delimite par les cordonees ********}

Procedure HighBox(x1,y1,X2,Y2,Colori:Byte);
External {Win_Box};

Procedure BoxColor(X1,Y1,X2,Y2,Colori:Byte);
External {Win_Box};

{***** Rempli un rectangle avec un caractere determine
le caractere peut etre un code ASCII ? eviter un code de control ******}

Procedure BoxFill(x1,y1,X2,Y2:Byte;Ch:Char);
External {Win_Box};

{**** Sauvegarde un ecran entier sur un fichier dans le disque designe par
par la constante type DisqueVirtuel, le numero donne ? l'ecran repere
le ecran ******** }

Function GetCursor : Word;       { Renvoie l'aspect du curseur }
var
Reg : Registers;
begin
with Reg do
begin
AH := 3;
BH := 0;
Intr($10, Reg);
GetCursor := CX;
end; { Reg }
end; { GetCursor }

procedure SetCursor(NewCursor : Word);      { Definit l'aspect du curseur }
var
Reg : Registers;
begin
with Reg do
begin
AH := 1;
BH := 0;
CX := NewCursor;
Intr($10, Reg);
end; { with }
end; { SetCursor }

function PS2 : Boolean;
{ Renvoit True si vous travaillez avec un adaptateur video PS/2 }
var
Regs : Registers;
begin
Regs.AX := $1A00;
Intr($10, Regs);
PS2 := ((Regs.AL and $FF) = $1A) and
((Regs.BL and $FF) in [$07, $08, $0B, $0C]);
end; { PS2 }

Procedure Screen_Init;
{ Detecte l'adaptateur video et
initialise differentes variables en consequence }
var
Reg : Registers;
begin
OldMode := LastMode;
Reg.AH := $0F;
Intr($10, Reg);     {* Cherche le mode video actuel *}
if Reg.AL <> 7 then
begin
if EGAInstalled then
begin
if PS2 then
VideoType := VGA
else
VideoType := EGA;
end
else begin
if PS2 then
VideoType := MCGA
else
VideoType := CGA;
end;
ScreenPtr := Ptr($B800, 0);
BaseEcran := Ptr($B800, 0);
if Reg.AL < 2 then
CrtGetMaxX := 40
else
CrtGetMaxX := 80;
end
else begin
VideoType := MDA;
ScreenPtr := Ptr($B000, 0);
BaseEcran := Ptr($B000, 0);
CrtGetMaxX := 80;
end;
CrtGetMaxY := Hi(WindMax)+1;
{*Res_Cursor := GetCursor;*}
if (CrtGetMaxY = MinGetMaxEcranY) and (VideoType <> CGA) then
InsCursor := InsCursorLarge
else
InsCursor := InsCursorSmall;
TailleEcran:=MemW[$40:$4C];
end; {* Screen.Init *}

Procedure Screen_VGA;
{* Bascule l'affichage en 43/50-ligne *}
begin
if CrtGetMaxY = MinGetMaxEcranY then
begin
TextMode(Lo(LastMode) + Font8x8);
InsCursor := InsCursorSmall;
end
else begin
TextMode(Lo(LastMode));
InsCursor := InsCursorLarge;
end;
CrtGetMaxY:=(Hi(WindMax)+1);

{*GetmaxY:=Mem[$40:$84]+1;*}
TailleEcran:=MemW[$40:$4C];
end; {* Screen_Vga *}

Procedure ScreenLine25;
Begin
{* Restaure le mode ecran et l'aspect curseur anterieurs au programme *}
TextMode(OldMode);
Screen_Init;
End;
(******** anule le 2010 pour ordinteur(PX)******
Procedure ScreenLine50;
Begin
Screen_VGA;
End;
***********)

procedure ClearScreen(X1, Y1, X2, Y2, Attrib : Word);
{* Efface une zone de l'ecran *}
var
Reg : Registers;
begin
if (X1 > X2) or (Y1 > Y2) then   { Valeurs illegales }
Exit;
with Reg do
begin
AX := $0600;              { Efface l'ecran par routine BIOS }
BH := Attrib;
CH := Pred(Y1);
CL := Pred(X1);
DH := Pred(Y2);
DL := Pred(X2);
Intr($10, Reg);
end; { with }
end; { ClearScreen }

{*** SCREEN ***}

procedure MoveToScreen(var Source, Dest; Len : Word);
external {SCREEN};

{** Deplacement de zones memoire entre memoire "normale" et memoire ecran
- voir le source dans SCREEN.ASM *}

procedure MoveFromScreen(var Source, Dest; Len : Word);
external  {SCREEN};

{** Deplacement de zones memoire entre memoire ecran et memoire "normale"
- voir le source dans SCREEN.ASM **}

procedure MoveText(OldX1, OldY1, OldX2, OldY2, NewX1, NewY1 : Word);
{** Deplace une zone de texte en une nouvelle position de l'ecran **}
var
Counter, Len : Word;
begin
if (OldX2 < OldX1) or (OldY2 < OldY1) then
Exit;
Len := Succ(OldX2 - OldX1) shl 1;
if NewY1 < OldY1 then
begin     {* Deplacement en avant, ligne par ligne *}
for Counter := 0 to OldY2 - OldY1 do
MoveFromScreen(ScreenPtr^[OldY1 + Counter, OldX1],
ScreenPtr^[NewY1 + Counter, NewX1], Len)
end
else begin  {* Deplacement en arri?re, ligne par ligne *}
for Counter := OldY2 - OldY1 downto 0 do
MoveFromScreen(ScreenPtr^[OldY1 + Counter, OldX1],
ScreenPtr^[NewY1 + Counter, NewX1], Len)
end;
end; { MoveText }

procedure ScrollText(Dir : Direction; X1, Y1, X2, Y2, Amt, Attrib : Word);
{** Translation du texte -
le texte est translate puis la zone non concernee est remise ? blanc.**}
begin
case Dir of
Up : begin
MoveText(X1, Y1 + Amt, X2, Y2, X1, Y1);
ClearScreen(X1, Succ(Y2 - Amt), X2, Y2, Attrib);
end;
Down : begin
MoveText(X1, Y1, X2, Y2 - Amt, X1, Succ(Y1));
ClearScreen(X1, Y1, X2, Pred(Y1 + Amt), Attrib);
end;
Left : begin
MoveText(X1 + Amt, Y1, X2, Y2, X1, Y1);
ClearScreen(Succ(X2 - Amt), Y1, X2, Y2, Attrib);
end;
Right : begin
MoveText(X1, Y1, X2 - Amt, Y2, X1 + Amt, Y1);
ClearScreen(X1, Y1, Pred(X1 + Amt), Y2, Attrib);
end;
end; { case }
end; { ScrollText }

procedure ClrscrFinLineXY(Col : ScreenColoneRange; Row : ScreenLineRange);
{* Efface la fin de la ligne *}
begin
GotoXY(Col, Row);
ClrEOL;
end; { ClrscrinLineXY }

Procedure WriteCar(x,Y:Byte;Caractere:Char);
Var Reg:Registers;
Begin
PosXy(x,y);
Reg.AX:=9 shl 8 + Ord(Caractere);
Reg.BL:=GetFond Shl 4 + Char_Color;
Reg.BH:=GetPage;
Reg.CX:=1;
Intr($10,Reg);
End;
Procedure WriteClip(x,Y:Byte;Car:String;Clip:Byte);
Var Reg:Registers;
I:Byte;
Begin
For i:=0 TO Length(Car)-1 DO
Begin
PosXy(x+i,y);
Reg.AX:=9 shl 8 + Ord(Car[i+1]);
Reg.BL:=GetFond Shl 4 + Char_Color + Clip ;
Reg.BH:=GetPage;
Reg.CX:=1;
Intr($10,Reg);
End;
End;

Function Babi_Ti(NomA:String;U:Byte):String;
Var Nom1:String;
i:Byte;
car:Char;
Begin
Nom1:='';
Case U Of
1:  For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Car=#191 Then Nom1:=Nom1+#32
Else
Nom1:=Nom1+Chr(Ord(Car)-70);
End;
2:  For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Car=#145 Then Nom1:=Nom1+#32
Else
Nom1:=Nom1+Chr(Ord(Car)-119);
End;
3:  For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Car=#250 Then Nom1:=Nom1+#32
Else
Nom1:=Nom1+Chr(Ord(Car)-127);
End;
End;
Babi_ti:=nom1;
End;

Function Code_Babi_Ti(NomA:String;U:Byte):String;
Var Nom1:String[80];
i:Byte;
car:Char;

Begin
Nom1:='';
Case U Of
1:  For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Ord(Car)=32 Then Nom1:=Nom1+#191
Else
Nom1:=Nom1+Chr(Ord(Car)+70);
End;
2:  For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Car=#32 Then Nom1:=Nom1+#145
Else
Nom1:=Nom1+Chr(Ord(Car)+119);
End;
3:  For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Car=#32 Then Nom1:=Nom1+#250
Else
Nom1:=Nom1+Chr(Ord(Car)+127);
End;
End;
Code_Babi_ti:=nom1;
End;

Begin
GetPage:=0;
Res_Cursor:=GetCursor;
TextMode(LastMode);
{**ClearScreen(X1, Y1, X2, Y2, Attrib : Word);**}
Screen_Init;

{**Selectione la page ecran active Page 0**}
Regg.AH:=5;
Regg.AL:=Getpage;
Intr($10,Regg);
{**initialise disque virtuel**}
{**Disque_Max;**}
CheckSnow:=False;
TextBackGround(Black);
TextColor(White);
End.

Win_Box.ASM

;=============================================
; EDNUM version 3.001e
; programmation commande numerique Num 750/760F
; Copyright (S) 1997-2010
; programmeur du logiciel A.Ara
; 64150 Mourenx ville France.
; Licence d'utilisation accord dans un but démonstratif
; la vente du logiciel et interdite.
; Numero de serie 00-331-7431-A1133071e
;=============================================
;===========  FICHIER DE EDNUM  ================
; Fichier WIN_BOX.ASM
; Fichier assembleur utilise par l'unit Box13.pas
;=============================================

TITLE   WIN_BOX
LOCALS  @@

;=====================================
; Structure de donnees pour les coordonnees
;=====================================

X               EQU     (BYTE PTR 0)
Y               EQU     (BYTE PTR 1)

;=====================================
; Equivalences de l'espace de travail BIOS
;=====================================

CrtMode         EQU     (BYTE PTR 49H)
CrtWidth        EQU     (BYTE PTR 4AH)

DATA    SEGMENT WORD PUBLIC

;===========================
; Donnees externes de l'unite Crt
;===========================

EXTRN   CheckSnow:BYTE,WindMin:WORD,WindMax:WORD,TextAttr:BYTE
EXTRN   GetMaxX:BYTE,GetMaxY:BYTE

DATA    ENDS

CODE    SEGMENT BYTE PUBLIC

ASSUME  CS:CODE,DS:DATA

;=====================================
; PROCEDURE Writexy(X, Y: Byte; S: String);
;=====================================

PUBLIC  Writexy

Writexy:

PUSH    BP
MOV     BP,SP
LES     BX,[BP+6]   ;charge le pointeur de la chaine S
MOV     CL,ES:[BX]  ;charge dans CL la longeur de la chaine
MOV     DL,[BP+12]  ;charche X
MOV     DH,[BP+10]  ;charche Y
MOV     SI,OFFSET CS:CrtWriteStr
CALL    CrtWrite
POP     BP
RETF    8

;==================================
; PROCEDURE Putxy(X, Y: Byte; S: String);
;==================================

PUBLIC  Putxy

Putxy:
PUSH    BP
MOV     BP,SP
LES     BX,[BP+6]   ;charge le pointeur de la chaine S
MOV     CL,ES:[BX]  ;charge dans CL la longeur de la chaine
MOV     DL,[BP+12]  ;charche X
MOV     DH,[BP+10]  ;charche Y
MOV     SI,OFFSET CS:CrtWriteStr
CALL    CrtEcran
POP     BP
RETF    8

;==================================
; PROCEDURE WriteCn(Y: Byte; S: String);
;==================================

PUBLIC  WriteCn

WriteCn:

PUSH    BP
MOV     BP,SP
LES     BX,[BP+6]    ;charge le pointeur de la chaine S
MOV     CL,ES:[BX]   ;charge dans CL la longeur de la chaine
MOV     AL,windmax.X ;Charge la cordone x max d'ecran
INC     AL
MOV     AH,WindMin.X
INC     AH
SUB     AL,AH
INC     AL
XOR     AH,AH
SUB     AL,CL        ;soustrait la longeur de la chaine
JC      Resul0
MOV     DL,2         ;charge 2  pour diviseur
Div     DL           ;divise AL/2
INC     AL
MOV     DL,AL        ;charche X
XOR     AX,AX        ;remet AX ? 0
MOV     DH,[BP+10]   ;charche Y
MOV     SI,OFFSET CS:CrtWriteStr
CALL    CrtWrite
Resul0: POP     BP
RETF    6

;==============================================
; PROCEDURE WriteChar(X, Y, Count: Byte; Ch: Char);
;==============================================

PUBLIC  WriteChar

WriteChar:

PUSH    BP
MOV     BP,SP
MOV     CL,[BP+8]
MOV     DL,[BP+12]  ;X
MOV     DH,[BP+10]  ;y
MOV     SI,OFFSET CS:CrtWriteChar
CALL    CrtWrite
POP     BP
RETF    8

;========================================
; PROCEDURE BoxFill(x1,y1,x2,y2:Byte; Ch: Char);
; BP+14,12,10 8]  [BP+6]
;========================================

PUBLIC  BOXFill

BOXFill:

MOV     SI,OFFSET CS:CrtWriteChar
JMP     SHORT CommonFill

;=========================================
; PROCEDURE ReadBuf(x1,y1,x2,y2:Byte; var Buf);
; BP+16,14,12,10]      [BP+6]
;=========================================

PUBLIC  ReadBuf

ReadBuf:

MOV     SI,OFFSET CS:CrtReadWin
JMP     SHORT CommonWin

; PROCEDURE WriteBuf(x1,y1,x2,y2:Byte; var Buf);
; BP+16,14,12,10]      [BP+6]
PUBLIC  WriteBuf

WriteBuf:

MOV     SI,OFFSET CS:CrtWriteWin
JMP     SHORT CommonWin

;====================================
; Routine commune pour ReadWin/WriteWin
;====================================

CommonWin:

PUSH    BP
MOV     BP,SP
MOV     AL,[BP+12]   ;X2
MOV     AH,[BP+10]   ;Y2
MOV     CL,[BP+16]   ;X1
MOV     CH,[BP+14]   ;Y1
CALL    ControlBox
CMP     AL,0
JE      FinBuf
XOR     AL,AL
XOR     CX,CX
MOV     DL,[BP+16]   ;X1
DEC     DL
MOV     DH,[BP+14]   ;Y1
DEC     DH
MOV     CL,[BP+12]   ;X2
DEC     CL
SUB     CL,DL        ;CL = X2-X1
INC     CX
@@1:    PUSH    CX
PUSH    DX
PUSH    SI
CALL    CrtBlock
POP     SI
POP     DX
POP     CX
Mov     AH,[BP+10]   ;Y2
Dec     AH
INC     DH
CMP     DH,AH        ;Y1 <= Y2
JBE     @@1
Finbuf: POP     BP
RETF    12

;============================
; Block Apele par FillBox
;============================

CommonFill:

PUSH    BP
MOV     BP,SP
MOV     AL,[BP+10]  ;X2
MOV     AH,[BP+8]   ;Y2
MOV     CL,[BP+14]  ;X1
MOV     CH,[BP+12]  ;Y1
CALL    ControlBox
CMP     AL,0
JE      FinFil
XOR     AL,AL

XOR     CX,CX
MOV     DL,[BP+14] ;Charge X1
DEC     DL
MOV     DH,[BP+12] ;Charge Y1
DEC     DH
MOV     CL,[BP+10] ;Charge X2
DEC     CL
SUB     CL,DL
INC     CX
@@1:    PUSH    CX
PUSH    DX
PUSH    SI
CALL    CrtBlock
POP     SI
POP     DX
POP     CX
Mov     AH,[BP+8]  ;Charge Y2
Dec     AH
INC     DH
CMP     DH,AH
JBE     @@1
FinFil: POP     BP
RETF    10

;==============================================
;  Cordones:  AL = X2    AH = Y2
;             CL = X1    CH = Y1
;  Returne:   AL = 1  si cordones son bonnes sino AL = 0
;==============================================
ControlBox:
CMP  AL,GetMaxX   ;80d
JG   Exit
CMP  AH,GetMaxY   ;25d  ou 50d
JG   Exit
CMP  CL,1
JL   Exit
CMP  CH,1
JL   Exit
CMP  CL,AL
JG   Exit
CMP  CH,AH
JG   Exit

XOR  CX,CX
XOR  AH,AH
MOV  AL,1
Ret

Exit:    XOR  CX,CX
XOR  AX,AX
Ret

;===========================
; Envoie chaine vers l'ecran
;===========================

CrtWriteStr:

PUSH    DS
MOV     AH,TextAttr
LDS     SI,[BP+6]
INC     SI
JC      @@4
@@1:    LODSB
MOV     BX,AX
@@2:    IN      AL,DX
TEST    AL,1
JNE     @@2
CLI
@@3:    IN      AL,DX
TEST    AL,1
JE      @@3
MOV     AX,BX
STOSW
STI
LOOP    @@1
POP     DS
RET
@@4:    LODSB
STOSW
LOOP    @@4
POP     DS
RET

;===============================
; Ecriture de caracteres vers l'ecran
;===============================

CrtWriteChar:

MOV     AL,[BP+6]
MOV     AH,TextAttr
JC      @@4
MOV     BX,AX
@@1:    IN      AL,DX
TEST    AL,1
JNE     @@1
CLI
@@2:    IN      AL,DX
TEST    AL,1
JE      @@2
MOV     AX,BX
STOSW
STI
LOOP    @@1
RET
@@4:    REP     STOSW
RET

;=====================================
; Lecture de l'ecran vers le tampon fenetre
;=====================================

CrtReadWin:

PUSH    DS
PUSH    ES
POP     DS
MOV     SI,DI
LES     DI,[BP+6]               ;Charge dans DI  le pointeur
CALL    CrtCopyWin
MOV     [BP+6],DI
POP     DS
RET

;=====================================
; Recopie du tampon de fenetre vers l'ecran
;=====================================

CrtWriteWin:

PUSH    DS
LDS     SI,[BP+6]
CALL    CrtCopyWin
MOV     [BP+6],SI
POP     DS
RET

;===============================
; Routine de copie de tampon fenetre
;===============================

CrtCopyWin:

JC      @@4
@@1:    LODSW           ;charge dans AX bouble mot
MOV     BX,AX
@@2:    IN      AL,DX
TEST    AL,1
JNE     @@2
CLI
@@3:    IN      AL,DX
TEST    AL,1
JE      @@3
MOV     AX,BX
STOSW
STI
LOOP    @@1
RET
@@4:    REP     MOVSW
RET

;========================================
; Realise operation ecran rapor a la fenetre active
; In    CL = Longueur tampon
;       SI = Pointeur sur procedure Write
;       BP = Pointeur sur cadre de pile
;       DL = cordone X
;       DH = cordone Y
;========================================

CrtWrite:
DEC     DL
ADD     DL,WindMin.X
JC      CrtExit
CMP     DL,WindMax.X
JA      CrtExit

DEC     DH
ADD     DH,WindMin.Y
JC      CrtExit
CMP     DH,WindMax.Y
JA      CrtExit
XOR     CH,CH
JCXZ    CrtExit
MOV     AL,WindMax.X
SUB     AL,DL
INC     AL
CMP     CL,AL
JB      CrtBlock
MOV     CL,AL

;==============================
; Realise l'operation ecran
; In    CL = Longueur tampon
;       DX = Coordonnees ecran
;       SI = Pointeur sur procedure
;=============================

CrtBlock:
MOV     AX,40H
MOV     ES,AX
MOV     AL,DH
MUL     ES:CrtWidth
XOR     DH,DH
ADD     AX,DX
SHL     AX,1
MOV     DI,AX
MOV     AX,0B800H
CMP     ES:CrtMode,7
JNE     @@1
MOV     AH,0B0H
@@1:    MOV     ES,AX
MOV     DX,03DAH
CLD
CMP     CheckSnow,1
JMP     SI

; Sortie des routines ecran

CrtExit:
RET
;============================================
; Realise operation ecran rapor a la fenetre 80x25
; In    CL = Longueur tampon
;       SI = Pointeur sur procedure Write
;       BP = Pointeur sur cadre de pile
;       DL = cordone X  DH = cordone Y
;=============================================

CrtEcran:
CMP     DL,1       ; cordone X
JB      CrtExit    ; saut si inferieur a 1
CMP     DH,1       ; cordone Y
JB      CrtExit    ; saut si inferieur a 1

CMP     DL,80
JA      CrtExit    ; saut si superieur a 80
Dec     DL         ; DL contien X
DEC     DH         ; Dh contien Y
CMP     DH,GetMaxY
JA      CrtExit    ; saut si superieur a 25
XOR     CH,CH
JCXZ    CrtExit
MOV     AL,GetMaxX      ; charge AL 80
SUB     AL,DL      ; sustrait ,  AL = (AL-DL)
INC     AL
CMP     CL,AL
JB      CrtBlock
MOV     CL,AL
JMP SHORT CrtBlock

;========================================
; function CrtSize(x1,y1,x2,y2:Byte): Word;
; BP+ 12,10,8, 6
;========================================

PUBLIC  CrtSize

CrtSize:

PUSH    BP
MOV     BP,SP
PUSH    BX
MOV     AL,[BP+8]
DEC     AL
MOV     AH,[BP+6]
DEC     AH
MOV     BL,[BP+12]
DEC     BL
MOV     BH,[BP+10]
DEC     BH
;AX contien X2,Y2
SUB     AX,BX         ;BX contien X1,Y1
ADD     AX,101H
MUL     AH
SHL     AX,1
POP     BX
POP     BP
RETF    8

;================ Debut BoxChar ===================

;PROCEDURE Rectangle(X1, Y1,  X2, Y2: Byte; Cadre:Cadreforme);

PUBLIC Rectangle

Rectangle:

PUSH  BP
MOV   BP,SP
PUSH  DI
PUSH  SI

MOV   AL,[BP+10]    ;y2
MOV   AH,[BP+14]    ;y1
CMP   AL,AH
JNA   @@3           ;si Al<=AH  /  y2 <= Y1  fin
DEC   AL                ;initialise cordones Ecran Max = 0,0 et 79,24
DEC   AH
MOV   [BP+10],AL    ;ecri les cordonees su la pile decrementes
MOV   [BP+14],AH
MOV   AL,[BP+12]    ;cordonee X2
MOV   AH,[BP+16]    ;cordonee X1
CMP   AL,AH              ;si AL<=AH  /  X2 <= X1 fin
JNA   @@3
DEC   AL
DEC   AH
MOV   [BP+12],AL
MOV   [BP+16],AH

LES   DI,[BP+6]                ;forme de cadre simple ou double
Call  BlockRectangle1
@@3:  POP   SI
POP   DI
POP   BP
RETF  12

BlockRectangle1:              ;block depandant de procedure Rectangle

MOV   DL,[BP+16]       ;X1  Affiche angle1 haut Gauche
MOV   DH,[BP+14]       ;y1
XOR   CX,CX
MOV   CL,01
MOV   AL,ES:[DI+0]
Call  BlockWrite1

MOV   DL,[BP+16]    ;X1   Trace ligne horizontal Haut
MOV   DH,[BP+14]    ;y1
INC   DL
XOR   CX,CX
MOV   CL,[BP+12]      ;nonbre de fois ? afficher
SUB   CL,[BP+16]       ;CL = X2-X1
MOV   AL,ES:[DI+1]
Call  BlockWrite1

MOV   DL,[BP+12]       ;X2   Affiche angle2 haut droite
MOV   DH,[BP+14]       ;y1
XOR   CX,CX
MOV   CL,1
MOV   AL,ES:[DI+2]
Call  BlockWrite1

MOV   DL,[BP+16]    ;X1  Affiche angle3  bas gauche
MOV   DH,[BP+10]    ;y2
XOR   CX,CX
MOV   CL,01
MOV   AL,ES:[DI+3]
Call  BlockWrite1

MOV   DL,[BP+16]    ;X1  Trace ligne horizontal Bas
MOV   DH,[BP+10]    ;y2
INC   DL
XOR   CX,CX
MOV   CL,[BP+12]    ;nonbre de fois ? afficher
SUB   CL,[BP+16]     ;CL = X2-X1
MOV   AL,ES:[DI+1]
Call  BlockWrite1

MOV   DL,[BP+12]    ;X2   Affiche angle4 bas droite
MOV   DH,[BP+10]    ;y2
XOR   CX,CX
MOV   CL,1
MOV   AL,ES:[DI+4]
Call  BlockWrite1

MOV   DL,[BP+16]    ;X1  Traze ligne Hauteur Gauche
MOV   DH,[BP+14]    ;y1
INC   DH
XOR   CX,CX
MOV   CL,1
MOV   AL,ES:[DI+5]
Call  BlockWriteHaut

MOV   DL,[BP+12]    ;X2   Trace ligne Hauteur Droite
MOV   DH,[BP+14]    ;y1
INC   DH
XOR   CX,CX
MOV   CL,1
MOV   AL,ES:[DI+5]
Call  BlockWriteHaut

MOV   AH,2          ;positione curseur interieur de cadre
MOV   BH,0
MOV   DL,[BP+16]    ;X1
MOV   DH,[BP+14]    ;y1
INC   DL
INC   DH
INT   10h
RET

;====================================
; Entrees: DL cordonee " X "
;          DH cordonee " Y "
;          CX nombre de caracteres ? ecrire
;          AL Caractere ASCII
;====================================

BlockWrite1:             ;block depandant de procedure BoxChar

MOV   AH,2       ;fonction positione curseur sur l'ecran
MOV   BH,0
INT   10h

MOV   AH,9       ;fonction ecrire sur l'ecran
MOV   BH,0
MOV   BL,TextAttr
INT   10h
RET

;======================================
; Entrees:  DH cordonee: " Y1"
;           DL cordonee: " X1 ou X2 "
;           AL caractere ASCII
;           CX nombre de caracteres ? ecrire
; Sortie:   Cant Y1 >= Y2
;======================================

BlockWriteHaut:             ;block depandant procedure BoxChar

@@2: CMP   DH,[BP+10]    ;controle si y1 < que Y2
JGE   @@1
MOV   AH,2               ;foction positione curseur
MOV   BH,0
INT   10h

MOV   AH,9                ;foction ecrire ecran
MOV   BH,0                ;page ecran ? ecrire
MOV   BL,TextAttr   ;atribut de caractere
INT   10h
INC   DH                     ;incremente cordonee Y1
JMP   @@2              ;saut
@@1: RET

;==== End Rectangle ====

;================================================
; Function GetkeyByte:Byte  revoit le nø de la touche Tape
;================================================

PUBLIC GetKeyByte

GetKeyByte:
MOV     AH,1
Int     16h
Jz      @@2    ;PasCaractere Disponibles
MOV     AH,0
Int     16h
CMP     AL,0
Je      @@1    ;Si AL =0  Saut
RetF           ;Sino Resulta dans AL
@@1:   MOV    AL,AH
RetF
@@2:   MOV    AX,0000H
RetF

;==========================
;Function GetPrn:Boolean
;==========================

PUBLIC GetPrn

GetPrn:
MOV   AH,2
MOV   DX,0
Int   17h
CMP   AH,90h
JNE   @@1
MOV   AL,01
RETF
@@1:   MOV   AL,00
RETF

;========================
;Function TestPrn:Integer
;========================

PUBLIC TestPrn

TestPrn:
MOV   AH,2
MOV   DX,0
Int   17h
MOV   AL,AH
RETF

;===========================================
;Procedure ClearBufKey        vide le buffer du clavier
;===========================================

PUBLIC ClearBufKey

ClearBufKey:

MOV   AH,1           ;fonction: encore caracteres dans buffer ?
Int   16h                 ;appeler interruction clavier BIOS
JE    @@1            ;plus de daractere dans le buffer -->Fin
XOR   AH,AH        ;fonction retire caractere du buffer
Int   16h
JMP   ClearBufKey     ;tester si encore des caracteres
@@1:  XOR   AX,AX          ;tout est en ordre
RETF                               ;retour au programme d'appel

;================================
;   Function GetTexte:Byte;
;================================

PUBLIC GetTexte

GetTexte:
XOR   AX,AX
MOV   AL,[TextAttr]
SHL   AL,1
SHL   AL,1
SHL   AL,1
SHL   AL,1
XOR   AH,AH
SHR   AL,1
SHR   AL,1
SHR   AL,1
SHR   AL,1
RETF

;==========================
;Function GetFond:Byte;
;==========================

PUBLIC GetFond

GetFond:
XOR   AX,AX
MOV   AL,[TextAttr]
SHL   AL,1
XOR   AH,AH
SHR   AL,1
SHR   AL,1
SHR   AL,1
SHR   AL,1
SHR   AL,1
RETF

;========================
;Function SegEcran:Word;
;========================

PUBLIC SegEcran

SegEcran:
MOV  AH,0FH    ;Focntion  lire parametres video du BIOS
INT  10H
CMP  AL,7      ;est une carte mono
JNE  @@1       ;nom ----> @@1
MOV  AX,0B000h ;carte Mono
RET
@@1:  MOV  AX,0B800h ;carte Couleur
RETF

;===============================
;Function OfsEcran(X,Y:Byte):Word;
;===============================

PUBLIC OfsEcran

OfsEcran:
PUSH BP
MOV  BP,SP
PUSH ES
MOV  DL,[BP+8]         ;cordone "X"
MOV  DH,[BP+6]         ;cordone "Y"
DEC  DL
DEC  DH
MOV  AX,40H            ;Segment variables video du BIOS
MOV  ES,AX             ;ES Segment variables Bios
MOV  AL,DH             ;AL cordonnee ligne =(Y-1)
MUL  ES:Byte Ptr [4AH] ;ES:4Ah = nonbre de colones par ligne  BIOS
XOR  DH,DH             ;resutat de multiplication dans AX
ADD  AX,DX             ;addition la cordonnee (X-1)
SHL  AX,1              ;decalage ? gauche de 1 bit = AX * 2
POP  ES
POP  BP
RETF  4

;========================================
;Procedure HigthBox(x1,y1,x2,y2:Byte;Color:Byte);
;========================================

PUBLIC HighBox

HighBox:

PUSH BP
MOV  BP,SP
MOV  CL,[BP+14]  ;cordone X1
MOV  CH,[BP+12]  ;cordone Y1
MOV  AL,[BP+10]  ;cordonee X2
MOV  AH,[BP+8]   ;cordonee Y2
CALL ControlBox

MOV  DL,[BP+14]  ;cordonee X1
MOV  DH,[BP+12]   ;Cordonee Y1
DEC  DL
DEC  DH
MOV  AL,50H      ;calcule l'adresse de x1,y1
MUL  DH
XOR  DH,DH
ADD  AX,DX
Shl  AX,1
INC  AX          ; AX + 1 pour l'attribut du caractere

MOV  DI,AX       ;Adresse de X1,Y1
MOV  BX,AX       ;Adresse de reserve

MOV  AX,0B800H   ;ecran couleur
PUSH AX
POP  ES

MOV  DL,[BP+12]  ;cordonee Y1
MOV  DH,[BP+8]  ;cordonee Y2

@@3:  CMP  DL,DH      ;texte Y1  et Y2
JNLE @@2        ;fin si y1 > Y2
MOV  CL,[BP+10]  ;cordonee X2
SUB  CL,[BP+14] ;cordonee X1
INC  CL
XOR  CH,CH      ;CL = longeur de la ligne
JCXZ @@2        ;Fin si CX = zero

MOV  AL,17d
MOV  AH,[BP+6]  ;Code couleur pour l'inversement
MUL  AH
MOV  AH,AL

@@1:  MOV  AL,ES:[DI]
XOR  AL,AH     ;77H     ;change le attribut du l'octet
MOV  ES:[DI],AL
INC  DI         ;Incremente de deux pour trouver l'attribut suivant
INC  DI
LOOP @@1
ADD  BX,00A0H   ;Adresse de reserve + 160d  change de ligne
MOV  DI,BX
INC  DL         ;y1 := y1+1
JMP  @@3        ;Boucle

@@2:  POP  BP         ;Fin
RETF 10

;=======================================
;Procedure BoxColor(x1,y1,x2,y2:Byte;Color:Byte);
;=======================================

PUBLIC BoxColor

BoxColor:

PUSH BP
MOV  BP,SP

MOV  DL,[BP+14]  ;cordonee X1
MOV  DH,[BP+12]   ;Cordonee Y1
DEC  DL
DEC  DH
MOV  AL,50H      ;calcule l'adresse de x1,y1
MUL  DH
XOR  DH,DH
ADD  AX,DX
Shl  AX,1
INC  AX          ; AX + 1 pour l'attribut du caractere

MOV  DI,AX       ;Adresse de X1,Y1
MOV  BX,AX       ;Adresse de reserve

MOV  AX,0B800H   ;ecran couleur
PUSH AX
POP  ES

MOV  DL,[BP+12]  ;cordonee Y1
MOV  DH,[BP+8]  ;cordonee Y2

@@3:  CMP  DL,DH      ;texte Y1  et Y2
JNLE @@2        ;fin si y1 > Y2
MOV  CL,[BP+10]  ;cordonee X2
SUB  CL,[BP+14] ;cordonee X1
INC  CL
XOR  CH,CH      ;CL = longeur de la ligne
JCXZ @@2        ;Fin si CX = zero

MOV  AL,17d
MOV  AH,[BP+6]  ;Code couleur
;MUL  AH
;MOV  AH,AL

@@1:  MOV  AL,ES:[DI]
Mov  AL,AH     ;77H     ;change le attribut du l'octet
MOV  ES:[DI],AL
INC  DI         ;Incremente de deux pour trouver l'attribut suivant
INC  DI
LOOP @@1
ADD  BX,00A0H   ;Adresse de reserve + 160d  change de ligne
MOV  DI,BX
INC  DL         ;y1 := y1+1
JMP  @@3        ;Boucle

@@2:  POP  BP         ;Fin
RETF 10

CODE    ENDS

END
;============================
; End de Fichier WIN_BOX.ASM
;============================

Miniscul.ASM

;=============================================
; EDNUM version 3.001e
; programmation commande numerique Num 750/760F
; Copyright (S) 1997-2010
; programmeur du logiciel A.Ara
; 64150 Mourenx ville France.
; Licence d'utilisation accord dans un but démonstratif
; la vente du logiciel et interdite.
; Numero de serie 00-331-7431-A1133071e
;=============================================

;=================================
; Fichier Miniscul
; resulta sur fonction type String
;=================================

CODE SEGMENT BYTE PUBLIC

ASSUME  CS:CODE

PUBLIC Miniscul

MajResult  EQU  DWORD PTR [BP+10]
MajChaine  EQU  DWORD PTR [BP+6]

;===========================
;Function Uppers(S:String):String;
;===========================

Miniscul  PROC FAR

PUSH BP
MOV  BP,SP
PUSH DS

LDS  SI,MajChaine    ;charge l'adresse de la chaine
LES  DI,MajResult     ;Charge l'adresse du resultat
CLD                              ;indicateur de direction ? 0
LODSB                         ;charge la longeur de la chaine
STOSB                         ;copie dans resultat
MOV  CL,AL                 ;longeur de la chaine dans CX
XOR  CH,CH               ;met CH ? zero
JCXZ U3                      ;Saut si Cx = 0

U1:    LODSB                      ;charge caractere dans AL, incremente SI
CMP  AL,'A'                  ;saut si caractre diferan de
JB   U2
CMP  AL,'Z'                  ;l'intervalle 'a' ?  'z'
JA   U2
ADD  AL,'a'-'A'             ;converti en majuscule

U2:    STOSB                      ;copie dans resultat
LOOP U1                     ;boucle tant que cx diferan de zero
;d?cremente CX sans modifier les indicateurs
U3:    POP  DS                  ;depile Ds
POP  BP                      ;depile Bp
Ret  4                           ;Retour de pile 6 octets

Miniscul   ENDP               ;fin de procedure

CODE ENDS

END
;=============================
;End Fichier Miniscul
;=============================

Uppers.ASM

;=============================================
; EDNUM version 3.001e
; programmation commande numerique Num 750/760F
; Copyright (S) 1997-2010
; programmeur du logiciel A.Ara
; 64150 Mourenx ville France.
; Licence d'utilisation accord dans un but démonstratif
; la vente du logiciel et interdite.
; Numero de serie 00-331-7431-A1133071e
;=============================================

;=================================
; Fichier Uppers.asm
; resulta sur fonction type String
;=================================

Code Segment byte public

assume CS:Code

PUBLIC Uppers
;===============================
;  Function Uppers(s: String):String
;===============================

MajResult   EQU  DWORD PTR [BP+10]
MajChaine   EQU  DWORD PTR [BP+6]

Uppers  Proc Far

Push BP
Mov  BP,SP
Push DS
LDS  SI,MajChaine
LES  DI,MajResult
CLD
LODSB
STOSB
MOv  CL,AL
XOR  CH,CH
JCXZ U3
U1: LODSB
CMP  AL,'a'

JB   U2
CMP  AL,'z'
JA   U2
SUB  AL,'a'-'A'
U2: STOSB
LOOP U1
U3: POP  DS
POP  BP
RET  4

Uppers   ENDP

CODE ENDS

End

;=================================
; End Fichier Uppers.asm
;=================================

Screen.ASM

;=============================================
; EDNUM version 3.001e
; programmation commande numerique Num 750/760F
; Copyright (S) 1997-2010
; programmeur du logiciel A.Ara
; 64150 Mourenx ville France.
; Licence d'utilisation accord dans un but démonstratif
; la vente du logiciel et interdite.
; Numero de serie 00-331-7431-A1133071e
;=============================================

;==================================
; Fichier Screen.ASM
;==================================

MODEL TPASCAL

LOCALS

DATASEG

EXTRN CheckSnow : BYTE

CODESEG

PUBLIC MoveToScreen, MoveFromScreen

;====================================================
; procedure MoveToScreen(var Source, Dest; Len : Word);
;
; Recopie une zone memoire entre RAM et memoire video en gerant
; un eventuel effet de neige sur certains ecrans CGA.
; Variables:
;   Source : Pointeur long vers la zone RAM ? copier
;   Dest   : Pointeur long vers la zone video ? ecraser
;   Len    : Quantite d'octets ? copier
;=====================================================

Proc MoveToScreen Source : DWord, Dest : DWord, Len : Word
push    ds
mov     bh,[CheckSnow]       ; Charge valeur de CheckSnow
lds     si,[Source]                   ; Pointeur source dans DS:SI
les     di,[Dest]                       ; Pointeur dest dans ES:DI
mov     cx,[Len]                      ; Len dans CX
jcxz    @@0                            ; Fin si Len = 0
cmp     si,di                            ; Teste si source est avant destination
jle     @@1                             ; Si oui, copie ? partir de la fin
cld                                            ; Incrementation de copie de chainesnes
jmp     short @@2
@@1:
add     si,cx                            ; Amene SI et DI en fin de zones memoire
sub     si,2
add     di,cx
sub     di,2
std                                           ; Decrementation chaines
@@2:
cmp     bh,0                            ; Si CheckSnow = false, affichages rapides
je      @@7
@@3:
shr     cx,1                              ; Conversion octets en mots
mov     dx,3DAh                    ; DX pointe sur le port d'etat de CGA
mov     bl,9
@@4:
lodsw                                    ; Lecture d'un mot
mov     bp,ax                         ; Le sauve dans BP
@@5:
in      al,dx                              ; Lit l'etat du 6845
rcr     al,1                               ; Teste si en balayage ligne
jb      @@5                            ; Boucle si oui : on evite d'ecrire
; pendant ce temps. Il n'y a de temps que
;   pour exactement 1 STOSW
cli                                            ; Et surtout pas d'interruptions !
@@6:
in      al,dx                              ; Lit l'etat du 6845
and     al,bl                            ;Teste les deux balayages : si la carte video
; n'indique pas de balayage ligne pendant
; le balayage trame, on peut envoyer plusieurs
;  caracteres pendant la trame
jz      @@6                             ; Boucle si = 0
mov     ax,bp                          ;Lit le mot de l'ecran video
stosw                                     ; Le sauve
sti                                            ; Demasque les interruptions
loop    @@4                          ; Au suivant !
jmp     short @@0
@@7:
shr     cx,1                               ; Conversion d'octets en mots
rep     movsw
@@0:
pop     ds                                ; Restaure DS
ret
ENDP

;==============================================================
; procedure MoveFromScreen(var Source, Dest; Len : Word);
;
; Recopie une zone de memoire video en memoire normale en gerant l'effet de
; neige des ancienness cartes CGA.
; Variables:
;   Source : Pointeur long vers la zone video ? copier
;   Dest   : Pointeur long vers la zone memoire vive ? ecraser
;   Len    : Quantite d'octets ? copier
;===============================================================

Proc MoveFromScreen Source : DWord, Dest : DWord, Len : Word
push    ds
mov     bh,[CheckSnow]
lds     si,[Source]
les     di,[Dest]
mov     cx,[Len]
jcxz    @@0
cmp     si,di

jle     @@1
cld
jmp     short @@2
@@1:
add     si,cx
sub     si,2
add     di,cx
sub     di,2
std
@@2:
cmp     bh,0
je      @@6
@@3:
shr     cx,1
mov     dx,3DAh
@@4:
in      al,dx
rcr     al,1
jb      @@4
cli
@@5:
in      al,dx
rcr     al,1
jnb     @@5
lodsw
sti
stosw
loop    @@4
jmp     short @@0
@@6:
shr     cx,1
rep     movsw
@@0:
pop     ds
ret
ENDP

END

;=================================
;      Fin Fichier Screen.ASM
;=================================

Unité Get_key7.PAS

{============================================
EDNUM version 3.001e
programmation commande numerique Num 750/760F
Copyright (S) 1997-2010
programmeur du logiciel A.Ara
64150 Mourenx ville France.
Licence d'utilisation accord dans un but démonstratif
la vente du logiciel et interdite.
Numero de serie 00-331-7431-A1133071e
============================================}
{===========================================}
Unite Get_key7.pas
============================================}

{$O+,F+}
Unit Get_Key7;
Interface

Const
Shift_D:Boolean=False;
Shift_G:Boolean=False;
Ctrl:Boolean=False;                { press key Ctrl ok }
Alt:Boolean=False;                  { press key Alt  ok  }
Inser_mode:Boolean=True;  { press key Inser ok }
Key_Code:Boolean=False;   { code clavier etendue ok }

Function KeyBoard:Byte;
Procedure Beep;

Implementation

Uses crt,Dos;
Var Reg_DOS:Registers;

Procedure Beep;
{** Genere un bip grave **}
begin
Sound(4071);
Delay(50);
NoSound;
end;
{** Beep **}

Function KeyBoard:Byte;
Var ch:Char;
Begin
Reg_DOS.AX:=$0C00;
MsDos(Reg_DOS);
ch:=Readkey;
If Mem[0:$417] And 128 = 128 Then Inser_Mode:=True
Else Inser_mode:=False;
If Mem[0:$417] And 8 = 8  Then Alt :=True
Else Alt:=False;
If Mem[0:$417] And 4 = 4  Then Ctrl:=True
Else Ctrl:=False;
If Mem[0:$417] And 2 = 2  Then Shift_G:=True
Else Shift_G:=False;
If Mem[0:$417] And 1 = 1  Then Shift_D:=True
Else Shift_D:=False;

If (ch = #0) then
Begin
KeyBoard:=Ord(Readkey);
Key_Code:=True;
End
else
Begin
KeyBoard:=ord(ch);
Key_Code:=False;
end;
End; {** end keyBoard **}
End.

Unité Graphe Trace.PAS

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

{=======================================================}
{                                                       }
{ ED9FNUM  comprend La fonction Miroir / ED Rotation    }
{ les variables L0 .. L19                               }
{                                                       }
{=======================================================}

{$O+,F+}

Unit ED13FNUM;

Interface

{***define __TYPE_M100__}  {** Si la machine demande de serrer la piece **}

{$IFDEF __Type_M100__}

Const Serrage_Piece:Boolean=False;

{$ENDIF}

Procedure InitGraphique;
Procedure GraPhique_Numeriqe(RepertoireFile1,NomFile1:String);
Function  SuprimeCommentaires(S:String):String;
Function  VerifyLetreIso(SSS:String):Boolean;
Function  Decode_Ligne(Var lig:Integer;Texte:String):Boolean;
Procedure Init_Table(uu:Integer);
Procedure Numerical;
Procedure Metre_un_Veille;

Implementation

Uses crt,Dos,GRAPH,
Crtkey,
Get_Key,
Buffs         , {**}
Buff_Tex      , {**}
NUM_Buff      , {**}
VAR_NUM       , {**}
OPEN_GPH      , {**}
UFormule      , {**}
UTIL7F        , {**}
FONC_GXM      , {**}
RepetG77;       {**}

Const
LetreNotISO:set of Char = [#0..#9,#12,#14..#25,#27..#31,#33..#36,#38,#39,#59,#63,#91..#255];
Type ResolutionPreference = (Lower, Higher);

Var ix      : Integer;
ReserveZ: Integer;
Snnn    : String[3];
Scommand: String[6];
Modale  : Boolean;

Function Decode_Ligne(Var lig:Integer;Texte:String):Boolean;

Label Finis;
Const
Commande1: Array[1..40] Of String[4] = ('G0', 'G00','G1', 'G01','G2', 'G02',
'G3', 'G03','G',  'GXY','GXYZ',
'M2', 'M02','M3', 'M03','M4', 'M04',
'M5', 'M05','M6', 'M06','G51','G59',
'G52','G79','G77','G54','G80','G81','G82',
'G83','G84','G85','G86','G87','G88',
'G89','G45','M100','M101'); {**G90','G91');***}

Var Recherche,tex  :String;
i,u,NN,s,n,Z   :Integer;
cc,a,x,Err     :Integer;
_P,_ER,_Z,Vii  :Real;
StrVar         :String[40];
StrVar1        :String[40];
Valeur         :Real;
NN_ligne       :Longint;
Temporal       :String[20];

Procedure Analise_Commande(xx:Byte);
var Trouve:Boolean;
u:Byte;

begin
i:=xx-1;
While (i>2)  DO
begin
Trouve:=False;u:=1;
While (Not Trouve) And (u<=40) Do
begin
if (Tab128[i]=Commande1[u]) Then
begin
Temporal:=Tab128[i];
Tab128[i]:=Tab128[i-1];
Tab128[i-1]:=Temporal;
trouve:=True;
end;
Inc(u);
end;
Dec(i);
end;
end;

begin
if Ordinateur486 Then begin end;

For i:=1 To 20 DO Tab128[i]:='';
texte:=Uppers(Texte)+' ';
a:=1;x:=0;
cc:=length(texte);
z:=1;
Repeat
tex:=Copy(Texte,a,cc);
s:=pos(' ',tex);
Recherche:=Copy(tex,1,s);
n:=length(Recherche);
Inc(a,n);
if Recherche<>' ' Then
begin
Recherche:=Copy(Recherche,1,n-1);
if length(Recherche)>40 Then
begin
Erreur_Formule(4,0,Tab128[1]);
Decode_Ligne:=False;
Goto Finis;
end
else
begin
if (Modale) And (z=2) And (Pos('G',Texte)=0) Then
begin
if (((Recherche[1]='X') OR (Recherche[1]='Y')) And
((Scommand='G0')  OR (Scommand='G1')  OR
(Scommand='G2')  OR (Scommand='G3')  OR
(Scommand='G00') OR (Scommand='G01') OR
(Scommand='G02') OR (Scommand='G03') OR
(Scommand='G81')  OR (Scommand='G82')  OR
(Scommand='G83')  OR (Scommand='G84')  OR
(Scommand='G85') OR (Scommand='G86') OR
(Scommand='G87') OR (Scommand='G88') OR
(Scommand='G89'))) Then
begin
Tab128[z]:=Scommand;
Inc(z);
Tab128[z]:=Recherche;
end;
end;

if (Recherche='G') Then
begin
Recherche:='G1';
Scommand:='G1';
end;

if (z>1) And ((Recherche='GXY') OR (Recherche='GXYZ')) Then
begin
Scommand:='G1';
Tab128[z]:=Scommand;
Inc(z);
Tab128[z]:='X0';
Inc(z);
Tab128[z]:='Y0';
if Recherche='GXYZ'Then
begin
Inc(z);
Tab128[z]:='Z0';
end;
End
else
tab128[z]:=Recherche;

if (z>1) Then
begin
if (Recherche='G0') OR (Recherche='G00') Then Scommand:='G0'
else
if (Recherche='G1') OR (Recherche='G01') Then Scommand:='G1'
else
if (Recherche='G2') OR (Recherche='G02') Then Scommand:='G2'
else
if (Recherche='G3') OR (Recherche='G03') Then Scommand:='G3'
else
if ((Recherche='M2')  OR (Recherche='M02') OR
(Recherche='M3')  OR (Recherche='M03') OR
(Recherche='M4')  OR (Recherche='M04') OR
(Recherche='M5')  OR (Recherche='M05') OR
(Recherche='M6')  OR (Recherche='M06') OR
(Recherche='G51') OR (Recherche='G79') OR
(Recherche='G77') OR (Recherche='G54') OR
(Recherche='G80') OR (Recherche='G59')) Then Scommand:='G1'
else
if ( (Recherche='G81') OR
(Recherche='G82') OR (Recherche='G83') OR
(Recherche='G84') OR (Recherche='G85') OR
(Recherche='G86') OR (Recherche='G87') OR
(Recherche='G88') OR (Recherche='G89')) Then
Scommand:=Recherche;

end;
end;

if (Tab128[z]='X') OR (Tab128[z]='Y') OR (Tab128[z]='Z') Then
Insert('0',Tab128[z],2);
Inc(z);
end;

Until (a>cc) OR (z=limite);

if z>2 Then Analise_Commande(z);

if ((Tab128[2]='G0') OR (Tab128[2]='G00') OR
(Tab128[2]='G1') OR (Tab128[2]='G01')) And
(POS('Z',Tab128[3])=1) And (Tab128[4]='') Then
begin
Tab128[2]:=Tab128[3];
Tab128[3]:='';
end;

U:=1;
if (Tab128[u]='M2') OR (Tab128[u]='M02') Then
begin
if (Tab128[u]='M02') Then Tab128[u]:='M2';
C^[Lig].CN:=Tab128[u];
if (u=1) And (Lig>1) Then
begin
StrVar:=Copy(C^[Lig-1].CN,2,Length(C^[Lig-1].CN));
{$R-}
Val(StrVar,Valeur,Err);
{$R+}
if (Err=0) Then
begin
Valeur:=Valeur+1;
Str(Round(Valeur),StrVar);
C^[Lig].CN:='N'+StrVar;
end;
end;
FIN_M2:=False;
Inc(Lig);
Decode_Ligne:=False;
Goto Finis;
End
else
if Tab128[u]<>'' Then
begin
if Tab128[1][1]<>'N' Then Erreur_Formule(20,0,Tab128[1])
else
begin
StrVar:=Copy(Tab128[1],2,Length(Tab128[u]));
{$R-}
Val(StrVar,NN_Ligne,Err);
{$R+}
if (Err<>0) OR (NN_Ligne>32767) Then Erreur_Formule(21,0,Tab128[1])
else
if N_Number>=NN_Ligne Then Erreur_Formule(26,0,Tab128[1])
else
N_number:=NN_Ligne;
end;
C^[Lig].CN:=Tab128[1];
Inc(u);
end;

if (Tab128[u]='M2') OR (Tab128[u]='M02') Then
begin
if (Tab128[u]='M02') Then Tab128[u]:='M2';
C^[Lig].CG:=Tab128[u];
FIN_M2:=False;
Inc(Lig);
Decode_Ligne:=False;
Goto Finis;
End
else

if (Tab128[u]='G91') OR (Tab128[u]='G90') Then
begin
if (Tab128[u]='G91') Then C^[Lig].CS:='G91'
else C^[Lig].CS:='G90';
Inc(u);
end;

if (Tab128[U]='M3') OR (Tab128[u]='M03') OR (Tab128[u]='M04') OR
(Tab128[u]='M4') OR (Tab128[u]='M5') OR (Tab128[u]='M05') Then
begin
if (Tab128[u]='M03') Then Tab128[u]:='M3';
if (Tab128[u]='M04') Then Tab128[u]:='M4';
if (Tab128[u]='M05') Then Tab128[u]:='M5';
cc:=2;
While (cc<Limite) And (Tab128[cc]<>'') DO
begin
if (Tab128[cc]='M3') OR (Tab128[cc]='M4') OR (Tab128[cc]='M5') Then
C^[Lig].CG:=Tab128[cc]
else
if Tab128[cc][1]='M' Then C^[Lig].CX:=Tab128[cc]
else
if Tab128[cc][1]='S' Then C^[Lig].CY:=Tab128[cc];
Inc(cc);
end;
end;

if Tab128[U]='G79' Then   {Saut inconditionel/conditionel}
begin
C^[Lig].CG:=Tab128[U];
if Tab128[U+1][1]='N' Then C^[Lig].CX:=Tab128[U+1]
else
if Tab128[U+1][1]<>'' Then
begin
if (Condition(Tab128[U+1]) In[1,0]) Then
begin
C^[Lig].CY:=Tab128[U+1];
C^[Lig].CX:=Tab128[U+2];
End
else
begin
Erreur_Formule(5,Formule_Erreur,Tab128[1]);
Decode_Ligne:=False;
Goto Finis;
end;
end;
end;

if Tab128[U]='G77' Then      {Repete bloc}
begin
C^[Lig].CG:=Tab128[U];
C^[Lig].CX:=Tab128[U+1];
C^[Lig].CY:=Tab128[U+2];
if POS('S',Tab128[U+3])>0 Then
begin
if I>0 Then
if (Not Controle_Formule(Copy(Tab128[U+3],2,Length(Tab128[U+3])),2)) Then
begin
Erreur_Formule(2,Formule_Erreur,Tab128[1]);
Decode_Ligne:=False;
Goto Finis;
End
else
C^[Lig].CR:=Tab128[U+3];
Tab128[U+3]:='';
End
else C^[Lig].CR:='  ';
end;

if Tab128[U]='G51' Then      {Miroir}
begin
C^[Lig].CG:=Tab128[U];
C^[Lig].CX:=Tab128[U+1];
C^[Lig].CY:=Tab128[U+2];
end;

(***==========================================================
*if Tab128[U]='G54' Then   {Validation des decalges}
* begin
*   C^[Lig].CG:=Tab128[U];
*   if Tab128[u+1][1]='X' Then C^[Lig].CX:=Tab128[U+1];
*   if Tab128[u+2][1]='Y' Then C^[Lig].CY:=Tab128[U+2];
*
*   if Tab128[u+1][1]='Y' Then C^[Lig].CY:=Tab128[U+1];
*   if Tab128[u+2][1]='X' Then C^[Lig].CX:=Tab128[U+2];
*
* end;
***=======================================================***)

if (POS('ED',Tab128[U])=1) Then    {**Rotation ED**}
begin
C^[Lig].CED:='ED';
if (POS('L',Tab128[U])>0) Then
begin
if Length(Tab128[u])<=Long_Formule Then
begin
i:=Pos('L',Tab128[U]);
if (i>1) And
(Controle_Formule(Copy(Tab128[u],3,Length(Tab128[U])),i)) Then
begin
New(C^[Lig].LED);
C^[Lig].LED^:=Copy(Tab128[u],3,Length(Tab128[U]));
DElete(Tab128[U],3,Length(Tab128[U]));
Insert('400',Tab128[U],3);
StrVar:=Copy(Tab128[u],3,Length(Tab128[u]));
End
else
begin
Erreur_Formule(1,Formule_Erreur,Tab128[1]);
Decode_Ligne:=False;
Goto Finis;
end;

End
else
begin
Erreur_Formule(6,0,Tab128[1]);
Decode_Ligne:=False;
Goto Finis;
end;
end;
end;

if POS('L',Tab128[U])>0 Then   {**Variables**}
begin
if Length(Tab128[u])<=Long_Formule Then
begin
i:=Pos('L',Tab128[U]);
if i>1 Then
begin
if (Tab128[U][1] In['X','Y','R','I','J']) And
(Controle_Formule(Tab128[U],i)) Then
begin
Case Tab128[U][1] Of
'X': begin
New(C^[Lig].LX);
C^[Lig].LX^:=Copy(Tab128[u],2,Length(Tab128[U]));
end;
'Y': begin
New(C^[Lig].LY);
C^[Lig].LY^:=Copy(Tab128[u],2,Length(Tab128[U]));
end;
'R': begin
New(C^[Lig].LR);
C^[Lig].LR^:=Copy(Tab128[u],2,Length(Tab128[U]));
end;
'I': begin
New(C^[Lig].LI);
C^[Lig].LI^:=Copy(Tab128[u],2,Length(Tab128[U]));
end;
'J': begin
New(C^[Lig].LJ);
C^[Lig].LJ^:=Copy(Tab128[u],2,Length(Tab128[U]));
end;
end;
DElete(Tab128[U],2,Length(Tab128[U]));
Insert('-30000',Tab128[U],2);
End
else
begin
Erreur_Formule(2,Formule_Erreur,Tab128[1]);
Decode_Ligne:=False;
Goto Finis;
end;
End
else
if (i=1) And (Tab128[U][1]='L') Then
begin
if (Controle_Formule(Tab128[U],i))  Then
begin
New(C^[Lig].LA);
C^[Lig].LA^:=Tab128[u];  {**L=formule**}
Tab128[u]:='$-40000';
End
else
begin
Erreur_Formule(1,Formule_Erreur,Tab128[1]);
Decode_Ligne:=False;
Goto Finis;
end;
end;
End
else
begin
Erreur_Formule(6,0,Tab128[1]);
Decode_Ligne:=False;
Goto Finis;
end;
end;

if (Tab128[U]='G80') Then   {**Stop Circle Percage**}
begin
Circle_Percage:=False;
C^[Lig].CG:=Tab128[U];
if Tab128[U+1]<>'' Then C^[Lig].CX:=Tab128[U+1];
if Tab128[U+2]<>'' Then C^[Lig].CY:=Tab128[U+2];
if Tab128[U+3]<>'' Then C^[Lig].CR:=Tab128[U+3];
ModeG81:='';
Z_G81:='';
ERG81:='';
F_G81:='';
End
else
if (Circle_Percage) OR (Tab128[U]='G81') OR (Tab128[U]='G82') OR
(Tab128[U]='G83') OR (Tab128[U]='G84') OR (Tab128[U]='G85') OR
(Tab128[U]='G86') OR (Tab128[U]='G87') OR (Tab128[U]='G88') OR
(Tab128[U]='G89') Then   {Circle Percage}
begin
if (Circle_Percage) AND (Tab128[u]<>'G81')  And (Tab128[U]<>'G81') And
(Tab128[U]<>'G82') And (Tab128[U]<>'G83') And (Tab128[U]<>'G84') And
(Tab128[U]<>'G85') And (Tab128[U]<>'G86') And (Tab128[U]<>'G87') And
(Tab128[U]<>'G88') And (Tab128[U]<>'G89') Then
begin
if ModeG81<>'' Then C^[lig].CG:=ModeG81;
if F_G81<>'' Then C^[lig].CF:=F_G81;
i:=2;
While Tab128[i]<>'' DO Inc(i);
if Tab128[i]='' Then Tab128[i]:=Z_G81;
if Tab128[i+1]='' Then Tab128[i+1]:=ERG81;
End
else
begin
Circle_Percage:=True;
i:=2;

While Tab128[i]<>'' DO
begin
if POS('G8',Tab128[i])>0 Then
begin
C^[Lig].CG:=Tab128[i];
ModeG81:=Tab128[i];
End
else
if POS('ER',Tab128[i])>0 Then
begin
ERG81:=Tab128[i];
End
else
if POS('Z',Tab128[i])>0 Then
begin
Z_G81:=Tab128[i];
End
else
if POS('F',Tab128[i])>0 Then
begin
C^[Lig].CF:=Tab128[i];
F_G81:=Tab128[i];
end;
Inc(i);
end; {while}
end; {end bloc}
End
else
if Tab128[U]='G45' Then  {**controle La commande G45**}
begin
cc:=U+1;_Z:=0.0;_ER:=0.0;_P:=0.0;Err:=0;Vii:=0.0;
While (cc<20) And (Err=0) And (Tab128[cc]<>'') DO
begin
if (Pos('Z',Tab128[cc])>0) Then
begin
StrVar1:=Tab128[cc];
StrVar1:=Copy(StrVar1,2,Length(StrVar1));
{$R-}
Val(StrVar1,_z,Err);   {**valeur de Z**}
{$R+}
End
else
if (Pos('ER',Tab128[cc])>0) Then
begin
StrVar1:=Tab128[cc];
StrVar1:=Copy(StrVar1,3,Length(StrVar1));
{$R-}
Val(StrVar1,_ER,Err);  {**valeur de ER**}
{$R+}
End
else
if (Pos('EP',Tab128[cc])=0) And (Pos('P',Tab128[cc])>0) then
begin
StrVar1:=Tab128[cc];
StrVar1:=Copy(StrVar1,2,Length(StrVar1));
{$R-}
Val(StrVar1,_P,Err);  {**valeur de P**}
{$R+}
if (Err=0) And (_P<=0.0) then Err:=-1;
End
else
if (Pos('EP',Tab128[cc])>0) then
begin
Vii:=0.0;
StrVar1:=Tab128[cc];
StrVar1:=Copy(StrVar1,3,Length(StrVar1));
{$R-}
Val(StrVar1,Vii,Err);  {**valeur de EP**}
{$R+}
if (Err=0) And (Vii<=0.0) then Err:=-1;
End
else
if (Pos('EQ',Tab128[cc])=0) And (Pos('Q',Tab128[cc])>0) then
begin
Vii:=0.0;
StrVar1:=Tab128[cc];
StrVar1:=Copy(StrVar1,2,Length(StrVar1));
{$R-}
Val(StrVar1,Vii,Err);  {**valeur de Q**}
{$R+}
if (Err=0) And (Vii<=0.0) then Err:=-1;
End
else
if (Pos('EQ',Tab128[cc])>0) then
begin
Vii:=0.0;
StrVar1:=Tab128[cc];
StrVar1:=Copy(StrVar1,3,Length(StrVar1));
{$R-}
Val(StrVar1,Vii,Err);  {**valeur de EQ**}
{$R+}
if (Err=0) And (Vii<=0.0) then Err:=-1;
End
else
if (Pos('EB',Tab128[cc])>0) then
begin
Vii:=0.0;
StrVar1:=Tab128[cc];
StrVar1:=Copy(StrVar1,3,Length(StrVar1));
{$R-}
Val(StrVar1,Vii,Err);  {**valeur de EB**}
{$R+}
if (Err=0) And (Vii<=0.0) then Err:=-1;
End
else
if (Pos('EX',Tab128[cc])>0) then
begin
Vii:=0.0;
StrVar1:=Tab128[cc];
StrVar1:=Copy(StrVar1,3,Length(StrVar1));
{$R-}
Val(StrVar1,Vii,Err);  {**valeur de EX**}
{$R+}
if (Err=0) And (Vii<=0.0) then Err:=-1;
End
else
if (Pos('EY',Tab128[cc])>0) then
begin
Vii:=0.0;
StrVar1:=Tab128[cc];
StrVar1:=Copy(StrVar1,3,Length(StrVar1));
{$R-}
Val(StrVar1,Vii,Err);  {**valeur de EY**}
{$R+}
if (Err=0) And (Vii<=0.0) then Err:=-1;
end;
Inc(cc);
end; {**fin de while**}

if (Err=0) Then
begin
{**Erreur si P plus Grand que (Z*-1)+R**}
if ( _P > ((_z * -1)+_ER) ) Then
begin
Erreur_Formule(66,0,Tab128[1]);
Decode_Ligne:=False;
Exit;
Goto Finis;
end;
End
else
begin
Erreur_Formule(3,0,Tab128[1]);
Decode_Ligne:=False;
Exit;
Goto Finis;
end;
end; {**fin de controle du commande G45**}

{$IFDEF __Type_M100__}

if (Tab128[U]='M100') OR (Tab128[U]='M101') Then   {**Serrage Piece**}
begin
C^[Lig].CG:=Tab128[U];
end;

{$ENDIF}

if (Tab128[U]<>'G77') And (Tab128[u]<>''   )  And
(Tab128[u]<>'M3' ) And (Tab128[u]<>'M03' ) And (Tab128[u]<>'M04' ) And
(Tab128[u]<>'M4' ) And (Tab128[u]<>'M5' ) And (Tab128[u]<>'M05') And
(Tab128[U]<>'G79')  And (Tab128[U]<>'G51') And (Tab128[U]<>'M100') And
(Tab128[U]<>'M101') Then
While (U<20) And (Tab128[u]<>'') And (ErreurFile=0) DO
begin
if (Tab128[u]='G1') OR (Tab128[u]='G01') OR (Tab128[u]='G2') OR
(Tab128[u]='G02') OR (Tab128[u]='G3') OR (Tab128[u]='G03') OR
(Tab128[u]='G0') OR (Tab128[u]='G00') OR (Tab128[u]='M6') OR
(Tab128[u]='M06') OR (Tab128[u]='G45') OR (Tab128[u]='G59') OR
(Tab128[u]='G81') OR (Tab128[u]='G')   OR (Tab128[u]='G54')
Then
begin
if (Tab128[u]='G00') OR (Tab128[u]='G') Then Tab128[u]:='G0'
else
if Tab128[u]='G01' Then Tab128[u]:='G1'
else
if Tab128[u]='G02' Then Tab128[u]:='G2'
else
if Tab128[u]='G03' Then Tab128[u]:='G3'
else
if Tab128[u]='M06' Then Tab128[u]:='M6';
if (Tab128[U]='G0') OR (Tab128[u]='G1') OR (Tab128[u]='G59') OR
(Tab128[U]='G54') Then
begin
cc:=2;A:=0;
While (cc<20) And (A<1) And (Tab128[cc]<>'') DO
begin
if (Pos('X',Tab128[cc])>0) OR (Pos('Y',Tab128[cc])>0) Then
Inc(A);
Inc(cc);
end;
if A>0 Then C^[lig].CG:=Tab128[u];
End
else
C^[lig].CG:=Tab128[u];
End
else
if Tab128[u][1]='M' Then C^[Lig].CR:=Tab128[u]
else
if (Tab128[u]='G40') OR (Tab128[u]='G41') OR (Tab128[u]='G42') Then
C^[lig].CX:=Tab128[u]
else
if (Tab128[u]='G90') OR (Tab128[u]='G91')  OR (Tab128[u][1]='S') Then
C^[lig].CS:=Tab128[u]
else
if (Tab128[u][1]='F') Then
C^[lig].CF:=Tab128[u]
{*a1*} else
begin
if (Pos('EB',Tab128[u])>0) OR (Pos('EX',Tab128[u])>0) OR
(Pos('EY',Tab128[u])>0) OR (Pos('ER',Tab128[u])>0) OR
(Pos('EP',Tab128[u])>0) OR (Pos('EQ',Tab128[u])>0) OR
(Pos('ED',Tab128[u])>0)
Then
StrVar:=Copy(Tab128[u],3,Length(Tab128[u]))
else
StrVar:=Copy(Tab128[u],2,Length(Tab128[u]));

if POS('L',Tab128[U])>0 Then   {Variables}
begin
if Length(Tab128[u])<=Long_Formule Then
begin
i:=Pos('L',Tab128[U]);
if (i>1) And (Tab128[U][1] In['X','Y','R','I','J']) And
(Controle_Formule(Copy(Tab128[u],2,Length(Tab128[U])),i)) Then
begin
Case Tab128[U][1] Of
'X': begin
New(C^[Lig].LX);
C^[Lig].LX^:=Copy(Tab128[u],2,Length(Tab128[U]));
end;
'Y': begin
New(C^[Lig].LY);
C^[Lig].LY^:=Copy(Tab128[u],2,Length(Tab128[U]));
end;
'R': begin
New(C^[Lig].LR);
C^[Lig].LR^:=Copy(Tab128[u],2,Length(Tab128[U]));
end;
'I': begin
New(C^[Lig].LI);
C^[Lig].LI^:=Copy(Tab128[u],2,Length(Tab128[U]));
end;
'J': begin
New(C^[Lig].LJ);
C^[Lig].LJ^:=Copy(Tab128[u],2,Length(Tab128[U]));
end;
end;
DElete(Tab128[U],2,Length(Tab128[U]));
Insert('-30000',Tab128[U],2);
StrVar:=Copy(Tab128[u],2,Length(Tab128[u]));
End
else
if (i=1) And (Tab128[U][1]='L') And
(Controle_Formule(Copy(Tab128[u],2,Length(Tab128[U])),i)) Then
begin
New(C^[Lig].LA);
C^[Lig].LA^:=Tab128[u];
Tab128[u]:='$-40000';
StrVar:=Copy(Tab128[u],2,Length(Tab128[u]));
End
else
begin
Erreur_Formule(1,Formule_Erreur,Tab128[1]);
Decode_Ligne:=False;
Goto Finis;
end;
End
else
begin
Erreur_Formule(6,0,Tab128[1]);
Decode_Ligne:=False;
Goto Finis;
end;
end;  {formule}

{$R-}
Val(StrVar,Valeur,Err);
{$R+}

if (Err<>0) OR (Valeur>99999.999) Then
begin
{Efface_Mesaje;}
Erreur_Formule(3,0,Tab128[1]);
Decode_Ligne:=False;
Exit;
End
else
{*a2*}      begin
Case Tab128[u][1] Of
'X': W^[lig].X:=Valeur;
'Y': W^[lig].Y:=Valeur;
'Z': W^[lig].Z:=Valeur;
'R': W^[lig].R:=Valeur;
'I': W^[lig].I:=Valeur;
'J': W^[lig].J:=Valeur;
'D': if Round(Valeur) In[1..Max_Outils] Then W^[lig].D:=Round(Valeur);
'T': if Round(Valeur) In[0..32] Then W^[lig].T:=Round(Valeur);

'E': begin
if Pos('EB',Tab128[u])>0 Then W^[lig].R:=Valeur
else
if Pos('EX',Tab128[u])>0 Then W^[lig].I:=Valeur
else
if Pos('EY',Tab128[u])>0 Then W^[lig].J:=Valeur
else
if Pos('ER',Tab128[u])>0 Then W^[lig].K:=Valeur
else
if Pos('ED',Tab128[u])>0 Then
begin
if (Valeur>=0) And (Valeur<=360) Then
W^[lig].ED:=Round(Valeur);
if C^[Lig].CED<>'ED' Then C^[Lig].CED:='ED';
end;
end;

end; { ** case **}
{*a2*}     end;
Valeur:=0;
{*a1*} end;

Inc(u);
end; {**While**}

if Tab128[1]<>'' Then Inc(Lig);
Decode_Ligne:=True;
Finis:
end;

Function SuprimeCommentaires(S:String):String;
var ch:Char;
i,nc1,Nc2:Integer;
begin
nc1:=0;nc2:=0;
For I:=1 To Length(S) Do
begin
if S[i]='(' Then Inc(nc1);
if S[i]=')' Then Inc(nc2);
end;
if nc1<>nc2 Then
begin
if nc1>nc2 Then ch:=')'
else ch:='(';
SuprimeCommentaires:=Ch;
End
else
begin
Repeat
nc1:=Pos('(',S);
nc2:=Pos(')',S);
if nc2-nc1>39 Then
begin
SuprimeCommentaires:='>40';
ch:='#';
nc1:=0;
End
else
if nc1>0 Then Delete(S,nc1,(nc2-nc1)+1);
Until (nc1=0);
if ch<>'#' Then
begin
I:=Length(S);
While (S[i]=#32) And (i>0) DO Dec(i);
if i>0 Then S:=Copy(S,1,i)
else S:='';
SuprimeCommentaires:=S;
end;
end;
end;

Function VerifyLetreIso(SSS:String):Boolean;
Var i,LongSSS:Integer;
Trouve:Boolean;
begin
LongSSS:=Length(SSS);i:=1;Trouve:=False;
While (i<=LongSSS) And (Not Trouve) DO
begin
if SSS[i] In LetreNotISO Then Trouve:=True
else
Inc(i);
end;
VerifyLetreISO:=Trouve;
end;

Procedure Lire_Index;
Var SC,ST  : String;
Lire   : Boolean;
S      : String;
kk     : Byte;
Err,NNN: Integer;
SN     : String[6];

Compare, Block:Boolean;

begin
Scommand:='G1';
Modale:=TRUE;
ErreurFile:=0;
S:='';Err:=1;
Block:=False;
N_Number:=0;  {**control denumeration de lignes**}
TextRec(Fictex).BufPos:=0;
While (Not Eof(FicTex)) And (Not Block )  Do
begin
{$i-}
Read(Fictex,S);
{$I+}

if (S[1]='%') Then
begin
S:=Copy(S,2,Length(S));
if (Pos('(',S)>0)  OR (Pos(')',S)>0) Then
begin
S:=SuprimeCommentaires(S+' ');
if (S='(') OR (S=')') OR (S='>40') then
begin
Efface_Mesaje;
if S='>40' Then
Mesaje('Error - the commentaire max 40 carct. Stop line: '+
'% prog')
else
Mesaje('Error not "'+S+'" the commentaire.  Line: % prog');
KK:=keyBoard;
Efface_Mesaje;
ErreurFile:=2;
Exit;
end;
end;

if S<>'' Then
begin
if VerifyLetreISO(S) Then
begin
Efface_Mesaje;
Mesaje('Error - not ISO character.  Stop line: % prog');
KK:=keyBoard;
Efface_Mesaje;
ErreurFile:=2;
Exit;
End
end;

{$R-}
Val(S,nnn,Err);
{$R+}

if (Err=0) Then
begin
if (nnn>0) And (nnn<=9999) Then Block:=True
else Err:=2;
{$I-}
ReadLN(FicTex);
{$I+}
end;
end
else
begin
{$I-}
Readln(FicTex);
{$I+}
end;
end;

if Err<>0 Then
begin
ErreurFile:=12;
Efface_Mesaje;
Str(ErreurFile,S);
Mesaje('ERRR -- Number programm not correct: '+S);
KK:=KeyBoard;
Efface_Mesaje;
Exit;
end;

if Block Then
begin
Lire:=True;
Nbr:=1;
While (Not Eof(FicTex)) And (Lire) And (ErreurFile=0) Do
begin
{$I-}
Readln(Fictex,St);
{$I+}
if (Pos('(',ST)>0) OR (Pos(')',ST)>0)  Then
begin
St:=SuprimeCommentaires(ST+' ');
if (ST='(') OR (ST=')') OR (ST='>40') then
begin
if (Nbr>1) And (C^[Nbr-1].CN<>'') Then
Sn:=C^[Nbr-1].CN
else Str(Nbr,Sn);
Efface_Mesaje;
if ST='>40' Then
Mesaje('Error - the commentaire max 40 carct. Stop line: '+Sn)
else
Mesaje('Error not "'+ST+'" the commentaire.  Stop line: '+Sn);
KK:=keyBoard;
Efface_Mesaje;
ErreurFile:=2;
Exit;
end;
end;

if St<>'' Then
begin
if VerifyLetreISO(St) Then
begin
if (Nbr>1) And (C^[Nbr-1].CN<>'') Then
Sn:=C^[Nbr-1].CN
else Str(Nbr,Sn);
Efface_Mesaje;
Mesaje('Error - not ISO character.  Stop line: '+Sn);
KK:=keyBoard;
Efface_Mesaje;
ErreurFile:=2;
Exit;
End
end;

if St<>'' Then
begin
if (Nbr<MaxLig) Then
begin
{*Modale:=TRUE;}
St:=St+' ';
if Not Decode_Ligne(Nbr,ST) Then Exit;
{*Modale:=FALSE;}
End
else
begin
ErreurFile:=7;
Str(MaxLig,SC);
Mesaje('Error: Too much lines [maximum:'+Sc+']');
ChKey:=keyBoard;
Chkey:=27;
Efface_Mesaje;
end;
end;
end; { while }
End
else ErreurFile:=1;
Circle_Percage:=False;
Modale:=FALSE;
end;

Procedure Control(Max:integer);
var i           : Integer;
X_Max,X_Min : Real;
Y_Max,Y_Min : Real;

begin
X_Max:=0;
X_Min:=0;
Y_Max:=0;
Y_Min:=0;
ECHELLE:=1;
Echelle2:=False;
MaxiX:=0;
MaxiY:=0;
MiniX:=0;
MiniY:=0;

for i:=1 To max Do
begin
if W^[i].X>X_Max Then X_Max:=W^[i].X;
if W^[i].Y>Y_Max Then Y_Max:=W^[i].Y;

if (W^[i].X>-30000) And (W^[i].X<X_Min) Then
begin
if (C^[i].CG<>'G59') And (C^[i].CG<>'G54') Then X_Min:=W^[i].X;
end;
if (W^[i].Y>-30000) And (W^[i].Y<Y_Min)  Then
begin
if (C^[i].CG<>'G59') And (C^[i].CG<>'G54') Then Y_Min:=W^[i].Y;
end;
end;

MaxiX:=X_Max;MaxiY:=Y_Max;
MiniX:=X_Min;MiniY:=Y_Min;

if (ABS(X_Min)+X_Max)>MAX_X-60 Then  Echelle2:=True;
if (ABS(Y_Min)+Y_Max)>MAX_Y-60 Then  Echelle2:=True;
if Echelle2 Then
begin
ECHELLE:=(ABS(Y_Min)+Y_Max)/(MAX_Y-60);
if (ABS(X_Min)+X_Max)/(MAX_X-40)>ECHELLE Then
ECHELLE:=(ABS(X_Min)+X_Max)/(MAX_X-60);

For i:=1 To max Do
begin
if W^[i].X>-30000 Then W^[i].X:=W^[i].X / ECHELLE;
if W^[i].Y>-30000 Then W^[i].Y:=W^[i].Y / ECHELLE;
if W^[i].R>-30000 Then W^[i].R:=W^[i].R / ECHELLE;
if W^[i].I>-30000 Then W^[i].I:=W^[i].I / ECHELLE;
if W^[i].J>-30000 Then W^[i].J:=W^[i].J / ECHELLE;
{ if W^[i].K>-30000 Then W^[i].K:=W^[i].K / ECHELLE;}

(***=== anule ==============================================
* if C^[i].CG='G45' Then
*   begin
*      i:=i;
*      if W^[i].I>-30000 Then W^[i].I:=W^[i].I / ECHELLE;
*      if W^[i].J>-30000 Then W^[i].J:=W^[i].J / ECHELLE;
*      if W^[i].K>-30000 Then W^[i].K:=W^[i].K / ECHELLE;
*   end;
****====================================================***)

end;
end;
end;

Procedure Open_Fic(Reperto,Neime:String);
begin
if FileOpen Then
begin
{$i-}
Close(FicTex);
{$i+}
end;

FileOpen:=False;
FillChar(BufTexte^,SizeOf(Buf___Ptr),#32);
Assign(FicTex,Reperto+Neime);
SetTextBuf(FicTex,BufTexte^);
{$I-}
Reset(FicTex);
{$I+}
if Ioresult= 0 Then
begin
Read(Fictex,BufTexte^[1]);
FileOpen:=TRUE;
End
else FileOpen:=False;
end;

Procedure GO_Programme;
Label Pase,Fin_Error;

Var WW,G77_Nbr1,JJ  : integer;
TXX,TYY,TRR     : Real;
N1,N2,S,S2      : String;

begin
if FileOpen Then
begin
Graph.SetColor(14);
Circle(PmX,PmY,4);
line(PmX+2,PmY,Pmx+2,Pmy+2);
line(PmX-2,PmY,Pmx+2,Pmy);
PosX:=0;PosY:=0;
Graph.SetColor(15);
MiroirX:=1;
MiroirY:=1;
ED_Rotation:=False;
Angle_ED:=0;
Reyon_Util:=4;
Init_Variables;
Mode:=True;  {* Par defut Mode est G90 *}
Valeur_de_Z(Haut_Z);
Fin_M2:=False;
JJ:=1;
PosX:=0;PosY:=0;
Chkey:=0;

{$IFDEF __Type_M100__}
Serrage_Piece:=False;
{$ENDIF}

While (jj<=Nbr) And (Not Fin_M2) DO
begin
Affiche_Line(C^[jj].CN,W^[jj].X,W^[jj].Y);
Delay(TempoOK);
{Inc(DeplacementBlocs);}

if C^[jj].CS<>'' Then
begin
if (C^[jj].CS='G90') Then
begin
Mode:=True;
Affiche_Mode;
End
else
if C^[jj].CS='G91' Then
begin
Mode:=False;
Affiche_Mode;
end;
end;

{$IFDEF __Type_M100__}

if C^[jj].CG='M100' Then Serrage_Piece:=True;
if C^[jj].CG='M101' Then Serrage_Piece:=False;

{$ENDIF}

if C^[jj].CG='M6' Then
begin

{$IFDEF __Type_M100__}

if (Not Serrage_Piece) Then
begin
ERREUR_Execution(COTEZ,15,Pos_line,0,0);
Goto Fin_Error;
end;

{$ENDIF}

CoteZ:=Haut_Z;
M6(C^[jj].CN,W^[jj].T,W^[jj].D);
Valeur_de_Z(Haut_Z);
End
else
if (W^[jj].Z>-30000) And (W^[jj].Z<>CoteZ) Then
Valeur_de_Z(Round(W^[jj].Z));

if ((C^[jj].Cx='G41') OR
(C^[jj].Cx='G42') OR
(C^[jj].Cx='G40')) Then Decale(C^[jj].Cx);

if C^[jj].LA <>NIL Then
begin
if Controle_Formule(C^[jj].LA^,1) Then
else ERREUR_Execution(COTEZ,5,Pos_line,Formule_Erreur,0);
if Calcule_Formule(C^[jj].LA^,1) Then
else ERREUR_Execution(COTEZ,6,Pos_line,Formule_Erreur,0);
if (Debugger) And (DebugCode='V') Then
Debuger_Valeur(Debug_Var,C^[JJ].CN);
end;

if C^[jj].LX <>NIL Then
begin
if Controle_Formule(C^[jj].LX^,2) Then
else ERREUR_Execution(COTEZ,5,Pos_line,Formule_Erreur,0);
if Calcule_Formule(C^[jj].LX^,2) Then
else ERREUR_Execution(COTEZ,6,Pos_line,Formule_Erreur,0);
TXX:=Valeur_Variable / ECHELLE;
if (Debugger) And (DebugCode='V') Then
Debuger_Valeur(Debug_Var,C^[JJ].CN);
End
else
TXX:=W^[jj].X;

if C^[jj].LY<>NIL Then
begin
if Controle_Formule(C^[jj].LY^,2) Then
else ERREUR_Execution(COTEZ,5,Pos_line,Formule_Erreur,0);
if Calcule_Formule(C^[jj].LY^,2) Then
else ERREUR_Execution(COTEZ,6,Pos_line,Formule_Erreur,0);
TYY:=Valeur_Variable / ECHELLE;
if (Debugger) And (DebugCode='V') Then
Debuger_Valeur(Debug_Var,C^[JJ].CN);
End
else
TYY:=W^[jj].Y;

TRR:=-30000;

if (C^[jj].LR<>NIL) And ((C^[jj].CG='G2') OR (C^[jj].CG='G3')) Then
begin
if Controle_Formule(C^[jj].LR^,2) Then
else ERREUR_Execution(COTEZ,5,Pos_line,Formule_Erreur,0);
if Calcule_Formule(C^[jj].LR^,2) Then
else ERREUR_Execution(COTEZ,6,Pos_line,Formule_Erreur,0);
TRR:=Valeur_Variable / ECHELLE;
if (Debugger) And (DebugCode='V') Then
Debuger_Valeur(Debug_Var,C^[JJ].CN);
end
else
TRR:=W^[jj].R;

if (TXX<=-30000) Then TXX:=PosX;
if (TYY<=-30000) Then TYY:=PosY;

if (C^[jj].CG<>'G59') And (C^[jj].CG<>'G54')  Then
begin
if (Not Mode) And (W^[jj].X>-30000) Then TXX:=PosX+TXX;
if (Not Mode) And (W^[jj].Y>-30000) Then TYY:=PosY+TYY;
end;

if (C^[jj].CED='ED') Then
begin
if C^[jj].LED<>NIL Then
begin
if Controle_Formule(C^[jj].LED^,2) Then
else ERREUR_Execution(COTEZ,5,Pos_line,Formule_Erreur,0);
if Calcule_Formule(C^[jj].LED^,2) Then
else ERREUR_Execution(COTEZ,6,Pos_line,Formule_Erreur,0);
if (Valeur_Variable>=0) And (Valeur_Variable<=360) Then
begin
if mode Then  Angle_ED:=Valeur_Variable
else
Angle_ED:=Angle_ED+Valeur_Variable;
if (Angle_ED>=0) And (Angle_ED<=360) Then
ED_Rotation:=TRUE
else
begin
if (W^[jj].ED<>0) Then ERREUR_Execution(COTEZ,4,Pos_line,0,0);
ED_Rotation:=False;
ED_Rotation:=False;
Angle_ED:=0;
end;
End
else
ERREUR_Execution(COTEZ,4,Pos_line,0,0);
if (Debugger) And (DebugCode='V') Then
Debuger_Valeur(Debug_Var,C^[JJ].CN);
End   {end -50000}
else
if (W^[jj].ED>=0) And (W^[jj].ED<=360) Then
begin
ED_Rotation:=TRUE;
if mode Then  Angle_ED:=W^[jj].ED
else
Angle_ED:=Angle_ED+W^[jj].ED;
End
else
begin
if (W^[jj].ED<>0) Then ERREUR_Execution(COTEZ,4,Pos_line,0,0);
ED_Rotation:=False;
ED_Rotation:=False;
Angle_ED:=0;
end;
end;

if (Angle_ED>0) And (Angle_ED<=360) Then
begin
if (C^[jj].CG<>'G59') And (C^[jj].CG<>'G54') Then
Rotation_SUR_G3(TXX,TYY,Angle_ED)
else
begin
Angle_ED:=0;
ED_Rotation:=False;
end;
end;

(*******************************************************************
* if C^[jj].CG='G59' Then
* Voir(TXX,TYY,'  '+C^[jj].CN+'  '+C^[jj].CG+' --> Fin Angle');
*******************************************************************)

if ((MiroirX=-1) And (W^[jj].X>-30000)) Then TXX:=(TXX * -1);

if ((MiroirY=-1) And (W^[jj].Y>-30000)) Then TYY:=(TYY * -1);

if C^[jj].CG='G59' Then
begin
PosX:=0;
PosY:=0;
G59(TXX,TYY);
Goto Pase;
End
else
if C^[jj].CG='G0' Then G0(PosX,PosY,TXX,TYY,C^[jj].CX)
else
if C^[jj].CG='G1' Then G1(PosX,PosY,TXX,TYY,C^[jj].CX)
else
if (C^[jj].CG='G2') And (MiroirX=1) And (MiroirY=1) Then
G2(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J)
else
if (C^[jj].CG='G3')  And (MiroirX=1) And (MiroirY=1) Then
begin
G3(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J)
End
else
if (C^[jj].CG='G2') And ((MiroirX=-1) OR (MiroirY=-1)) Then
begin
if (MiroirX=-1) And (MiroirY=-1) Then
G2(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J)
else
G3(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J);
End
else
if (C^[jj].CG='G3')  And ((MiroirX=-1) OR (MiroirY=-1)) Then
begin
if (MiroirX=-1) And (MiroirY=-1) Then
G3(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J)
else
G2(PosX,PosY,TXX,TYY,TRR,W^[jj].I,W^[jj].J);
End
else
if C^[jj].CG='M3' Then
begin
{$IFDEF __Type_M100__}
if (Not Serrage_Piece) Then
begin
ERREUR_Execution(COTEZ,15,Pos_line,0,0);
Goto Fin_Error;
end;
{$ENDIF}
M3(C^[jj].CN,C^[jj].CX,C^[jj].CY)
End
else
if C^[jj].CG='M4' Then
begin

{$IFDEF __Type_M100__}

if (Not Serrage_Piece) Then
ERREUR_Execution(COTEZ,15,Pos_line,0,0);
Goto Fin_Error;

{$ENDIF}

M4(C^[jj].CN,C^[jj].CX,C^[jj].CY);
End
else
if C^[jj].CG='M5' Then M5(C^[jj].CN,C^[jj].CX,C^[jj].CY)
else
if C^[jj].CG='G45' Then
begin
ReserveZ:=CoteZ;
Valeur_de_Z(0);
G0(PosX,PosY,TXX,TYY,'');
Valeur_de_Z(ReserveZ);
G45(Round(TXX),Round(TYY),Round(W^[jj].I),Round(W^[jj].J),Round(W^[jj].R));
Valeur_de_Z(Round(W^[jj].K*ECHELLE));
End
else
if C^[jj].CG='G77' Then
begin
G77_Nbr1:=0;
if Affiche_G77(C^[jj].CN,C^[jj].CX,C^[jj].CY,C^[jj].CR,G77_Nbr1) Then
begin
N1:=C^[jj].CX;
N2:=C^[jj].CY;
if G77_Nbr1>0 Then
begin
if Formule_Erreur=0 Then
begin
ww:=1;
While (ww<=G77_Nbr1) And (ChKey<>27) DO
begin
Repeter_Bloc(N1,N2);
inc(ww);
end;
end;
End
else
Repeter_Bloc(N1,N2);
end;
End
else
if C^[jj].CG='G54' Then G54(TXX,TYY)
else
if ((C^[jj].CG='G81') OR (C^[jj].CG='G82') OR (C^[jj].CG='G83') OR
(C^[jj].CG='G84') OR (C^[jj].CG='G85') OR (C^[jj].CG='G86') OR
(C^[jj].CG='G87') OR (C^[jj].CG='G88') OR (C^[jj].CG='G89'))
Then
begin
ReserveZ:=CoteZ;
Valeur_de_Z(0);
Valeur_de_Z(ReserveZ);
G81(TXX,TYY, W^[jj].K, C^[jj].CG, C^[jj].CF);
End
else
if C^[jj].CG='G80' Then G80
else
if (C^[jj].CN='M2') OR (C^[jj].CG='M2') Then
begin

{$IFDEF __Type_M100__}

if (Serrage_Piece) Then
begin
ERREUR_Execution(COTEZ,16,Pos_line,0,0);
Goto Fin_Error;
end;

{$ENDIF}

Fin_M2:=True;
End
else
if C^[jj].CR[1]='M' Then
begin
if C^[jj].CR='M2' Then
begin

{$IFDEF __Type_M100__}

if (Serrage_Piece) Then
begin
ERREUR_Execution(COTEZ,16,Pos_line,0,0);
Goto Fin_Error;
end;

{$ENDIF}

Fin_M2:=True;
End
else MMM(C^[jj].CN,C^[jj].CR);
End
else
{Miroir}    if C^[jj].CG='G51' Then G51(C^[jj].CN,C^[jj].CX,C^[jj].CY)
else
if C^[jj].CG='G79' Then
begin
G79(jj,C^[jj].CN,C^[jj].CX,C^[jj].CY);
end;

{$IFDEF __Type_M100__}

if (C^[jj].CG='M101') And (Serrage_Piece) Then
begin
Serrage_Piece:=False;
end;

{$ENDIF}

pase:

ChKey:=GetKeyDelay(Opertion_Tempo);

if ChKey in [27,62,68] Then
begin
case ChKey of
27: begin
ChKey:=27;
Fin_M2:=True;
end;
62: if Key_Code Then
begin
Cadriage;
ChKey:=0;
Inc(jj);
end;

68: if Key_Code Then
begin
ERREUR_Execution(CoteZ,14,Pos_Line,0,0);
if ChKey = 27 Then
begin
ChKey:=27;
Fin_M2:=True;
End
else
begin
Chkey:=0;
Inc(jj);
end;
end;
end;
End                 {****if Type_Key <> 0****}
else Inc(jj);

if Not ChKey in [27,62,68] Then chKey:=0;

end; {** while - for **}

Fin_Error:

if (ChKey = 27) Then
begin
if jj>1 Then N1:=C^[jj].CN
else N1:='0';
ERREUR_Execution(COTEZ,13,N1,0,0);
End
else
if ((CoteZ<0) AND (CoteZ>-30000)) OR (BROCHE) Then
begin
if Nbr>1 Then N1:=C^[Nbr-1].CN
else N1:='0';
ERREUR_Execution(COTEZ,1,N1,0,0);
end;

Mode:=True;

SetTextJustify(CenterText, TopText);
SetTextStyle(0,0,1);

OutTextXY(MAX_X div 2, MAX_Y-15, 'End Programm');
Beep;

ChKey:=KeyBoard;
ChKey:=0;
SetTextJustify(0,0);
SetTextStyle(0, HorizDir, 0);

end;
end;

{$I NC_NUM3.PAS}  (*** ficier a inclure***)

Function File_Premier(Rep,Nom:String):Boolean;
Var File_OK:Boolean;
begin
File_OK:=False;
Init_Table(1);
Neime:=Nom;
Init_Table(1);
if (Nom<>'') Then Open_Fic(Rep,Nom);

if FileOpen Then
begin
DG41:=False;
DG42:=False;
DG40:=False;
PosX:=0.0;
PosY:=0.0;
Choix:=6;
Nom:=Neime;
File_OK:=True;
End
else
begin
DG41:=False;
DG42:=False;
DG40:=False;
PosX:=0.0;
PosY:=0.0;
Choix:=1;
Nom:='';
Neime:='';
Nom:='';
File_OK:=False;
end;
File_Premier:=File_OK;
end;

Procedure GraPhique_Numeriqe(RepertoireFile1,NomFile1:String);
begin
BotonX:=1;
Choix:=1;
End_Programm_Num:=False;
ErreurFile:=0;
Nbr:=0;
MiroirX:=1;
MiroirY:=1;
Circle_Percage:=False;
Z_G81:='';
ERG81:='';
ECHELLE:=1;
BROCHE:=False;
Chkey:=0;
MiniX:=0;
MiniY:=0;
MaxiX:=0;
MaxiY:=0;
DG41:=False;
DG42:=False;
DG40:=True;

{** Opertion_Tempo et Tempo son initialises sur Ednum.pas **}
{** Tempo:=50; **}
{** Opertion_Tempo:=8000;**}
{**TempoOK:=10; **}

Marke_Outil:=False;
Mode:=True;
Neime:='';
Nom:='';
PosX:=0.0;
PosY:=0.0;
Outil_Courant:='T0 > D0';
FileOpen:=False;

ED_Rotation:=False;
Angle_ED:=0;
if NomFile1<>'' then
begin
if File_Premier(RepertoireFile1,NomFile1) Then MENUXX(True)
else
MENUXX(False);
End
else MENUXX(False);
end;

Procedure Init_Table_Ouverture;
Var i:Byte;
begin
For ix:=1 To MaxLig DO
begin
W^[ix].X:=-30000;
W^[ix].Y:=-30000;
W^[ix].Z:=-30000;
W^[ix].R:=-30000;
W^[ix].I:=-30000;;
W^[ix].J:=-30000;;
W^[ix].K:=-30000;;
W^[ix].D:=255;
W^[ix].ED:=400;
W^[ix].T:=255;

C^[ix].CN:='';
C^[ix].CG:='';
C^[ix].CX:='';
C^[ix].CY:='';
C^[ix].CR:='';
C^[ix].CED:='';
C^[ix].CF:='';
C^[ix].CS:='';
C^[ix].LA:=NIL;
C^[ix].LX:=NIL;
C^[ix].LY:=NIL;
C^[ix].LR:=NIL;
C^[ix].LI:=NIL;
C^[ix].LJ:=NIL;
C^[ix].LED:=NIL;
end;
Init_Variables;
CoteZ:=-30000;
For i:=1 To NumBars DO TabB[i]:=0;
end;

Procedure Numerical;
Var u,i,XX,YY,PPMY:integer;
PPMX:Integer;
ColorTT:Byte;
begin
PPMY:=GetMaxY+120;
PPMX:=50;
ColorTT:=15;
{SetBox(15,4,66,8,3,15,7);}
SetBox(10,4,71,9,3,15,7);
SetBox(4,12,79,27,8,15,7);
SetColor(12);
SetTextStyle(2,0,4);
Outtextxy(500,460,'programming: A.ARA');
SetTextStyle(1,0,1);
SetTextJustify(0, TopText);
SetColor(4);
SetTextStyle(0,0,3);
Outtextxy(120,68,'NUMERICAL CONTROL');
Outtextxy(130,105,'      2001');

SetTextStyle(0,0,0);
SetViewPort(0,0,GetMAXX,GetMAXy,clipON);
SetColor(Colortt);

SetFillStyle(1,3);

Bar(PPMX+311,PPMY-308,PPMX+327,PPMY-388);
Bar(PPMX+327,PPMY-374,PPMX+352,PPMY-328);
Bar(PPMX+327,PPMY-328,PPMX+401,PPMY-315);
Rectangle(PPMX+311,PPMY-308,PPMX+327,PPMY-388);

Line(PPMX+206,PPMY-357,PPMX+311,PPMY-357);
Line(PPMX+327,PPMY-374,PPMX+352,PPMY-374);

Line(PPMX+352,PPMY-374,PPMX+352,PPMY-328);

Line(PPMX+352,PPMY-357,PPMX+486,PPMY-357);
Line(PPMX+486,PPMY-347,PPMX+373,PPMY-347);

Line(PPMX+486,PPMY-339,PPMX+396,PPMY-339);

Line(PPMX+327,PPMY-328,PPMX+401,PPMY-328);
Line(PPMX+401,PPMY-315,PPMX+327,PPMY-315);

Line(PPMX+401,PPMY-315,PPMX+401,PPMY-328);

Line(PPMX+206,PPMY-315,PPMX+311,PPMY-315);
Line(PPMX+206,PPMY-344,PPMX+293,PPMY-344);

Line(PPMX+486,PPMY-323,PPMX+401,PPMY-323);

SetColor(Colortt);
Line(PPMX+242,PPMY-297,PPMX+437,PPMY-297);

Line(PPMX+178,PPMY-265,PPMX+243,PPMY-297);
Line(PPMX+374,PPMY-265,PPMX+437,PPMY-296);
Line(PPMX+374,PPMY-258,PPMX+437,PPMY-290);

Line(PPMX+178,PPMY-265,PPMX+374,PPMY-265);
Line(PPMX+374,PPMY-258,PPMX+178,PPMY-258);

Line(PPMX+374,PPMY-248,PPMX+178,PPMY-248);
Line(PPMX+374,PPMY-238,PPMX+178,PPMY-238);
Line(PPMX+374,PPMY-228,PPMX+178,PPMY-228);
Line(PPMX+374,PPMY-248,PPMX+438,PPMY-280);
Line(PPMX+374,PPMY-238,PPMX+438,PPMY-270);
Line(PPMX+374,PPMY-228,PPMX+438,PPMY-260);

SetColor(14);
Line(PPMX+319,PPMY-295,PPMX+325,PPMY-308);
Line(PPMX+319,PPMY-295,PPMX+313,PPMY-308);
Line(PPMX+319,PPMY-308,PPMX+319,PPMY-295);

Line(PPMX+321,PPMY-308,PPMX+319,PPMY-295);
Line(PPMX+323,PPMY-308,PPMX+319,PPMY-295);
SetColor(3);
u:=2;
For i:=1 to 4 DO
begin
Line(PPMX+374,PPMY-258+u,PPMX+178,PPMY-258+u);
Line(PPMX+374,PPMY-258+u,PPMX+438,PPMY-290+u);
Inc(u,10);
end;

SetColor(ColorTT);
Bar(PPMX+486,PPMY-200,PPMX+521,PPMY-381);
Line(PPMX+486,PPMY-381,PPMX+506,PPMY-391);
Line(PPMX+521,PPMY-381,PPMX+541,PPMY-391);
Line(PPMX+506,PPMY-391,PPMX+541,PPMY-391);
Line(PPMX+541,PPMY-391,PPMX+541,PPMY-210);

Rectangle(PPMX+486,PPMY-200,PPMX+521,PPMY-381);
SetColor(8);
Rectangle(PPMX+493,PPMY-376,PPMX+516,PPMY-207);
SetColor(ColorTT);
Rectangle(PPMX+491,PPMY-376,PPMX+516,PPMY-205);

PPMY:=GetMaxY-30;
PPMX:=28;
u:=0;
For i:=0 To 10 Do
begin
Circle(PPMX+357+u,PPMY-163,2);
Inc(u,6);
end;

XX:=PPMX;
YY:=PPMY;
Dec(PPMX,45);
DEC(PPMY,15);
{ORDINA}
SetColor(11);
REctangle(PPMX+69,PPMY-171,PPMX+176,PPMY-192);

Line(PPMX+176,PPMY-192,PPMX+202,PPMY-201);
Line(PPMX+202,PPMY-184,PPMX+176,PPMY-171);
Line(PPMX+202,PPMY-201,PPMX+202,PPMY-184);
Line(PPMX+202,PPMY-201,PPMX+181,PPMY-201);

SetColor(4);
SetFillStyle(1,7);

Bar(PPMX+102,PPMY-200,PPMX+160,PPMY-237);
REctangle(PPMX+102,PPMY-200,PPMX+160,PPMY-237);
SetFillStyle(1,3);
SetColor(11);
REctangle(PPMX+100,PPMY-199,PPMX+160,PPMY-237);
REctangle(PPMX+97,PPMY-195,PPMX+165,PPMY-242);

Line(PPMX+116,PPMY-245,PPMX+181,PPMY-245);
Line(PPMX+181,PPMY-200,PPMX+181,PPMY-245);
Line(PPMX+97,PPMY-242,PPMX+116,PPMY-245);
Line(PPMX+165,PPMY-242,PPMX+181,PPMY-245);
Line(PPMX+165,PPMY-195,PPMX+181,PPMY-200);
Line(PPMX+69,PPMY-192,PPMX+97,PPMY-199);

REctangle(PPMX+76,PPMY-177,PPMX+112,PPMY-180);
REctangle(PPMX+76,PPMY-184,PPMX+112,PPMY-188);

REctangle(PPMX+55,PPMY-150,PPMX+135,PPMY-152);

Line(PPMX+80,PPMY-168,PPMX+163,PPMY-168);

Line(PPMX+55,PPMY-152,PPMX+80,PPMY-168);
Line(PPMX+135,PPMY-152,PPMX+163,PPMY-168);
{***}
Line(PPMX+135,PPMY-150,PPMX+163,PPMY-166);
u:=0;

For i:=0 To 9 Do
begin
Line(PPMX+140+u,PPMY-188,PPMX+140+u,PPMY-176);
Inc(u,3);
end;
SetColor(1);
u:=0;
For i:=0 To 5 Do
begin
Circle(PPMX+107+u,PPMY-230,1);
Circle(PPMX+107+u,PPMY-225,1);
Circle(PPMX+107+u,PPMY-220,1);
Circle(PPMX+107+u,PPMY-215,1);
Circle(PPMX+107+u,PPMY-210,1);
Circle(PPMX+107+u,PPMY-205,1);
Inc(u,4);
end;
SetColor(11);
u:=0;
For i:=0 To 10 Do
begin
Circle(PPMX+85+u,PPMY-164,1);
Circle(PPMX+78+u,PPMY-160,1);
Circle(PPMX+71+u,PPMY-156,1);
Inc(u,6);
end;
SetColor(15);
Inc(PPMX,30);
Inc(PPMY,35);

SetBox(7,21,21,26,3,15,7);
SetFillStyle(1,7);
Bar(PPMX+45,PPMY-140,PPMX+88,PPMY-110);
SetFillStyle(1,3);
SetColor(14);
Outtextxy(180,210,#27);
Line(185,213,195,213);
Outtextxy(180,350,#27);
Line(195,214,195,353);
Outtextxy(220,280,#26);
Line(185,353,195,353);
Line(195,283,220,283);

SetColor(15);
Rectangle(PPMX+43,PPMY-142,PPMX+90,PPMY-108);
Rectangle(PPMX+45,PPMY-140,PPMX+88,PPMY-110);
u:=0;
For i:=0 To 7 Do
begin
Circle(PPMX+45+u,PPMY-98,2);
Circle(PPMX+45+u,PPMY-88,2);
Circle(PPMX+45+u,PPMY-78,2);
Circle(PPMX+45+u,PPMY-68,2);
Inc(u,6);
end;
u:=0;
For i:=0 To 6 Do
begin
Circle(PPMX+107+u,PPMY-130,2);
Circle(PPMX+107+u,PPMY-120,2);
Circle(PPMX+107+u,PPMY-100,2);

Circle(PPMX+107+u,PPMY-80,2);
Circle(PPMX+107+u,PPMY-70,2);
Inc(u,6);
end;

end; {numerical}

PROCEDURE InitGraphique;
begin
Initialise_Graphique;
Debugger:=False;
N_Number:=0;
FIN_M2:=True;
ED_Rotation:=False;
Angle_ED:=0;
Reyon_Util:=4;
ZX:=0; ZY:=0; ZZ0:=0;
C:=Nil;
W:=Nil;
GetMem(BufTexte,SizeOf(Buf___Ptr));
New(W);
New(C);
Init_Table_Ouverture;
if (BufTexte<>Nil) And (W<>Nil) And (C<>Nil)  Then
begin
Size_Menu_Buf:=ImageSize(1,1,30,30);
GetMeM(Menu_Buf,Size_Menu_Buf);
SetLineStyle(0,0,0);
Numerical;
ix:=KeyBoard;
{ix:=GetKeyDelay(32000);}
REstoreCRTMODE;
End
else
begin
Writeln('Error: Pas asez de Memoire vive.');
Writeln('Liberer la memoire ou retirer les programmes résidents.');
Writeln('Pressez une touche');
ch:=Readkey;
Halt(1);
end;
end; { De Procââ‚¬&#353;dure Init}

Procedure Metre_un_Veille;
Const
Seed   = 1958; { Valeur semence du générateur aléatoire }
NumPts = 2100; { Quantité de pixels à traiter           }
PPP    = 4;
Var
III,XXX, YYY, Color : WORD;
XXMax, YYMax  : INTEGER;
_ViewInfo     : ViewPortType;
ColorPoint    : Integer;
Max__Color    : WORD;

begin
Randomize;                { Init générateur de nombres aléatoire     }
Max__Color := Graph.GetMaxColor;  { Récup + grand numéro de couleur de tracé }
GetViewSettings(_ViewInfo);
WITH _ViewInfo DO
begin
XXMax := (x2-x1-1);
YYMax := (y2-y1-1);
end;

WHILE NOT KeyPressed DO
begin
{** Pose pixels alââ‚¬&#353;atoires **}
RandSeed := Seed;
III := 0;
WHILE (NOT KeyPressed) AND (III < NumPts) DO
begin
Color:=Random(Max__Color)+1;
if  Color>0 Then
begin
Inc(III);
Graph.PutPixel(Random(XXMax), Random(YYMax), Color);
end;
end;

{** Efface pixels **}

RandSeed := Seed;
III := 0;
WHILE (NOT KeyPressed) DO
begin
XXX     := Random(XXMax)+1;
YYY     := Random(YYMax)+1;
Color := Random(Max__Color)+1;
ColorPoint := Graph.GetPixel(XXX, YYY);

if  (Graph.GetPixel(XXX, YYY)<>0) And (Color>0) And
(Color<>ColorPoint) Then
begin
if (iii=0) And (XXX-PPP>0) And (XXX-PPP<XXMax) And (YYY-PPP>0) And
(YYY-PPP<YYMax) Then
begin
Graph.PutPixel(XXX, YYY, 0);
Graph.PutPixel(XXX-PPP, YYY-PPP, Color);
iii:=1;
End
else
if (iii=1) And (XXX+PPP>0) And (XXX+PPP<XXMax) And (YYY+PPP>0) And
(YYY+PPP<YYMax) Then
begin
Graph.PutPixel(XXX, YYY, 0);
Graph.PutPixel(XXX+PPP, YYY+PPP, Color);
iii:=0;
end;
end;
end;
end;
end;    {** Metre_un_Veille **}

End.

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

Le dictionnaire

Démo des fonctions :

1. Traduction Français / Anglais

2. Traduction Anglais / Français

3. Traduction et suggestions Français / Anglais

4. Traduction et suggestions Anglais /Français

Les fichiers :

- Box13.tpu : pour les parties d'affichage.

- Var2.tpu : déclarations de variables.

- Buff1.tpu : déclaration de buffers.

- Get_Key1.tpu : entrées au clavier et définition de touches normales et Ctrl, Alt et touches F1 à F10.

- Traduc1.tpu : Unité de traduction définie avec des parties Directive IFDEF à compiler ou non compiler.

Exemple de directive $IFDEF - $ELSE - $ENDIF pour le mode de compilation :

{** $define __COPYDAF__  **}
{** $define __INCONNUS__ **}
{** $define __ERREUR__   **}

Exemple partie de conditions simple :

{$ifdef __COPYDAF__}
Partie à compile si le nom à été déclare.
{$endif}

Ou partie de conditions avec $else :

{$ifdef __COPYDAF__}
Partie à compiler si le nom a été déclare.
{$else}
Sinon compiler cette partie.
{$endif}

Les fichiers Demo_Dic.pas et .EXE doivent se trouver dans le répertoire du logiciel EDNUM.exe, où il y à le répertoire EDNUM\ contenant les fichiers du dictionnaire nécessaires : 1FraAng2.Idx - 2AngFra1.idx - FranAngl.dic.
Sur Traduc1.pas : les parties nom compilées font d'autres fonctions sur EDNUM, leur explication dans un avenir proche, si notre monde ou notre planète continue à tourner au tour du Soleil.

Le fichier compressé DemoTraduc.zip contient déjà le répertoire nécessaire EDNUM\ avec les fichiers du dictionnaire pour le fonctionnement de la Démo : 1FraAng2.Idx - 2AngFra1.idx - FranAngl.dic. Les seules fonctions et procédures manquantes pour qu'il fonctionne avec TPW sont :

Function CrtSize (x1, y1, x2, y2 : byte ) : Word;
Procedure ReadBuf (x1, y1, x2, y2 : byte; Var buf );
Procedure WriteBuf (x1, y1, x2, y2 : byte; Var buf );
Procedure Rectangle (x1, y1, x2, y2 : byte; Var Cadre : CadreChars );
Procedure HighBox (x1, y1, x2, y2, Colori : byte );
Procedure BoxColor (x1, y1, x2, y2, Colori : byte );
Procedure BoxFill (x1, y1, x2, y2 : byte; Ch : char );
Function ReadBox (x, y : byte; Var SS : string; Longeur, MaxCh : byte ) : boolean;

Téléchargement :

Fichier Demo_Dic.zip