Précédente Accueil Remonter Suivante

MENU PRINCIPAL

Visual Basic for MS-DOS

 

 

DECLARE SUB importlect (gg$, gg2$, rt$, VarEnreg AS ANY, nf%, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%, cyanclair%, rougeclair%, jaune%, blancbrill%, couleur%)
DECLARE SUB fleches3 (r%, np%, w$(), flag%, gg$, gg2$, blancbrill%, blanc%, noir%, bleu%, couleur%)
DECLARE SUB lecdir (cla$(), ncl%, dire$, s$)
DECLARE SUB entree_echap (rr%)
DECLARE SUB attendre (tx!)
DECLARE SUB cadre (v%, h%, l%, nli%, c%)
DECLARE SUB centre (v%, coul%, ph$)
DECLARE SUB entree (rr%)
DECLARE SUB fleches (v%, h%, w$(), np%, r%, drap%, v2%, h2%)
DECLARE SUB getinvimouse (rr%)
DECLARE SUB inputline (r$, nl%)
DECLARE SUB motpasse (f%)
DECLARE SUB titre (w$)
DECLARE SUB titrenb (w$)
DECLARE SUB tri (nf%, n$(), r%())
DECLARE SUB saisienom (r$, nl%, n$(), r%(), n%, nbmaxi%)
DECLARE SUB bilans (nbmaxi%, niveauxfrancais1%(), niveauxfrancais2%(), niveauxmath1%(), niveauxmath2%(), niveauxlecture%(), niveauxgeometrie%(), francais1$(), francais2$(), math1$(), math2$(), geometrie$(), lecture$(), VarEnreg AS ANY)
DECLARE SUB bilanmath2 (r%(), eleve%, VarEnreg AS ANY, niveauxmath2%(), math2$())
DECLARE SUB convertir (z$)
DECLARE SUB Bilanlecture (r%(), matiere%, eleve%, VarEnreg AS ANY, niveauxlecture%(), lecture$())
DECLARE SUB calmoy (t$(), moy$(), niveaux%())
DECLARE SUB bilanfrancais2 (r%(), eleve%, VarEnreg AS ANY, niveauxfrancais2%(), francais2$())
DECLARE SUB bilanfrancais1 (r%(), eleve%, VarEnreg AS ANY, niveauxfrancais1%(), francais1$())
DECLARE SUB bilanmath1 (r%(), eleve%, VarEnreg AS ANY, niveauxmath1%(), math1$())
DECLARE SUB bilangeometrie (r%(), eleve%, VarEnreg AS ANY, niveauxgeometrie%(), geometrie$())
DECLARE SUB pleineligne (z$, r$, np%, v%, h%)
DECLARE SUB nomprenom (n$, pr$, nom$, prenom$, flagnom%)
DECLARE SUB transferttextes ()
DECLARE SUB aproposde (rt$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%, cyanclair%, rougeclair%, jaune%, blancbrill%)
DECLARE SUB cadrebilan1 (v%, h%, debut%, fin%, blancbrill%, rouge%)
DECLARE SUB cadrebilan2 (v%, h%, debut%, fin%, blancbrill%, rouge%)
DECLARE SUB testespace (z$)
DECLARE SUB testtiret (z$)
'MENU AAS sans droits
'Clerc Daniel 20/10/2010
'version 2.0 souris

DEFINT A-Z

'200 élèves maxi ===

'faire attention au numéro élève en mémoire et numéro élève dans fichier (+1) ===
'quand saisie nom alors eleve est choisi sinon avec fleches3, c'est r%() ===

COMMON SHARED programme$, es$, gg$, gg2$, fichier$, rt$, noir, bleu, vert, rouge, marron, blanc, vertclair, cyanclair, rougeclair, jaune, blancbrill, couleur


' Inclut les fichiers contenant les déclarations relatives aux procédures appelées.
'$INCLUDE: 'MOUSE.BI'
'$INCLUDE: 'VBDOS.BI'

CONST FALSE = 0
CONST TRUE = NOT FALSE

SCREEN 9
SCREEN 0


' Vérifie que le gestionnaire de souris est installé.
MouseInit
MouseShow


TYPE TypeEnreg
nom AS STRING * 20
prenom AS STRING * 20
nbexo AS STRING * 21
Divers AS STRING * 50
notes AS STRING * 3000
END TYPE
DIM VarEnreg AS TypeEnreg

programme$ = "menu" '===

nbmaxi = 200 'nbmaxi = nombre élèves maxi ===

DIM n$(nbmaxi, 2), r%(nbmaxi), re$(16), pp$(9), p2$(3), m$(nbmaxi), nbexo$(nbmaxi), t$(nbmaxi), p$(4)
DIM math1$(21), math2$(21), francais1$(21), francais2$(21), lecture$(11), geometrie$(21)
DIM niveauxmath1(21), niveauxmath2(21), niveauxfrancais1(21), niveauxfrancais2(21), niveauxgeometrie(21), niveauxlecture(11)

DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
'POKE &H417, (PEEK(&H417) OR &H40) 'MAJ
DEF SEG

couleur = 1
noir = 0: bleu = 1: vert = 2: rouge = 4: marron = 6: blanc = 7: vertclair = 10: cyanclair = 11: rougeclair = 12: jaune = 14: blancbrill = 15

ON ERROR GOTO erreurfichier1
OPEN "pointeur.dat" FOR INPUT AS #1
INPUT #1, eleve, sens, couleur, texte, lecture$
CLOSE

DATA Activités,Bilans,Utilitaires,Quitter
FOR i = 1 TO 4: READ p$(i): NEXT

DATA Continuer sans préciser le nom,Ajouter un nom,Modifier un nom,Effacer un nom,Remettre le fichier à zéro,Importer/Exporter élèves/textes,Gestion des textes,A propos de...,Fin
FOR i = 1 TO 9: READ pp$(i): NEXT

rt$ = CHR$(17) + CHR$(196) + CHR$(217)
gg$ = CHR$(24) + " " + CHR$(25) + " puis " + rt$
gg2$ = CHR$(24) + " " + CHR$(25) + " " + CHR$(27) + " " + CHR$(26) + " puis " + rt$
es$ = "[Echap]=Fin"

moi$ = "": moi2$ = ""
'CLERC
DATA 67,82,69,76,35
'daniel
DATA 76,69,73,78,65,36
FOR i = 1 TO 5: READ n: moi$ = CHR$(n + 32) + moi$: NEXT
FOR i = 1 TO 6: READ n: moi2$ = CHR$(n + 32) + moi2$: NEXT

GOSUB init 'data

ON ERROR GOTO erreurfichier2
GOSUB lecture

ON ERROR GOTO erreur

CALL tri(nf, n$(), r%())

SCREEN 0: WIDTH 80: KEY OFF: LOCATE , , 0

'programme principal
debut:
LOCATE , , 0, 8, 8: COLOR blanc, bleu, 0: CLS

CALL cadre(5, 20, 40, 9, 15)
COLOR , 15
FOR ku = 7 TO 11
LOCATE ku, 25: PRINT SPACE$(32)
NEXT

h = 23
c = 0 'bleu 'blancbrill
CALL centre(8, c, "A T E L I E R S")
CALL centre(10, c, "A I D E et S O U T I E N")

COLOR blanc, bleu
c = noir
'LOCATE 16, 10: PRINT "clerc"
'CALL centre(14, c,

CALL cadre(15, 20, 15, 6, blanc)
COLOR noir, blanc
LOCATE 16, 23: PRINT "MATH"
LOCATE , 23: PRINT "FRANCAIS"
LOCATE , 23: PRINT "LECTURE"
LOCATE , 23: PRINT "GEOMETRIE"
COLOR blanc, bleu
CALL centre(14, 3, moi2$ + " " + UCASE$(moi$))

LOCATE 21, 48: PRINT gg$
DO
CALL fleches(16, 48, p$(), 4, ch, 1, 20, 48)
LOOP WHILE ch = 0

SELECT CASE ch
CASE 1
IF nf = 0 THEN GOSUB ajouter: COLOR , bleu: CLS : RUN
GOTO suite
CASE 2
IF nf = 0 THEN GOSUB fichiervide
CALL bilans(nbmaxi, niveauxfrancais1(), niveauxfrancais2(), niveauxmath1(), niveauxmath2(), niveauxlecture(), niveauxgeometrie(), francais1$(), francais2$(), math1$(), math2$(), geometrie$(), lecture$(), VarEnreg)
CASE 3
GOSUB utilitaires
CASE 4
COLOR blancbrill, noir: CLS : END
END SELECT
GOTO debut

suite:
CALL titre("saisie du nom")
CALL cadre(9, 42, 24, 3, vert)
COLOR blancbrill, vert
LOCATE 10, 44: PRINT "Tape ton NOM"
COLOR , noir
CALL centre(23, blanc, CHR$(24) + " " + CHR$(25))
LOCATE 23, 3: PRINT "["; : COLOR jaune: PRINT "Echap"; : COLOR blancbrill: PRINT "] = Fin"
LOCATE 23, 62: PRINT "["; : COLOR jaune: PRINT "*"; : COLOR blancbrill: PRINT "] = Utilitaires"

CALL saisienom(n$, 20, n$(), r%(), nf, nbmaxi)
SELECT CASE ASC(n$)

CASE 27
COLOR , bleu: CLS : RUN
CASE 42
GOSUB utilitaires
GOTO debut
END SELECT

'comparer nom avec ceux qui existent

FOR i = 1 TO nf
IF n$ = n$(i, 1) THEN
eleve = i
CALL titre("confirmation de la saisie")
CALL cadre(5, 20, 40, 5, blanc)
COLOR , blanc
CALL centre(7, noir, n$(eleve, 2) + " " + n$(eleve, 1))
CALL cadre(11, 20, 40, 3, vert)
COLOR , vert
CALL centre(12, blancbrill, "Est-ce bien ton prénom et ton nom ?")

p2$(1) = "oui"
p2$(2) = "non"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(16, 38, p2$(), 2, r, 1, 23, 35)

SELECT CASE r
CASE 0
COLOR , bleu: CLS : RUN
CASE 1
f = 1
EXIT FOR
END SELECT
END IF
NEXT i

IF f = 0 THEN
FOR i = 1 TO nf
IF n$ = UCASE$(n$(i, 2)) THEN
COLOR , noir
BEEP
CALL centre(23, rougeclair, "Tu as tapé un prénom !")
CALL getinvimouse(w)
GOTO suite
END IF
NEXT
GOSUB utilitaires
GOTO debut
END IF

GOTO quit
END

utilitaires: '++++++++++++++++++++++++++++++++++++++++++++++++++++
CALL titre("Utilitaires")
IF n$ <> "*" AND n$ <> "" THEN
BEEP: CALL centre(5, rougeclair, n$ + " n'est pas inscrit dans le fichier.")
END IF
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(8, (80 / 2) - 14, pp$(), 9, choix, 1, 23, 35)
COLOR , noir

SELECT CASE choix

CASE 0, 9
COLOR , bleu: CLS : RUN

CASE 1
eleve = 0: GOTO quit

CASE 2
CALL motpasse(f): IF f = 0 THEN CLS : GOTO utilitaires
GOSUB ajouter

CASE 3
IF nf = 0 THEN GOSUB fichiervide
CALL motpasse(f): IF f = 0 THEN CLS : GOTO utilitaires
GOSUB modifier
COLOR , bleu: CLS : RUN

CASE 4
IF nf = 0 THEN GOSUB fichiervide
CALL motpasse(f): IF f = 0 THEN CLS : GOTO utilitaires
GOSUB effacer
COLOR , bleu: CLS : RUN

CASE 5
IF nf = 0 THEN GOSUB fichiervide
CALL motpasse(f): IF f = 0 THEN CLS : GOTO utilitaires
GOSUB fichierazero
COLOR , bleu: CLS : RUN

CASE 6
IF nf = 0 THEN GOSUB fichiervide
CALL motpasse(f): IF f = 0 THEN COLOR , noir: CLS : GOTO utilitaires
CALL titre("importer - exporter")
p2$(1) = "Importer/Exporter des élèves"
p2$(2) = "Importer/Exporter les textes"
p2$(3) = "Fin"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(11, 28, p2$(), 3, reponse, 1, 23, 35)
IF reponse = 0 OR reponse = 3 THEN COLOR , bleu: CLS : RUN

SELECT CASE reponse
CASE 1
CALL importlect(gg$, gg2$, rt$, VarEnreg, nbmaxi, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%, cyanclair%, rougeclair%, jaune%, blancbrill%, couleur)
CASE 2
CALL transferttextes
END SELECT
COLOR , bleu: CLS : RUN

CASE 7
CALL motpasse(f): IF f = 0 THEN COLOR , noir: CLS : GOTO utilitaires
CALL titre("gestion des textes")
p2$(1) = "Textes niveau I"
p2$(2) = "Textes niveau II"
p2$(3) = "Fin"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(11, 34, p2$(), 3, reponse, 1, 23, 35)
IF reponse = 0 OR reponse = 3 THEN COLOR , bleu: CLS : RUN
IF reponse = 1 THEN lecture$ = "fichier1.txt" ELSE lecture$ = "fichier2.txt"

OPEN "pointeur.dat" FOR OUTPUT AS #1
WRITE #1, eleve, 1, 1, texte, lecture$
CLOSE
COLOR , noir: CLS : RUN "gestion"

CASE 8
CALL aproposde(rt$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%, cyanclair%, rougeclair%, jaune%, blancbrill%)
END SELECT

GOTO utilitaires

ajouter: '++++++++++++++++++++++++++++++++++++++++++++++++++++
CALL titre("Introduire")
LOCATE 23, 66: COLOR blanc, noir: PRINT es$: COLOR , bleu
CALL cadre(4, 20, 40, 3, marron)
COLOR , marron
IF nf = 0 THEN
CALL centre(5, blancbrill, "Le fichier est vide")
ELSE
w$ = " nom": IF nf > 1 THEN w$ = w$ + "s"
CALL centre(5, blancbrill, LTRIM$(STR$(nf)) + w$ + " dans le fichier")
END IF
CALL cadre(7, 20, 40, 12, blanc)
nf = nf + 1
IF nf > nbmaxi THEN
BEEP
CALL centre(23, rougeclair, "le fichier est limité à " + RTRIM$(LTRIM$(STR$(nbmaxi))) + " élèves.")
w$ = INPUT$(1): COLOR , bleu: CLS : RUN
END IF

CALL nomprenom(n$, pr$, n$(eleve, 1), n$(eleve, 2), 1)
nbtemp = nf - 1: GOSUB tester: IF flag = 2 THEN nf = nf - 1: GOTO ajouter
n$(nf, 1) = n$: n$(nf, 2) = pr$

GOSUB ecriturenouvel
CALL titre("introduire")

p2$(1) = "Introduire un autre nom"
p2$(2) = "Fin"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(11, 28, p2$(), 2, r, 1, 23, 35)
IF r = 0 OR r = 2 THEN COLOR , bleu: CLS : RUN
GOTO ajouter

ecriturenouvel:
'Ecriture nouvel élève
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
'nf
GET #1, 1, VarEnreg
nf = VAL(VarEnreg.nom) + 1
VarEnreg.nom = RTRIM$(STR$(nf))
PUT #1, 1, VarEnreg

VarEnreg.nom = n$
VarEnreg.prenom = pr$
VarEnreg.nbexo = "000000000000000000000" '3x7
VarEnreg.Divers = ""
VarEnreg.notes = ""
PUT #1, nf + 1, VarEnreg
CLOSE
RETURN


fichierazero: '++++++++++++++++++++++++++++++++++++++++++++++++++++
CALL titre("remise a zero du fichier")
p2$(1) = "Effacer les noms et les notes"
p2$(2) = "Effacer seulement les notes"
p2$(3) = "Fin"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(11, 25, p2$(), 3, r, 1, 23, 35)
IF r = 0 OR r = 3 THEN COLOR , bleu: CLS : RUN

CALL titre("remise a zero du fichier")
BEEP
CALL cadre(5, 20, 40, 5, blanc)
COLOR , blanc
CALL centre(7, noir, p2$(r))
CALL cadre(11, 20, 40, 3, marron)
COLOR , marron
CALL centre(12, blancbrill, "Vous confirmez ?")

p2$(1) = "oui"
p2$(2) = "non"
COLOR blanc, noir
CALL centre(23, blanc, gg$)
CALL fleches(16, 38, p2$(), 2, r2, 1, 23, 35)

SELECT CASE r2
CASE 0, 2
COLOR , bleu: CLS : RUN
END SELECT

SELECT CASE r
CASE 1
COLOR , bleu: CLS
RANDOMIZE TIMER
z$ = LTRIM$(STR$(INT(RND * 1000)))
CLOSE : NAME "fichier.dat" AS "fichier." + z$
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
nf = 0
VarEnreg.nom = LTRIM$(STR$(nf))
PUT #1, 1, VarEnreg
CLOSE

GOSUB ajouter
COLOR , bleu: CLS : RUN

CASE 2
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
'nf
GET #1, 1, VarEnreg
nf = VAL(VarEnreg.nom)

FOR i = 2 TO nf + 1
VarEnreg.nom = n$(i - 1, 1)
VarEnreg.prenom = n$(i - 1, 2)
VarEnreg.nbexo = "000000000000000000000" '3x7
VarEnreg.Divers = ""
VarEnreg.notes = ""
PUT #1, i, VarEnreg
NEXT
COLOR , bleu: CLS : RUN

END SELECT

lecture:
'lecture fichier
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, 1, VarEnreg
nf = VAL(VarEnreg.nom)

FOR i = 1 TO nf
GET #1, i + 1, VarEnreg
n$(i, 1) = RTRIM$(VarEnreg.nom)
n$(i, 2) = RTRIM$(VarEnreg.prenom)
r%(i) = i
NEXT
CLOSE
RETURN

quit:
OPEN "pointeur.dat" FOR OUTPUT AS #1
IF eleve <> 0 THEN
eleve = eleve + 1
END IF
WRITE #1, eleve, 1, 1, texte, lecture$
CLOSE
COLOR blancbrill, noir: CLS : RUN "menuexo"

effacer: '++++++++++++++++++++++++++++++++++++++++++++++++++++
CALL titre("EFFACER un nom")
f = 0

GOSUB lecture
IF nf = 0 THEN GOSUB fichiervide
CALL tri(nf, n$(), r%())
eleve = 0

IF nf < 40 THEN
IF nf < 14 THEN
FOR i = 1 TO nf: m$(i) = n$(r%(i), 1) + " " + n$(r%(i), 2): NEXT
ELSEIF nf > 13 AND nf < 27 THEN
FOR i = 1 TO nf: m$(i) = n$(r%(i), 1) + " " + LEFT$(n$(r%(i), 2), 3) + ".": NEXT
ELSE
FOR i = 1 TO nf: m$(i) = n$(r%(i), 1) + " " + LEFT$(n$(r%(i), 2), 1): NEXT
END IF
LOCATE 23, 66: COLOR blanc, noir: PRINT es$: COLOR blancbrill
CALL fleches3(r, nf, m$(), 1, gg$, gg2$, blancbrill, blanc, noir, rouge, couleur)
COLOR , noir
IF r = 0 THEN RETURN
eleve = r%(r)
CALL titre("effacer un eleve")
CALL cadre(5, 20, 40, 5, blanc)
COLOR , blanc
CALL centre(7, noir, n$(eleve, 2) + " " + n$(eleve, 1))
CALL cadre(11, 20, 40, 3, marron)
COLOR , marron
CALL centre(12, blancbrill, "Voulez-vous effacer ce nom ?")

p2$(1) = "oui"
p2$(2) = "non"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(16, 38, p2$(), 2, r, 1, 23, 35)

SELECT CASE r
CASE 0
COLOR , bleu: CLS : RUN
CASE 1
f = 1
CASE 2
f = 0
END SELECT

ELSE
CALL cadre(9, 42, 24, 3, vert)
COLOR blancbrill, vert
LOCATE 10, 44: PRINT "Tapez le NOM à effacer"
COLOR , noir
CALL centre(23, blanc, CHR$(24) + " " + CHR$(25))
LOCATE 23, 3: PRINT "["; : COLOR jaune: PRINT "Echap"; : COLOR blancbrill: PRINT "] = Fin"
CALL saisienom(n$, 20, n$(), r%(), nf, nbmaxi)
IF ASC(n$) = 27 THEN COLOR , bleu: CLS : RUN

FOR i = 1 TO nf
IF n$ = n$(i, 1) THEN
eleve = i
CALL titre("effacer un eleve")
CALL cadre(5, 20, 40, 5, blanc)
COLOR , blanc
CALL centre(7, noir, n$(eleve, 2) + " " + n$(eleve, 1))
COLOR , bleu
CALL centre(12, jaune, "Voulez-vous effacer ce nom ?")

p2$(1) = "oui"
p2$(2) = "non"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(16, 38, p2$(), 2, r, 1, 23, 35)

SELECT CASE r
CASE 0
COLOR , bleu: CLS : RUN
CASE 1
f = 1
EXIT FOR
CASE 2
f = 0
END SELECT
END IF
NEXT i
END IF

IF eleve = 0 THEN
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
BEEP
CALL centre(23, rougeclair, "Nom absent du fichier")
CALL getinvimouse(w)
f = 0
END IF
IF f = 0 THEN GOTO effacer

'PRINT eleve, nf: END'===

OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)

IF eleve <> nf THEN
FOR i = eleve TO nf
GET #1, i + 2, VarEnreg
PUT #1, i + 1, VarEnreg
NEXT
END IF

'mise à jour nf
GET #1, 1, VarEnreg
nf = VAL(VarEnreg.nom) - 1
VarEnreg.nom = RTRIM$(STR$(nf))
PUT #1, 1, VarEnreg

CLOSE

'un autre ?
CALL titre("effacer")
p2$(1) = "Effacer un autre nom"
p2$(2) = "Fin"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(11, 30, p2$(), 2, r, 1, 23, 35)
IF r = 0 OR r = 2 THEN COLOR , bleu: CLS : RUN

GOTO effacer
RETURN

modifier: '++++++++++++++++++++++++++++++++++++++++++++++++++++
CALL titre("MODIFIER")

GOSUB lecture
CALL tri(nf, n$(), r%())
eleve = 0
IF nf < 40 THEN
IF nf < 14 THEN
FOR i = 1 TO nf: m$(i) = n$(r%(i), 1) + " " + n$(r%(i), 2): NEXT
ELSEIF nf > 13 AND nf < 27 THEN
FOR i = 1 TO nf: m$(i) = n$(r%(i), 1) + " " + LEFT$(n$(r%(i), 2), 3) + ".": NEXT
ELSE
FOR i = 1 TO nf: m$(i) = n$(r%(i), 1) + " " + LEFT$(n$(r%(i), 2), 1): NEXT
END IF
LOCATE 23, 66: COLOR blanc, noir: PRINT es$: COLOR blancbrill
CALL fleches3(r, nf, m$(), 1, gg$, gg2$, blancbrill, blanc, noir, rouge, couleur)
COLOR , noir
IF r = 0 THEN COLOR , bleu: CLS : RUN
eleve = r%(r): f = 1
ELSE
CALL cadre(9, 42, 24, 3, vert)
COLOR blancbrill, vert
LOCATE 10, 44: PRINT "Tapez le NOM à modifier"
COLOR , noir
CALL centre(23, blanc, CHR$(24) + " " + CHR$(25))
LOCATE 23, 3: PRINT "["; : COLOR jaune: PRINT "Echap"; : COLOR blancbrill: PRINT "] = Fin"
CALL saisienom(n$, 20, n$(), r%(), nf, nbmaxi)
IF ASC(n$) = 27 THEN COLOR , bleu: CLS : RUN
FOR i = 1 TO nf
IF n$ = n$(i, 1) THEN
eleve = i
CALL titre("modifier un eleve")
CALL cadre(5, 20, 40, 5, blanc)
COLOR , blanc
CALL centre(7, noir, n$(eleve, 2) + " " + n$(eleve, 1))
COLOR , bleu
CALL centre(12, jaune, "Voulez-vous modifier ce nom ?")

p2$(1) = "oui"
p2$(2) = "non"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(16, 38, p2$(), 2, r, 1, 23, 35)

SELECT CASE r
CASE 0
COLOR , bleu: CLS : RUN
CASE 1
f = 1
EXIT FOR
CASE 2
f = 0
END SELECT
END IF
NEXT i

END IF

IF eleve = 0 THEN
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
BEEP
CALL centre(23, rougeclair, "Nom absent du fichier")
CALL getinvimouse(w)
f = 0
END IF

IF f = 0 THEN GOTO modifier

CALL titre("MODIFIER")
CALL cadre(6, 20, 40, 12, blanc)

CALL nomprenom(n$, pr$, n$(eleve, 1), n$(eleve, 2), 2)
IF n$ = n$(eleve, 1) AND pr$ = n$(eleve, 2) THEN
'rien
ELSE
nbtemp = nf: GOSUB tester: IF flag = 2 THEN GOTO modifier
END IF

OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
n$(eleve, 1) = n$: n$(eleve, 2) = pr$
GET #1, eleve + 1, VarEnreg
VarEnreg.nom = n$(eleve, 1): VarEnreg.prenom = n$(eleve, 2)
'VarEnreg.NbExo inchangé VarEnreg.notes inchangé
PUT #1, eleve + 1, VarEnreg
CLOSE
'un autre ?
CALL titre("modifier")

p2$(1) = "Modifier un autre nom"
p2$(2) = "Fin"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(11, 30, p2$(), 2, r, 1, 23, 35)
IF r = 0 OR r = 2 THEN COLOR , bleu: CLS : RUN

GOTO modifier

RETURN

tester:
'tester si le nom et le prénom existent déjà n$ et pr$
flag = 0
FOR i = 1 TO nbtemp
IF n$(i, 1) = n$ AND n$(i, 2) = pr$ THEN flag = 2: EXIT FOR
NEXT
IF flag = 2 THEN
BEEP
COLOR , noir
CALL centre(23, rougeclair, "Le nom et le prénom existent déjà")
w$ = INPUT$(1)
END IF
RETURN

fichiervide:
COLOR , bleu: CLS
BEEP
CALL cadre(10, 20, 40, 5, rouge)
COLOR , rouge
CALL centre(12, blancbrill, "Le fichier est vide")
CALL getinvimouse(w)
COLOR , bleu: CLS
RUN

init:
'data francais niveau I
DATA Alphabet,1
DATA Orthographe,4
DATA Recolle le mot,3
DATA Devine le mot,3
DATA Trie les mots,2
DATA Mémorise les mots,3
DATA Cherche le mot,4
DATA Trouve l'intrus,2
DATA Copie un texte,4
DATA Sépare les mots,4
'
DATA Fabrique la phrase,2
DATA Phrase transformée,2
DATA Classe des mots,2
DATA Groupe des noms,2
DATA Féminin des noms,3
DATA Pluriel des noms,2
DATA Trouve le verbe,2
DATA Infinitif des verbes,2
DATA Passé Présent Futur,2
DATA Trouve le temps,2
DATA Conjugaison,4
'
FOR i = 1 TO 21: READ francais1$(i), niveauxfrancais1(i): NEXT

'data francais niveau 2

DATA Phrase éclatée,3
DATA Orthographe des mots,2
DATA Mot éclaté,4
DATA Tri des mots,2
DATA Nature des mots,3
DATA Homonymes,2
DATA Genre et nombre,2
DATA Ponctuation,3
DATA Accord du nom,4
DATA Accord de l'adjectif,4
DATA Participe passé,2
DATA Accord part. passé,4
DATA Fonctions,2
DATA Infinitif,3
DATA Radical des verbes,2
DATA Groupe des verbes,2
DATA Temps des verbes,2
DATA Accord des verbes,2
DATA Temps simples,4
DATA Temps composés,4
DATA Intrus,3

FOR i = 1 TO 21: READ francais2$(i): READ niveauxfrancais2(i): NEXT

'data geometrie
DATA Droite-Gauche,3
DATA Verticale-Horizont,2
DATA Reconnaissance,3
DATA Figures simples,1
DATA Triangles,1
DATA Quadrilatères,1
DATA Vocabulaire,2
DATA Parallèle-Perpend,2
DATA Convexe-Concave,1
DATA Coordonnées,3

DATA Reproduction,4
DATA Frises,4
DATA Agrandir-Réduire,2
DATA Symétrie,4
DATA Périmètre-Aire,1
DATA Solides,2
DATA Nom des angles,1
DATA Valeur des angles,2
DATA Heures-Minutes,4
DATA Orthographe,3
DATA Intrus,2

FOR i = 1 TO 21: READ geometrie$(i), niveauxgeometrie(i): NEXT

'data pour lecture niv 1 & 2
DATA Recopier,1
DATA Ecrire,1
DATA Séparer,1
DATA Recoller,1
DATA Deviner,1
DATA Compter,1
DATA Chercher,1
DATA Repérer,1
DATA Trouver,1
DATA Reconstituer,1
DATA Ponctuer,1

FOR i = 1 TO 11: READ lecture$(i), niveauxlecture(i): NEXT

'data pour math niv 1
DATA Décomposition,2
DATA Tables d'additions,4
DATA Tableau d'additions,4
DATA Additions,4
DATA Orthographe,2
DATA Valeur des chiffres,2
DATA Nombres en chiffres,3
DATA Nombres en lettres,3
DATA Nombres rangés,3
DATA Suite des nombres,2
DATA Avant - Après,3

DATA Tables de multi.,4
DATA Multiplications,4
DATA Soustractions,4
DATA Double des nombres,3
DATA Moitié des nombres,3
DATA Compter,4
DATA Heure et minutes,2
DATA Reproduction,3
DATA Frises,2
DATA Coordonnées,3

FOR i = 1 TO 21: READ math1$(i), niveauxmath1(i): NEXT

'data pour math niveau II
DATA Valeur des chiffres,2
DATA Tri des nombres,3
DATA Orthographe,2
DATA Nombres en lettres,3
DATA Nombres en chiffres,3
DATA Règle graduée,2
DATA Encadrement,2
DATA Chiffres romains,3
'calcul
DATA Additions,3
DATA Soustractions,3
DATA Tables de multi.,4
DATA Tableau de multi.,2
DATA Multiplications,4
DATA Divisions,4
DATA Calcul mental,3
DATA "Dix-cent-mille",4
DATA Moitié d'un nombre,3
DATA Nombre à trouver,4
DATA Fractions,2
DATA Mémorise,2
'problèmes
DATA Problèmes,3

FOR i = 1 TO 21: READ math2$(i), niveauxmath2(i): NEXT
RETURN

erreur:
programme$ = "menu"
SCREEN 0
COLOR , bleu: CLS
BEEP
CALL cadre(8, 5, 70, 9, rouge)
COLOR , rouge
CALL centre(10, blanc, "ATTENTION")

SELECT CASE ERR

CASE 71
CALL centre(12, blancbrill, "Disque non prêt")

CASE 70
CALL centre(12, blancbrill, "Disquette protégée")

CASE 53, 57, 72
CALL centre(12, blancbrill, "Problème sur le disque")

CASE 61
CALL centre(12, blancbrill, "Disque plein")

CASE 25, 26, 68
CALL centre(12, blancbrill, "Imprimante non prête")

CASE 27
CALL centre(12, blancbrill, "Imprimante sans papier")

CASE ELSE
CALL centre(12, blancbrill, "Erreur système n°" + LTRIM$(STR$(ERR)))
CALL centre(14, blancbrill, "Essayez de relancez le programme.")
CLOSE
w$ = INPUT$(1)
COLOR , noir: CLS
END

END SELECT

CALL centre(14, blancbrill, "Corrigez puis tapez " + rt$ + " [Echap] = Fin")
CALL getinvimouse(r)
IF r = 27 THEN COLOR , noir: CLS : END
COLOR , bleu: CLS : RUN programme$


erreurfichier1:
IF ERR = 53 THEN
CLOSE
OPEN "pointeur.dat" FOR OUTPUT AS #1
WRITE #1, 1, 1, 1, 1, "fichier1.txt"
CLOSE
RUN
END IF

GOTO erreur

erreurfichier2:
IF ERR = 53 THEN
'création du fichier manquant
CLOSE
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
nf = 0
VarEnreg.nom = RTRIM$(STR$(nf))
PUT #1, 1, VarEnreg

VarEnreg.nom = ""
VarEnreg.prenom = ""
VarEnreg.nbexo = "000000000000000000000" '3x7
VarEnreg.Divers = ""
VarEnreg.notes = ""
PUT #1, 2, VarEnreg
CLOSE
RUN
END IF

GOTO erreur

DEFINT A-Z
SUB attendre (tx!)

tx! = tx! * 2
debut! = TIMER
DO
fin! = TIMER
LOOP WHILE fin! - debut! < tx!

END SUB

DEFINT A-Z
SUB bilanfrancais1 (r%(), eleve, VarEnreg AS TypeEnreg, niveauxfrancais1(), francais1$())
ma = 21
DIM t$(100), moy$(ma)

ll$ = STRING$(30, ".")
pt$ = MID$(ll$, 1, 15)
ni$ = "Niveau " + CHR$(26) + " 1 2 3 4"

CALL titre("bilan francais niveau I")

'lecture des notes
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, r%(eleve) + 1, VarEnreg
nom$ = RTRIM$(VarEnreg.nom)
pre$ = RTRIM$(VarEnreg.prenom)
'francais niv 1 est en 1°
nbexo$ = LTRIM$(MID$(VarEnreg.nbexo, 1, 3))
resultat$ = MID$(VarEnreg.notes, 1, 400)
CLOSE
j = 1
FOR i = 1 TO 200 STEP 2
t$(j) = MID$(resultat$, i, 2)
j = j + 1
NEXT

CALL calmoy(t$(), moy$(), niveauxfrancais1())

'moy générale
tt = 0: nt = 0
FOR j = 1 TO ma
IF moy$(j) <> "" THEN tt = tt + VAL(moy$(j)): nt = nt + 1
NEXT j
IF nt = 0 THEN moygen$ = " " ELSE moygen$ = LTRIM$(STR$(INT((tt / nt) * 10) / 10))

z$ = pre$ + " " + nom$ + " a fait" + STR$(VAL(nbexo$)) + " exercice"
IF VAL(nbexo$) > 1 THEN z$ = z$ + "s"
z$ = z$ + " de français (niveau I)"
COLOR , marron
CALL centre(4, blancbrill, " " + z$ + " ")
COLOR , bleu
LOCATE 6, 16: COLOR vertclair: PRINT ni$: COLOR jaune: LOCATE 6, 36: PRINT "Moy"
COLOR vertclair: LOCATE 6, 57: PRINT ni$: COLOR jaune: LOCATE 6, 77: PRINT "Moy"

CALL cadrebilan2(7, 1, 8, 18, blancbrill, rouge)
CALL cadrebilan2(7, 42, 8, 17, blancbrill, rouge)
LOCATE 8
FOR i = 1 TO 11
LOCATE , 2: PRINT francais1$(i); " "; LEFT$(ll$, 20 - LEN(francais1$(i)))
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 43: PRINT francais1$(i); " "; LEFT$(ll$, 20 - LEN(francais1$(i)))
NEXT

'affichage des moyennes
LOCATE 8
FOR i = 1 TO 11
LOCATE , 36
IF moy$(i) = "" THEN
PRINT
ELSEIF VAL(moy$(i)) = 9 OR VAL(moy$(i)) = 10 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vertclair
LOCATE , 38
PRINT "A"
ELSEIF VAL(moy$(i)) = 7 OR VAL(moy$(i)) = 8 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vert
LOCATE , 38
PRINT "B"
ELSEIF VAL(moy$(i)) = 6 OR VAL(moy$(i)) = 5 THEN
COLOR blancbrill
PRINT moy$(i);
LOCATE , 38
COLOR jaune
PRINT "C"
ELSE
COLOR blancbrill
PRINT moy$(i);
COLOR rougeclair
LOCATE , 38
PRINT "D"
END IF
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 77
IF moy$(i) = "" THEN
PRINT
ELSEIF VAL(moy$(i)) = 9 OR VAL(moy$(i)) = 10 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vertclair
LOCATE , 79
PRINT "A"
ELSEIF VAL(moy$(i)) = 7 OR VAL(moy$(i)) = 8 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vert
LOCATE , 79
PRINT "B"
ELSEIF VAL(moy$(i)) = 5 OR VAL(moy$(i)) = 6 THEN
COLOR blancbrill
PRINT moy$(i);
LOCATE , 79
COLOR jaune
PRINT "C"
ELSE
COLOR blancbrill
PRINT moy$(i);
COLOR rougeclair
LOCATE , 79
PRINT "D"
END IF
NEXT
COLOR blanc


'++++++++++++++
v = 8
debut = 1
FOR valeur = 1 TO 11
fin = debut + (niveauxfrancais1(valeur) - 1)
h = 24: GOSUB placefrce
debut = fin + 1: v = v + 1
NEXT

v = 8
FOR valeur = 12 TO ma
fin = debut + (niveauxfrancais1(valeur) - 1)
h = 65: GOSUB placefrce
debut = fin + 1: v = v + 1
NEXT
'++++++++++

IF VAL(moygen$) <> 0 THEN
COLOR cyanclair, bleu: LOCATE 19, 43
CALL convertir(moygen$)
PRINT "Moyenne générale : "; moygen$; " sur 10"
END IF

EXIT SUB

placefrce:
LOCATE v
FOR i = debut TO fin
LOCATE , h
IF VAL(t$(i)) < 10 THEN PRINT " ";
IF t$(i) <> " " THEN PRINT LTRIM$(t$(i)); ELSE PRINT "-";
h = h + 3
NEXT
RETURN

END SUB

DEFINT A-Z
SUB bilanfrancais2 (r%(), eleve, VarEnreg AS TypeEnreg, niveauxfrancais2(), francais2$())
ma = 21
DIM t$(100), moy$(ma)
ll$ = STRING$(30, ".")
pt$ = MID$(ll$, 1, 15)
ni$ = "Niveau " + CHR$(26) + " 1 2 3 4"

CALL titre("bilan francais niveau II")

'lecture des notes
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, r%(eleve) + 1, VarEnreg
nom$ = RTRIM$(VarEnreg.nom)
pre$ = RTRIM$(VarEnreg.prenom)
'francais est en 2°
nbexo$ = LTRIM$(MID$(VarEnreg.nbexo, 4, 3))
resultat$ = MID$(VarEnreg.notes, 401, 400)
CLOSE
j = 1
FOR i = 1 TO 200 STEP 2
t$(j) = MID$(resultat$, i, 2)
j = j + 1
NEXT

CALL calmoy(t$(), moy$(), niveauxfrancais2())

'moy générale
tt = 0: nt = 0
FOR j = 1 TO ma
IF moy$(j) <> "" THEN tt = tt + VAL(moy$(j)): nt = nt + 1
NEXT j
IF nt = 0 THEN moygen$ = " " ELSE moygen$ = LTRIM$(STR$(INT((tt / nt) * 10) / 10))

z$ = pre$ + " " + nom$ + " a fait" + STR$(VAL(nbexo$)) + " exercice"
IF VAL(nbexo$) > 1 THEN z$ = z$ + "s"
z$ = z$ + " de français (niveau II)"
COLOR , marron
CALL centre(4, blancbrill, " " + z$ + " ")
COLOR , bleu

LOCATE 6, 16: COLOR vertclair: PRINT ni$: COLOR jaune: LOCATE 6, 36: PRINT "Moy"
COLOR vertclair: LOCATE 6, 57: PRINT ni$: COLOR jaune: LOCATE 6, 77: PRINT "Moy"

CALL cadrebilan2(7, 1, 8, 18, blancbrill, rouge)
CALL cadrebilan2(7, 42, 8, 17, blancbrill, rouge)
LOCATE 8
FOR i = 1 TO 11
LOCATE , 2: PRINT francais2$(i); " "; LEFT$(ll$, 20 - LEN(francais2$(i)))
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 43: PRINT francais2$(i); " "; LEFT$(ll$, 20 - LEN(francais2$(i)))
NEXT

'affichage des moyennes
LOCATE 8
FOR i = 1 TO 11
LOCATE , 36
IF moy$(i) = "" THEN
PRINT
ELSEIF VAL(moy$(i)) = 9 OR VAL(moy$(i)) = 10 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vertclair
LOCATE , 38
PRINT "A"
ELSEIF VAL(moy$(i)) = 7 OR VAL(moy$(i)) = 8 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vert
LOCATE , 38
PRINT "B"
ELSEIF VAL(moy$(i)) = 6 OR VAL(moy$(i)) = 5 THEN
COLOR blancbrill
PRINT moy$(i);
LOCATE , 38
COLOR jaune
PRINT "C"
ELSE
COLOR blancbrill
PRINT moy$(i);
COLOR rougeclair
LOCATE , 38
PRINT "D"
END IF
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 77
IF moy$(i) = "" THEN
PRINT
ELSEIF VAL(moy$(i)) = 9 OR VAL(moy$(i)) = 10 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vertclair
LOCATE , 79
PRINT "A"
ELSEIF VAL(moy$(i)) = 7 OR VAL(moy$(i)) = 8 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vert
LOCATE , 79
PRINT "B"
ELSEIF VAL(moy$(i)) = 5 OR VAL(moy$(i)) = 6 THEN
COLOR blancbrill
PRINT moy$(i);
LOCATE , 79
COLOR jaune
PRINT "C"
ELSE
COLOR blancbrill
PRINT moy$(i);
COLOR rougeclair
LOCATE , 79
PRINT "D"
END IF
NEXT
COLOR blanc


'++++++++++++++
v = 8
debut = 1
FOR valeur = 1 TO 11
fin = debut + (niveauxfrancais2(valeur) - 1)
h = 24: GOSUB placefr
debut = fin + 1: v = v + 1
NEXT

v = 8
FOR valeur = 12 TO ma
fin = debut + (niveauxfrancais2(valeur) - 1)
h = 65: GOSUB placefr
debut = fin + 1: v = v + 1
NEXT
'++++++++++

IF VAL(moygen$) <> 0 THEN
COLOR cyanclair, bleu: LOCATE 19, 43
CALL convertir(moygen$)
PRINT "Moyenne générale : "; moygen$; " sur 10"
END IF
EXIT SUB


placefr:
LOCATE v
FOR i = debut TO fin
LOCATE , h
IF VAL(t$(i)) < 10 THEN PRINT " ";
IF t$(i) <> " " THEN PRINT LTRIM$(t$(i)); ELSE PRINT "-";
h = h + 3
NEXT
RETURN

END SUB

DEFINT A-Z
SUB bilangeometrie (r%(), eleve, VarEnreg AS TypeEnreg, niveauxgeometrie(), geometrie$())
ma = 21
DIM t$(100), moy$(ma)

ll$ = STRING$(30, ".")
pt$ = MID$(ll$, 1, 15)
ni$ = "Niveau " + CHR$(26) + " 1 2 3 4"

CALL titre("bilan geometrie - mesures")

'lecture des notes
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, r%(eleve) + 1, VarEnreg
nom$ = RTRIM$(VarEnreg.nom)
pre$ = RTRIM$(VarEnreg.prenom)
'géométrie en 5°
nbexo$ = LTRIM$(MID$(VarEnreg.nbexo, 13, 3))
resultat$ = MID$(VarEnreg.notes, 1601, 400)
j = 1
FOR i = 1 TO 200 STEP 2
t$(j) = MID$(resultat$, i, 2)
j = j + 1
NEXT
CLOSE
CALL calmoy(t$(), moy$(), niveauxgeometrie())

'moy générale
tt = 0: nt = 0
FOR j = 1 TO ma
IF moy$(j) <> "" THEN tt = tt + VAL(moy$(j)): nt = nt + 1
NEXT j
IF nt = 0 THEN moygen$ = " " ELSE moygen$ = LTRIM$(STR$(INT((tt / nt) * 10) / 10))

z$ = pre$ + " " + nom$ + " a fait" + STR$(VAL(nbexo$)) + " exercice"
IF VAL(nbexo$) > 1 THEN z$ = z$ + "s"
z$ = z$ + " de géométrie - mesures"
COLOR , marron
CALL centre(4, blancbrill, " " + z$ + " ")
COLOR , bleu

LOCATE 6, 16: COLOR vertclair: PRINT ni$: COLOR jaune: LOCATE 6, 36: PRINT "Moy"
COLOR vertclair: LOCATE 6, 57: PRINT ni$: COLOR jaune: LOCATE 6, 77: PRINT "Moy"

CALL cadrebilan2(7, 1, 8, 18, blancbrill, rouge)
CALL cadrebilan2(7, 42, 8, 17, blancbrill, rouge)

LOCATE 8
FOR i = 1 TO 11
LOCATE , 2: PRINT geometrie$(i); " "; LEFT$(ll$, 20 - LEN(geometrie$(i)))
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 43: PRINT geometrie$(i); " "; LEFT$(ll$, 20 - LEN(geometrie$(i)))
NEXT

'affichage des moyennes
LOCATE 8
FOR i = 1 TO 11
LOCATE , 36
IF moy$(i) = "" THEN
PRINT
ELSEIF VAL(moy$(i)) = 9 OR VAL(moy$(i)) = 10 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vertclair
LOCATE , 38
PRINT "A"
ELSEIF VAL(moy$(i)) = 7 OR VAL(moy$(i)) = 8 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vert
LOCATE , 38
PRINT "B"
ELSEIF VAL(moy$(i)) = 6 OR VAL(moy$(i)) = 5 THEN
COLOR blancbrill
PRINT moy$(i);
LOCATE , 38
COLOR jaune
PRINT "C"
ELSE
COLOR blancbrill
PRINT moy$(i);
COLOR rougeclair
LOCATE , 38
PRINT "D"
END IF
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 77
IF moy$(i) = "" THEN
PRINT
ELSEIF VAL(moy$(i)) = 9 OR VAL(moy$(i)) = 10 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vertclair
LOCATE , 79
PRINT "A"
ELSEIF VAL(moy$(i)) = 7 OR VAL(moy$(i)) = 8 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vert
LOCATE , 79
PRINT "B"
ELSEIF VAL(moy$(i)) = 5 OR VAL(moy$(i)) = 6 THEN
COLOR blancbrill
PRINT moy$(i);
LOCATE , 79
COLOR jaune
PRINT "C"
ELSE
COLOR blancbrill
PRINT moy$(i);
COLOR rougeclair
LOCATE , 79
PRINT "D"
END IF
NEXT
COLOR blanc


'++++++++++++++
v = 8
debut = 1
FOR valeur = 1 TO 11
fin = debut + (niveauxgeometrie(valeur) - 1)
h = 24: GOSUB placegeo
debut = fin + 1: v = v + 1
NEXT

v = 8
FOR valeur = 12 TO ma
fin = debut + (niveauxgeometrie(valeur) - 1)
h = 65: GOSUB placegeo
debut = fin + 1: v = v + 1
NEXT
'++++++++++

IF VAL(moygen$) <> 0 THEN
COLOR cyanclair, bleu: LOCATE 19, 43
CALL convertir(moygen$)
PRINT "Moyenne générale : "; moygen$; " sur 10"
END IF

EXIT SUB

placegeo:
LOCATE v
FOR i = debut TO fin
LOCATE , h
IF VAL(t$(i)) < 10 THEN PRINT " ";
IF t$(i) <> " " THEN PRINT LTRIM$(t$(i)); ELSE PRINT "-";
h = h + 3
NEXT
RETURN

END SUB

DEFINT A-Z
SUB Bilanlecture (r%(), matiere, eleve, VarEnreg AS TypeEnreg, niveauxlecture(), lecture$())
ma = 11
DIM no$(ma, 10), t$(10), moy(10), total(10)

IF matiere = 5 THEN
CALL titre("bilan lecture niveau I")
ELSE
CALL titre("bilan lecture niveau II")
END IF

rt$ = CHR$(17) + CHR$(196) + CHR$(217)
ll$ = STRING$(30, ".")

'lecture des notes
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, r%(eleve) + 1, VarEnreg
nom$ = RTRIM$(VarEnreg.nom)
pre$ = RTRIM$(VarEnreg.prenom)
IF matiere = 5 THEN
'lecture niv 1 est en 6° position
nbexo$ = LTRIM$(MID$(VarEnreg.nbexo, 16, 3))
resultat$ = MID$(VarEnreg.notes, 2001, 400)
ELSE
'lecture niv 2 est en 7° position
nbexo$ = LTRIM$(MID$(VarEnreg.nbexo, 19, 3))
resultat$ = MID$(VarEnreg.notes, 2401, 400)
END IF

CLOSE

'possibilité de 20 exercices enregistré sur 10 (2 caractères)
j = 1
FOR i = 1 TO 400 STEP 40 '(10 textes)
t$(j) = MID$(resultat$, i, 40)
j = j + 1
NEXT

FOR text = 1 TO 10
pointeur = 1
FOR matier = 1 TO ma
no$(matier, text) = MID$(t$(text), pointeur, 2)
pointeur = pointeur + 2
NEXT matier
NEXT text

'moyenne générale
tt = 0: nt = 0
FOR i = 1 TO 10
FOR j = 1 TO ma
IF no$(j, i) <> " " THEN tt = tt + VAL(no$(j, i)): nt = nt + 1
NEXT j
NEXT i

IF tt <> 0 THEN moy! = INT((tt / nt) * 10) / 10
GOSUB moytexte

z$ = pre$ + " " + nom$ + " a fait" + STR$(VAL(nbexo$)) + " exercice"
IF VAL(nbexo$) > 1 THEN z$ = z$ + "s"
IF matiere = 5 THEN
z$ = z$ + " de lecture (niveau I)"
ELSE
z$ = z$ + " de lecture (niveau II)"
END IF
COLOR , marron
CALL centre(4, blancbrill, " " + z$ + " ")
COLOR , bleu


LOCATE 6, 26: COLOR vertclair: PRINT "texte n° "; : FOR i = 1 TO 9: PRINT i; " "; : NEXT
LOCATE 6, 71: PRINT "10": COLOR blancbrill

'liste des matières
COLOR , rouge
LOCATE 7, 7: PRINT "┌"; STRING$(66, "─"); "┐"
FOR i = 1 TO ma
LOCATE , 7: PRINT "│ "; lecture$(i); " "; LEFT$(ll$, 20 - LEN(lecture$(i)));
PRINT " │ │ │ │ │ │ │ │ │ │ │"
NEXT
LOCATE , 7: PRINT "└"; STRING$(66, "─"); "┘"


'notes
COLOR blanc
v = 8
FOR i = 1 TO ma
h = 36
FOR j = 1 TO 10
LOCATE v, h: IF VAL(no$(i, j)) = 10 THEN LOCATE v, h - 1
IF no$(i, j) <> " " THEN PRINT LTRIM$(STR$(VAL(no$(i, j))))
h = h + 4
NEXT j
v = v + 1
NEXT i
COLOR cyanclair, bleu: LOCATE 20, 9: PRINT "Moyenne par texte "; LEFT$(ll$, 6)
v = 20: h = 36
FOR text = 1 TO 10
LOCATE v, h: IF moy(text) = 10 THEN LOCATE v, h - 1
IF moy(text) <> 0 THEN
PRINT LTRIM$(STR$((moy(text))))
ELSE
PRINT "-"
END IF
h = h + 4
NEXT
IF tt <> 0 THEN
z$ = STR$(moy!): CALL convertir(z$)
COLOR , bleu
CALL centre(5, jaune, "Moyenne générale :" + z$ + " sur 10")
END IF
COLOR blancbrill
CLOSE
EXIT SUB

moytexte:
FOR text = 1 TO 10
total(text) = 0: nt = 0
FOR i = 1 TO ma
IF no$(i, text) <> " " THEN total(text) = total(text) + VAL(no$(i, text)): nt = nt + 1
NEXT
IF total(text) = 0 THEN
moy(text) = 0
ELSE
moy(text) = INT(((total(text) / nt) * 10) / 10)
END IF
NEXT
RETURN


END SUB

DEFINT A-Z
SUB bilanmath1 (r%(), eleve, VarEnreg AS TypeEnreg, niveauxmath1(), math1$())
ma = 21
DIM t$(100), moy$(ma)

ll$ = STRING$(30, ".")
pt$ = MID$(ll$, 1, 15)
ni$ = "Niveau " + CHR$(26) + " 1 2 3 4"

CALL titre("bilan math niveau I")

'lecture des notes
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, r%(eleve) + 1, VarEnreg
nom$ = RTRIM$(VarEnreg.nom)
pre$ = RTRIM$(VarEnreg.prenom)
'math niv 1 est en 3°
nbexo$ = LTRIM$(MID$(VarEnreg.nbexo, 7, 3))
resultat$ = MID$(VarEnreg.notes, 801, 400)
CLOSE

j = 1
FOR i = 1 TO 200 STEP 2
t$(j) = MID$(resultat$, i, 2)
j = j + 1
NEXT

CALL calmoy(t$(), moy$(), niveauxmath1())

'moy générale
tt = 0: nt = 0
FOR j = 1 TO ma
IF moy$(j) <> "" THEN tt = tt + VAL(moy$(j)): nt = nt + 1
NEXT j
IF nt = 0 THEN moygen$ = " " ELSE moygen$ = LTRIM$(STR$(INT((tt / nt) * 10) / 10))

IF LEN(pre$ + nom$) > 25 THEN pre$ = ""
z$ = pre$ + " " + nom$ + " a fait" + STR$(VAL(nbexo$)) + " exercice"
IF VAL(nbexo$) > 1 THEN z$ = z$ + "s"
z$ = z$ + " de mathématiques (niveau I)"
COLOR , marron
CALL centre(4, blancbrill, " " + z$ + " ")
COLOR , bleu

LOCATE 6, 16: COLOR vertclair: PRINT ni$: COLOR jaune: LOCATE 6, 36: PRINT "Moy"
COLOR vertclair: LOCATE 6, 57: PRINT ni$: COLOR jaune: LOCATE 6, 77: PRINT "Moy"
CALL cadrebilan2(7, 1, 8, 18, blancbrill, rouge)
CALL cadrebilan2(7, 42, 8, 17, blancbrill, rouge)
LOCATE 8
FOR i = 1 TO 11
LOCATE , 2: PRINT math1$(i); " "; LEFT$(ll$, 20 - LEN(math1$(i)))
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 43: PRINT math1$(i); " "; LEFT$(ll$, 20 - LEN(math1$(i)))
NEXT

'affichage des moyennes
LOCATE 8
FOR i = 1 TO 11
LOCATE , 36
IF moy$(i) = "" THEN
PRINT
ELSEIF VAL(moy$(i)) = 9 OR VAL(moy$(i)) = 10 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vertclair
LOCATE , 38
PRINT "A"
ELSEIF VAL(moy$(i)) = 7 OR VAL(moy$(i)) = 8 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vert
LOCATE , 38
PRINT "B"
ELSEIF VAL(moy$(i)) = 6 OR VAL(moy$(i)) = 5 THEN
COLOR blancbrill
PRINT moy$(i);
LOCATE , 38
COLOR jaune
PRINT "C"
ELSE
COLOR blancbrill
PRINT moy$(i);
COLOR rougeclair
LOCATE , 38
PRINT "D"
END IF
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 77
IF moy$(i) = "" THEN
PRINT
ELSEIF VAL(moy$(i)) = 9 OR VAL(moy$(i)) = 10 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vertclair
LOCATE , 79
PRINT "A"
ELSEIF VAL(moy$(i)) = 7 OR VAL(moy$(i)) = 8 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vert
LOCATE , 79
PRINT "B"
ELSEIF VAL(moy$(i)) = 5 OR VAL(moy$(i)) = 6 THEN
COLOR blancbrill
PRINT moy$(i);
LOCATE , 79
COLOR jaune
PRINT "C"
ELSE
COLOR blancbrill
PRINT moy$(i);
COLOR rougeclair
LOCATE , 79
PRINT "D"
END IF
NEXT
COLOR blanc


'++++++++++++++
v = 8
debut = 1
FOR valeur = 1 TO 11
fin = debut + (niveauxmath1(valeur) - 1)
h = 24: GOSUB placema1
debut = fin + 1: v = v + 1
NEXT

v = 8
FOR valeur = 12 TO ma
fin = debut + (niveauxmath1(valeur) - 1)
h = 65: GOSUB placema1
debut = fin + 1: v = v + 1
NEXT
'++++++++++

IF VAL(moygen$) <> 0 THEN
COLOR cyanclair, bleu: LOCATE 19, 43
CALL convertir(moygen$)
PRINT "Moyenne générale : "; moygen$; " sur 10"
END IF

EXIT SUB

placema1:
LOCATE v
FOR i = debut TO fin
LOCATE , h
IF VAL(t$(i)) < 10 THEN PRINT " ";
IF t$(i) <> " " THEN PRINT LTRIM$(t$(i)); ELSE PRINT "-";
h = h + 3
NEXT
RETURN

END SUB

DEFINT A-Z
SUB bilanmath2 (r%(), eleve, VarEnreg AS TypeEnreg, niveauxmath2(), math2$())
DIM t$(100), moy$(21), moygen$(1)
ma = 21
ll$ = STRING$(30, ".")
pt$ = MID$(ll$, 1, 15)
ni$ = "Niveau " + CHR$(26) + " 1 2 3 4"

CALL titre("bilan math niveau II")

'lecture des notes
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, r%(eleve) + 1, VarEnreg
nom$ = RTRIM$(VarEnreg.nom)
pre$ = RTRIM$(VarEnreg.prenom)
'math niv 2 en 4°
nbexo$ = LTRIM$(MID$(VarEnreg.nbexo, 10, 3))
resultat$ = MID$(VarEnreg.notes, 1201, 400)
CLOSE

j = 1
FOR i = 1 TO 200 STEP 2
t$(j) = MID$(resultat$, i, 2)
j = j + 1
NEXT
CALL calmoy(t$(), moy$(), niveauxmath2())

'moy générale
tt = 0: nt = 0
FOR j = 1 TO ma
IF moy$(j) <> "" THEN tt = tt + VAL(moy$(j)): nt = nt + 1
NEXT j
IF nt = 0 THEN moygen$ = " " ELSE moygen$ = LTRIM$(STR$(INT((tt / nt) * 10) / 10))

IF LEN(pre$ + nom$) > 25 THEN pre$ = ""
z$ = pre$ + " " + nom$ + " a fait" + STR$(VAL(nbexo$)) + " exercice"
IF VAL(nbexo$) > 1 THEN z$ = z$ + "s"
z$ = z$ + " de mathématiques (niveau II)"
COLOR , marron
CALL centre(4, blancbrill, " " + z$ + " ")
COLOR , bleu

LOCATE 6, 16: COLOR vertclair: PRINT ni$: COLOR jaune: LOCATE 6, 36: PRINT "Moy"
COLOR vertclair: LOCATE 6, 57: PRINT ni$: COLOR jaune: LOCATE 6, 77: PRINT "Moy"

CALL cadrebilan2(7, 1, 8, 18, blancbrill, rouge)
CALL cadrebilan2(7, 42, 8, 17, blancbrill, rouge)
LOCATE 8
FOR i = 1 TO 11
LOCATE , 2: PRINT math2$(i); " "; LEFT$(ll$, 20 - LEN(math2$(i)))
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 43: PRINT math2$(i); " "; LEFT$(ll$, 20 - LEN(math2$(i)))
NEXT

'affichage des moyennes
LOCATE 8
FOR i = 1 TO 11
LOCATE , 36
IF moy$(i) = "" THEN
PRINT
ELSEIF VAL(moy$(i)) = 9 OR VAL(moy$(i)) = 10 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vertclair
LOCATE , 38
PRINT "A"
ELSEIF VAL(moy$(i)) = 7 OR VAL(moy$(i)) = 8 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vert
LOCATE , 38
PRINT "B"
ELSEIF VAL(moy$(i)) = 6 OR VAL(moy$(i)) = 5 THEN
COLOR blancbrill
PRINT moy$(i);
LOCATE , 38
COLOR jaune
PRINT "C"
ELSE
COLOR blancbrill
PRINT moy$(i);
COLOR rougeclair
LOCATE , 38
PRINT "D"
END IF
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 77
IF moy$(i) = "" THEN
PRINT
ELSEIF VAL(moy$(i)) = 9 OR VAL(moy$(i)) = 10 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vertclair
LOCATE , 79
PRINT "A"
ELSEIF VAL(moy$(i)) = 7 OR VAL(moy$(i)) = 8 THEN
COLOR blancbrill
PRINT moy$(i);
COLOR vert
LOCATE , 79
PRINT "B"
ELSEIF VAL(moy$(i)) = 5 OR VAL(moy$(i)) = 6 THEN
COLOR blancbrill
PRINT moy$(i);
LOCATE , 79
COLOR jaune
PRINT "C"
ELSE
COLOR blancbrill
PRINT moy$(i);
COLOR rougeclair
LOCATE , 79
PRINT "D"
END IF
NEXT
COLOR blanc


'++++++++++++++
v = 8
debut = 1
FOR valeur = 1 TO 11
fin = debut + (niveauxmath2(valeur) - 1)
h = 24: GOSUB place
debut = fin + 1: v = v + 1
NEXT

v = 8
FOR valeur = 12 TO ma
fin = debut + (niveauxmath2(valeur) - 1)
h = 65: GOSUB place
debut = fin + 1: v = v + 1
NEXT
'++++++++++

IF VAL(moygen$) <> 0 THEN
COLOR cyanclair, bleu: LOCATE 19, 43
CALL convertir(moygen$)
PRINT "Moyenne générale : "; moygen$; " sur 10"
END IF

EXIT SUB

place:
LOCATE v
FOR i = debut TO fin
LOCATE , h
IF VAL(t$(i)) < 10 THEN PRINT " ";
IF t$(i) <> " " THEN PRINT LTRIM$(t$(i)); ELSE PRINT "-";
h = h + 3
NEXT
RETURN
END SUB

DEFINT A-Z
SUB bilans (nbmaxi, niveauxfrancais1(), niveauxfrancais2(), niveauxmath1(), niveauxmath2(), niveauxlecture(), niveauxgeometrie(), francais1$(), francais2$(), math1$(), math2$(), geometrie$(), lecture$(), VarEnreg AS TypeEnreg)
'15/5/96
ma = 21
DIM n$(nbmaxi, 2), r%(nbmaxi), m$(nbmaxi), mat$(7), p2$(2)
mat$(1) = "Français niveau I"
mat$(2) = "Français niveau II"
mat$(3) = "Math niveau I"
mat$(4) = "Math niveau II"
mat$(5) = "Lecture niveau I"
mat$(6) = "Lecture niveau II"
mat$(7) = "Géométrie - Mesures"

OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, 1, VarEnreg
nf = VAL(VarEnreg.nom)

FOR i = 1 TO nf
GET #1, i + 1, VarEnreg
n$(i, 1) = RTRIM$(VarEnreg.nom)
n$(i, 2) = RTRIM$(VarEnreg.prenom)
r%(i) = i
NEXT
CLOSE

CALL tri(nf, n$(), r%())
IF nf < 14 THEN
FOR i = 1 TO nf: m$(i) = n$(r%(i), 1) + " " + n$(r%(i), 2): NEXT
ELSEIF nf > 13 AND nf < 27 THEN
FOR i = 1 TO nf: m$(i) = n$(r%(i), 1) + " " + LEFT$(n$(r%(i), 2), 3) + ".": NEXT
ELSE
FOR i = 1 TO nf: m$(i) = n$(r%(i), 1) + " " + LEFT$(n$(r%(i), 2), 1): NEXT
END IF

principal:
CALL titre("BILANS")
eleve = 0

IF nf < 40 THEN
LOCATE 23, 66: COLOR blanc, noir: PRINT es$
CALL fleches3(rep, nf, m$(), 1, gg$, gg2$, blancbrill, blanc, noir, rouge, couleur)
IF rep = 0 THEN CLOSE : COLOR , noir: CLS : EXIT SUB
eleve = rep
ELSE
CALL cadre(9, 42, 24, 3, vert)
COLOR blancbrill, vert
LOCATE 10, 44: PRINT "Tapez le NOM de l'élève"
COLOR , noir
CALL centre(23, blanc, CHR$(24) + " " + CHR$(25))
LOCATE 23, 3: PRINT "["; : COLOR jaune: PRINT "Echap"; : COLOR blancbrill: PRINT "] = Fin"
CALL saisienom(n$, 20, n$(), r%(), nf, nbmaxi)
IF ASC(n$) = 27 THEN COLOR , noir: CLS : EXIT SUB

FOR i = 1 TO nf
IF n$ = MID$(n$(r%(i), 1), 1, LEN(n$)) THEN
eleve = i
EXIT FOR
END IF
NEXT i
END IF

IF eleve = 0 THEN
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
BEEP
CALL centre(23, rougeclair, "Nom absent du fichier")
CALL attendre(1)
eleve = 0
END IF
IF eleve = 0 THEN GOTO principal

'++++++++++++++++++++++++++++++++++++++++++++++
matiere = 1
DO
SELECT CASE matiere

CASE 1
'francais niv 1
CALL bilanfrancais1(r%(), eleve, VarEnreg, niveauxfrancais1(), francais1$())

CASE 2
'francais niv 2
CALL bilanfrancais2(r%(), eleve, VarEnreg, niveauxfrancais2(), francais2$())

CASE 3
'math niv 1
CALL bilanmath1(r%(), eleve, VarEnreg, niveauxmath1(), math1$())

CASE 4
'math niv 2
CALL bilanmath2(r%(), eleve, VarEnreg, niveauxmath2(), math2$())

CASE 5, 6
'lecture 1 & 2
CALL Bilanlecture(r%(), matiere, eleve, VarEnreg, niveauxlecture(), lecture$())

CASE 7
'geometrie
CALL bilangeometrie(r%(), eleve, VarEnreg, niveauxgeometrie(), geometrie$())

END SELECT


w$ = CHR$(24) + " = "
IF matiere = 1 THEN
w$ = w$ + mat$(7)
ELSE
w$ = w$ + mat$(matiere - 1)
END IF
z$ = CHR$(25) + " = "
IF matiere = 7 THEN
z$ = z$ + mat$(1)
ELSE
z$ = z$ + mat$(matiere + 1)
END IF

COLOR , noir
CALL centre(22, blanc, w$ + SPACE$(10) + z$)
CALL centre(23, blanc, "[Echap] = choix élève <- = élève précédent -> = élève suivant")

souris = 0
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
IF v_mouse = 23 THEN
IF h_mouse >= 6 AND h_mouse <= 26 THEN
'echap
s = 27
CALL attendre(.3)
souris = 1: EXIT DO
ELSEIF h_mouse >= 32 AND h_mouse <= 51 THEN
'fleche gauche
s = 75
CALL attendre(.3)
souris = 1: EXIT DO
ELSEIF h_mouse >= 57 AND h_mouse <= 74 THEN
'fleche droite
s = 77
CALL attendre(.3)
souris = 1: EXIT DO
END IF

ELSEIF v_mouse = 22 THEN
IF h_mouse >= 10 AND h_mouse <= 37 THEN
'fleche haut
s = 72
CALL attendre(.3)
souris = 1: EXIT DO
ELSEIF h_mouse >= 44 AND h_mouse <= 70 THEN
'fleche bas
s = 80
CALL attendre(.3)
souris = 1: EXIT DO
END IF
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""

IF souris = 0 AND LEN(r$) < 2 THEN
s = ASC(r$)
ELSEIF souris = 0 THEN
s = ASC(RIGHT$(r$, 1))
END IF

IF s = 27 THEN EXIT DO
IF s <> 75 AND s <> 72 AND s <> 80 AND s <> 77 THEN BEEP
IF s = 75 THEN eleve = eleve - 1
IF s = 77 THEN eleve = eleve + 1
IF s = 72 THEN matiere = matiere - 1
IF s = 80 THEN matiere = matiere + 1
IF matiere < 1 THEN matiere = 7: BEEP
IF matiere > 7 THEN matiere = 1: BEEP
IF eleve < 1 THEN eleve = nf: BEEP
IF eleve > nf THEN eleve = 1: BEEP

LOOP

IF s = 27 THEN GOTO principal
END SUB

DEFINT A-Z
SUB cadre (v%, h%, l%, nli%, c)
'c est l'intérieur
'le fond écran est bleu

v2 = v

'cadre
COLOR c, 1 'bleu

LOCATE v2, h
PRINT STRING$(l + 2, 220)
FOR i = 1 TO nli - 2
v2 = v2 + 1: LOCATE v2, h
PRINT STRING$(l + 2, 219)
NEXT

COLOR , 1 'bleu
LOCATE v2 + 1, h: PRINT CHR$(223)

COLOR , 0
LOCATE v + 1
FOR i = 1 TO nli - 1
LOCATE , h + l + 2
PRINT " "
NEXT
LOCATE v2 + 1, h + 1
PRINT STRING$(l + 1, 223)
COLOR 15
END SUB

DEFINT A-Z
SUB calmoy (t$(), moy$(), niveaux())
'29/3/95
debut = 1
FOR valeur = 1 TO 21
fin = debut + (niveaux(valeur) - 1)
GOSUB calcul
debut = fin + 1
NEXT

EXIT SUB

calcul:
tt = 0: nt = 0
FOR j = debut TO fin
IF t$(j) <> " " THEN tt = tt + VAL(t$(j)): nt = nt + 1
NEXT j
IF nt = 0 THEN moy$(valeur) = "" ELSE moy$(valeur) = LTRIM$(STR$(INT(INT(tt / nt) * 10) / 10))
RETURN
END SUB

DEFINT A-Z
SUB centre (v, coul, ph$)
COLOR coul
LOCATE v, INT(((80 / 2) + 1) - LEN(ph$) / 2): PRINT ph$
COLOR 15
END SUB

DEFINT A-Z
SUB chgcouleur (couleur)
IF couleur = 0 THEN
couleur = 1
ELSE
couleur = 0
END IF

END SUB

DEFINT A-Z
SUB convertir (z$)
'convertir les . en ,
s = INSTR(1, z$, ".")
IF s <> 0 THEN z$ = MID$(z$, 1, s - 1) + "," + MID$(z$, s + 1)
END SUB

DEFINT A-Z
SUB entree (rr)
COLOR , noir
CALL centre(23, blanc, rt$)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
r$ = ""
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll row, col, lButton, rButton
IF lButton THEN
r$ = CHR$(13)
CALL attendre(.5)
END IF
LOOP WHILE r$ = ""

IF LEN(r$) < 2 THEN rr = ASC(r$) ELSE rr = ASC(RIGHT$(r$, 1))

COLOR blancbrill
END SUB

DEFINT A-Z
SUB entree_echap (rr)
COLOR , noir
CALL centre(23, blanc, rt$ + " = Continuer" + SPACE$(20) + es$)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
r$ = ""
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
IF v_mouse = 23 AND (h_mouse >= 53 AND h_mouse <= 63) THEN
CLOSE : COLOR , bleu: CLS : RUN "menu"
ELSE
r$ = CHR$(13)
CALL attendre(.3)
END IF
END IF
LOOP WHILE r$ = ""

IF LEN(r$) < 2 THEN rr = ASC(r$) ELSE rr = ASC(RIGHT$(r$, 1))

COLOR blancbrill

END SUB

DEFINT A-Z
SUB fleches (v%, h%, w$(), np%, r%, drap, v2, h2)
'PRINT v2, h2
'v2 et h2 sont la ligne colonne des fleches
DIM p$(np)

souris = 0
LOCATE , , 0
FOR i = 1 TO np: p$(i) = w$(i): NEXT
l2 = 0
FOR i = 1 TO np
l1 = LEN(p$(i)): IF l2 < l1 THEN l2 = l1
NEXT
FOR i = 1 TO np
p$(i) = p$(i) + SPACE$(l2 - LEN(p$(i)))
NEXT

'souris
v_mini = v: v_maxi = v_mini + np - 1
h_mini = h - 1: h_maxi = LEN(p$(1)) + h_mini + 1

'cadre
IF drap = 1 THEN
CALL cadre(v - 1, h - 3, l2 + 4, np + 2, rouge)
END IF
COLOR blancbrill, rouge
coul = rouge

LOCATE v
FOR i = 1 TO np
LOCATE , h - 1: PRINT " "; p$(i); " "
NEXT
vt = v - 1
LOCATE v, h - 1
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(1); " "
COLOR blancbrill, coul
DO
DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE 1050, PEEK(1052)
DEF SEG

DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
IF v_mouse >= v_mini AND v_mouse <= v_maxi THEN
IF h_mouse >= h_mini AND h_mouse <= h_maxi THEN
LOCATE v_mini
FOR i = 1 TO np
LOCATE , h_mini: PRINT " "; p$(i); " "
NEXT
calcul = v_mouse - v_mini + 1
LOCATE v_mouse, h_mini
COLOR coul, blancbrill
PRINT " "; p$(calcul); " "
CALL attendre(.3)
r = calcul
EXIT SUB
ELSE
BEEP
END IF
ELSEIF v_mouse = v2 AND h_mouse = h2 THEN
rr = 72 'fleche haut
souris = 1
CALL attendre(.2)
EXIT DO
ELSEIF v_mouse = v2 AND h_mouse = h2 + 2 THEN
rr = 80 'fleche bas
souris = 1
CALL attendre(.2)
EXIT DO
ELSEIF v_mouse = v2 AND (h_mouse >= h2 + 9 AND h_mouse <= h2 + 11) THEN
rr = 13
souris = 1
CALL attendre(.3)
EXIT DO
ELSE
BEEP
END IF
END IF

LOOP WHILE r$ = ""

IF souris = 0 AND LEN(r$) < 2 THEN
rr = ASC(r$)
ELSEIF souris = 0 THEN
rr = ASC(RIGHT$(r$, 1))
END IF

IF rr = 27 THEN r = 0: EXIT SUB
LOCATE v, h - 1: PRINT " "; p$(v - vt); " "
IF rr = 72 THEN v = v - 1: IF v = vt THEN v = vt + np
IF rr = 80 THEN v = v + 1: IF v = vt + np + 1 THEN v = vt + 1
LOCATE v, h - 1
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(v - vt); " "
COLOR blancbrill, coul
LOOP WHILE rr <> 13
r = v - vt
COLOR blancbrill
END SUB

DEFINT A-Z
SUB getinvimouse (rr)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
r$ = CHR$(13)
CALL attendre(.5)
END IF
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN rr = ASC(r$) ELSE rr = ASC(RIGHT$(r$, 1))


END SUB

DEFINT A-Z
SUB inputline (r$, nl)
DIM re$(40)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
ligne = CSRLIN
col = POS(0)
debutinput:
LOCATE ligne, col, 1
FOR ii = 1 TO nl + 1

input0:
IF ii <= 0 THEN ii = 1
input1:
DO
re$(ii) = INKEY$
LOOP WHILE re$(ii) = ""

IF re$(ii) = CHR$(27) THEN r$ = CHR$(27): LOCATE , , 0: EXIT SUB
IF LEN(re$(ii)) = 2 THEN
z2 = ASC(RIGHT$(re$(ii), 1))
IF ii > 1 AND (z2 = 75 OR z2 = 83 OR z2 = 15) THEN PRINT CHR$(29); " "; CHR$(29); : ii = ii - 1: z2 = 0: GOTO input0
END IF
IF ASC(re$(ii)) = 13 THEN EXIT FOR
IF ii > 1 AND ASC(re$(ii)) = 8 THEN PRINT CHR$(29); " "; CHR$(29); : ii = ii - 1: GOTO input0
IF ASC(re$(ii)) < 32 OR ASC(re$(ii)) > 165 THEN GOTO input1
IF ii = nl + 1 THEN BEEP: GOTO input1
PRINT re$(ii); " "; CHR$(29);
NEXT ii
PRINT
r$ = "": FOR jj = 1 TO ii - 1: r$ = r$ + re$(jj): NEXT
r$ = LTRIM$(r$): r$ = RTRIM$(r$)
r$ = UCASE$(r$)
IF r$ = "" THEN BEEP: GOTO debutinput
LOCATE , , 0

END SUB

DEFINT A-Z
SUB motpasse (f)
DIM w$(6)
f = 1

END SUB

DEFINT A-Z
SUB nomprenom (n$, pr$, nom$, prenom$, flagnom)
pt$ = STRING$(15, ".")

nomprenom: '++++++++++++++++++++++++++++++++++++++++++++++++++++
DEF SEG = 0
POKE &H417, (PEEK(&H417) OR &H40) 'MAJ
DEF SEG
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
IF flagnom = 1 THEN
CALL centre(23, blanc, "Tapez le Nom")
ELSE
CALL centre(23, blanc, "Modifiez le Nom")
END IF
COLOR noir, blanc
LOCATE 11, 24: PRINT "NOM : ";
h = 30

IF flagnom = 2 THEN
PRINT nom$
r$ = nom$
CALL pleineligne(z$, r$, 15, 11, 30)
IF z$ = CHR$(27) THEN COLOR , bleu: CLS : RUN "menu"
IF z$ = CHR$(13) AND r$ = "" THEN r$ = nom$
IF LEN(r$) > 15 THEN r$ = LEFT$(r$, 15)
r$ = LTRIM$(RTRIM$(UCASE$(r$)))
ELSE
PRINT pt$
LOCATE 11, h
COLOR noir, blanc
CALL inputline(r$, 15)
'===IF nf = 1 AND ASC(r$) = 27 THEN CLOSE : COLOR , bleu: CLS : RUN "menu"
END IF

IF ASC(r$) = 27 THEN COLOR , bleu: CLS : RUN "menu"
IF ASC(r$) = 13 AND flagnom = 2 THEN n$ = nom$: GOTO prenom
IF ASC(r$) < 63 OR ASC(r$) > 138 THEN GOSUB erreurs: GOTO nomprenom
FOR i = 1 TO LEN(r$)
x = ASC(MID$(r$, i, 1))
IF x >= 65 AND x <= 90 THEN 5200
IF x = 32 THEN 5200
' IF x = 39 THEN 5200 'guillemet
IF x = 135 THEN x = 67 'ç
IF x = 138 OR x = 130 THEN x = 69 'é è
IF x = 133 THEN x = 65 'à
IF x = 45 THEN x = 32: GOTO 5190 '-
IF x < 65 OR x > 90 THEN GOSUB erreurs: GOTO nomprenom
5190 r$ = MID$(r$, 1, i - 1) + CHR$(x) + MID$(r$, i + 1)
5200 NEXT

'on vérifie qu'il n'y a pas deux espaces ou plus
CALL testespace(r$)

LOCATE 11, h: PRINT SPACE$(15)
LOCATE 11, h: PRINT r$

n$ = r$

prenom:
DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &HBF) 'minus
DEF SEG
COLOR , noir
IF flagnom = 1 THEN
CALL centre(23, blanc, "Tapez le Prénom")
ELSE
CALL centre(23, blanc, "Modifiez le Prénom")
END IF
COLOR noir, blanc
LOCATE 13, 4 + 20: PRINT "Prénom : ";
h = 33

IF flagnom = 2 THEN
PRINT prenom$
r$ = prenom$
CALL pleineligne(z$, r$, 15, 13, 33)
IF z$ = CHR$(27) THEN COLOR , bleu: CLS : RUN "menu"
IF z$ = CHR$(13) AND r$ = "" THEN r$ = prenom$
r$ = LTRIM$(RTRIM$(LCASE$(r$)))
ELSE
PRINT pt$
LOCATE 13, h
COLOR noir, blanc
CALL inputline(r$, 15)
IF ASC(r$) = 27 THEN COLOR , bleu: CLS : RUN "menu"
IF ASC(r$) = 13 AND flagnom = 2 THEN pr$ = prenom$: RETURN
IF ASC(r$) < 63 OR ASC(r$) > 138 THEN GOSUB erreurs: GOTO prenom
r$ = LCASE$(r$)
END IF
'on transforme la 1° lettre en majuscule
x = ASC(LEFT$(r$, 1))
IF x = 135 THEN x = 99 'ç
IF x = 138 OR x = 130 THEN x = 101 'é è
IF x = 133 THEN x = 97 'à
IF x > 122 THEN GOSUB erreurs: GOTO prenom
r$ = UCASE$(CHR$(x)) + MID$(r$, 2, LEN(r$) - 1)

CALL testespace(r$)

CALL testtiret(r$)

'on met une majuscule après l'espace ou le tiret
FOR z = 1 TO LEN(r$)
IF MID$(r$, z, 1) = " " OR MID$(r$, z, 1) = "-" THEN
r$ = MID$(r$, 1, z) + CHR$(ASC(MID$(r$, z + 1, 1)) - 32) + MID$(r$, z + 2)
END IF
NEXT z

LOCATE 13, h: PRINT SPACE$(15)
LOCATE 13, h: PRINT r$
pr$ = r$
COLOR , noir: LOCATE 23, 1: PRINT SPACE$(80)
CALL attendre(.5)

EXIT SUB

erreurs:
COLOR , noir
BEEP
CALL centre(23, rougeclair, "Caractère incorrect... Retapez")
CALL attendre(1.5)
LOCATE 23, 1: PRINT SPACE$(80)
RETURN

END SUB

DEFINT A-Z
SUB pleineligne (z$, r$, np, v, h)
'9/1/97
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG

h2 = h
f = 0 'recouvrement

ple1:
IF NOT f THEN LOCATE v, h, 1, 0, 7 ELSE LOCATE v, h, 1, 7
IF h < h2 THEN h = h2
IF h > np + h2 THEN h = np + h2
IF h - h2 > LEN(r$) THEN h = LEN(r$) + h2
LOCATE v, h2, 0: PRINT SPACE$(np + 1)
LOCATE v, h2: PRINT r$
lc = h - (h2 - 1)

LOCATE v, h, 1
DO
z$ = INKEY$
LOOP WHILE z$ = ""

IF z$ = CHR$(27) OR z$ = CHR$(13) THEN
LOCATE , , 0, 7
EXIT SUB
END IF

IF LEN(z$) = 2 THEN GOTO plecaet
r2 = ASC(z$)

IF r2 > 31 AND r2 < 255 THEN
IF LEN(r$) >= np THEN BEEP: IF f THEN r$ = MID$(r$, 1, LEN(r$) - 1)
IF f THEN
r$ = MID$(r$, 1, lc - 1) + z$ + MID$(r$, lc)
ELSE
r$ = MID$(r$, 1, lc - 1) + z$ + MID$(r$, lc + 1)
END IF
h = h + 1
IF h > np + h2 THEN h = np + h2
GOTO ple1
END IF

IF r2 = 8 THEN 'delete
IF h <> h2 THEN r$ = MID$(r$, 1, lc - 2) + MID$(r$, lc): h = h - 1
GOTO ple1
END IF

plecaet:
'carac étendu
r2 = ASC(RIGHT$(z$, 1))
SELECT CASE r2
CASE 77
h = h + 1 'droite
CASE 71
h = h2 'home
CASE 79
h = np + h2 'end
CASE 75
h = h - 1 'gauche
CASE 82
f = NOT f 'ins
CASE 83
r$ = MID$(r$, 1, lc - 1) + MID$(r$, lc + 1) 'suppr
END SELECT
GOTO ple1

END SUB

DEFINT A-Z
SUB saisienom (r$, nl, n$(), r%(), nf, nbmaxi)
DIM re$(nl + 1), nom$(nbmaxi)
r$ = ""
FOR i = 1 TO nf
nom$(i) = n$(r%(i), 1)
NEXT

CALL cadre(13, 42, 24, 3, blanc)

reponse = 1

GOSUB afficheliste

debinput:
ii = 0
DO
ii = ii + 1

input21:
IF ii <= 0 THEN ii = 1
COLOR noir, blanc
LOCATE 14, 44 + ii, 1: PRINT "_" + SPACE$(nl + 1 - ii)
LOCATE 14, 44 + ii, 1

DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG

DO
re$(ii) = UCASE$(INKEY$)
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 22, 1: PRINT v_mouse, h_mouse'===
IF lButton THEN
IF v_mouse = 23 THEN
IF h_mouse = 39 THEN
IF reponse > 1 THEN
reponse = reponse - 1
GOSUB affichelistebis
ELSE
BEEP
END IF
ELSEIF h_mouse = 41 THEN
IF reponse < nf THEN
reponse = reponse + 1
GOSUB affichelistebis
ELSE
BEEP
END IF
ELSEIF h_mouse >= 3 AND h_mouse <= 15 THEN
r$ = CHR$(27): LOCATE , , 0
CALL attendre(.3)
EXIT SUB
ELSEIF h_mouse >= 62 AND h_mouse <= 78 THEN
r$ = "*": LOCATE , , 0
CALL attendre(.3)
EXIT SUB
END IF

ELSEIF (v_mouse >= 6 AND v_mouse <= 17) AND (h_mouse >= 13 AND h_mouse <= 27) THEN
z$ = ""
FOR i = 1 TO 15
w = SCREEN(v_mouse, 12 + i)
IF w = 32 OR (w >= 65 AND w <= 90) THEN
z$ = z$ + CHR$(w)
END IF
NEXT
z$ = RTRIM$(z$)

IF z$ = "" THEN
BEEP
ELSE
LOCATE , , 0
GOSUB affichelistebis
COLOR rouge, blanc: LOCATE v_mouse, 13: PRINT z$
COLOR noir, blanc: LOCATE 14, 45: PRINT z$; SPACE$(20 - LEN(z$))
r$ = z$
CALL attendre(.7)
EXIT SUB
END IF
ELSEIF (v_mouse >= 6 AND v_mouse <= 17) AND (h_mouse >= 29 AND h_mouse <= 31) THEN
IF v_mouse = 6 THEN
IF reponse > 1 THEN
reponse = reponse - 1
GOSUB affichelistebis
ELSE
BEEP
END IF
ELSEIF v_mouse = 17 THEN
IF reponse < nf THEN
reponse = reponse + 1
GOSUB affichelistebis
ELSE
BEEP
END IF
ELSE
'calculer reponse
IF v_mouse = 7 THEN
valeur = 1
ELSEIF v_mouse = 8 THEN
valeur = 11
ELSEIF v_mouse = 9 THEN
valeur = 21
ELSEIF v_mouse = 10 THEN
valeur = 31
ELSEIF v_mouse = 11 THEN
valeur = 41
ELSEIF v_mouse = 12 THEN
valeur = 51
ELSEIF v_mouse = 13 THEN
valeur = 61
ELSEIF v_mouse = 14 THEN
valeur = 71
ELSEIF v_mouse = 15 THEN
valeur = 81
ELSEIF v_mouse = 16 THEN
valeur = 91
END IF
reponse = INT((valeur / 100) * nf)
IF reponse = 0 THEN reponse = 1
GOSUB affichelistebis
END IF
ELSE
BEEP
END IF
END IF

LOOP WHILE re$(ii) = ""

flag = 0
IF LEN(re$(ii)) = 2 THEN
temp = ASC(RIGHT$(re$(ii), 1))
IF temp = 72 OR temp = 80 THEN
re$(ii) = RIGHT$(re$(ii), 1)
flag = 1
END IF
END IF

SELECT CASE ASC(re$(ii))

CASE 27
r$ = CHR$(27): LOCATE , , 0
EXIT SUB

CASE 13
EXIT DO

CASE 80 'haut
IF flag = 1 THEN
IF reponse < nf THEN
reponse = reponse + 1
GOSUB affichelistebis
ELSE
BEEP
END IF
ii = 1: GOTO input21
END IF

CASE 72 'bas
IF flag = 1 THEN
IF reponse > 1 THEN
reponse = reponse - 1
GOSUB affichelistebis
ELSE
BEEP
END IF
ii = 1: GOTO input21
END IF

CASE 42, 36, 56, 230, 43 'l'étoile "*"
r$ = "*": LOCATE , , 0
EXIT SUB

CASE 32
IF ii = 1 THEN
BEEP
GOTO input21
END IF

END SELECT

IF LEN(re$(ii)) = 2 THEN
z2 = ASC(RIGHT$(re$(ii), 1))
IF ii > 1 AND (z2 = 75 OR z2 = 83 OR z2 = 15) THEN
ii = ii - 2
IF ii <= 0 THEN ii = 0
GOTO input22
END IF
END IF

IF ii > 1 AND ASC(re$(ii)) = 8 THEN
ii = ii - 2
IF ii <= 0 THEN ii = 0
GOTO input22
END IF

IF ASC(re$(ii)) < 32 OR ASC(re$(ii)) > 90 THEN
BEEP: GOTO input21
END IF

IF ii = nl + 1 THEN
BEEP: GOTO input21
END IF

input22:
r$ = "": FOR jj = 1 TO ii: r$ = r$ + re$(jj): NEXT
r$ = LTRIM$(UCASE$(r$))
CALL cadre(13, 42, 24, 3, blanc)
COLOR noir, blanc
LOCATE 14, 45: PRINT r$

GOSUB afficheliste
LOOP

r$ = LTRIM$(r$): r$ = RTRIM$(r$)
IF r$ = "" THEN BEEP: GOTO debinput

CALL testespace(r$)

LOCATE , , 0
EXIT SUB

afficheliste:
reponse = 1

LOCATE , , 0
CALL cadre(5, 10, 21, 14, rouge)
COLOR blancbrill, rouge
IF ii = 0 THEN
GOSUB ascenseur
LOCATE 6
FOR i = 1 TO 12
LOCATE , 13
PRINT nom$(i)
NEXT
RETURN
END IF

FOR i = 1 TO nf
IF r$ <= LEFT$(nom$(i), ii) THEN
reponse = i
EXIT FOR
END IF
NEXT

GOSUB ascenseur

LOCATE 6
dernier = reponse + 11: IF reponse + 11 > nf THEN dernier = nf
FOR i = reponse TO dernier
LOCATE , 13
IF i = reponse THEN
IF r$ = nom$(reponse) THEN
LOCATE , 13
COLOR rouge, blanc
ELSE
COLOR blancbrill
END IF
ELSE
COLOR blancbrill
END IF
PRINT nom$(i)
COLOR blancbrill, rouge
NEXT
LOCATE , , 1
RETURN

affichelistebis:
LOCATE , , 0
CALL cadre(5, 10, 21, 14, rouge)
COLOR blancbrill, rouge
GOSUB ascenseur
LOCATE 6
dernier = reponse + 11: IF reponse + 11 > nf THEN dernier = nf
FOR i = reponse TO dernier
LOCATE , 13
PRINT nom$(i)
NEXT
CALL attendre(.1)
RETURN

ascenseur:
valeur = INT((reponse / nf) * 100)
IF reponse = 1 AND nf <= 12 THEN valeur = 1
COLOR blanc, noir
h = 30
LOCATE 6, h: PRINT CHR$(24)
LOCATE 7
FOR i = 1 TO 10
LOCATE , h: PRINT CHR$(176)
NEXT
LOCATE , h: PRINT CHR$(25)
'affichage de l'ascenseur
v = 7
IF valeur >= 0 AND valeur < 10 THEN
LOCATE v, h
ELSEIF valeur >= 10 AND valeur < 20 THEN
LOCATE v + 1, h
ELSEIF valeur >= 20 AND valeur < 30 THEN
LOCATE v + 2, h
ELSEIF valeur >= 30 AND valeur < 40 THEN
LOCATE v + 3, h
ELSEIF valeur >= 40 AND valeur < 50 THEN
LOCATE v + 4, h
ELSEIF valeur >= 50 AND valeur < 60 THEN
LOCATE v + 5, h
ELSEIF valeur >= 60 AND valeur < 70 THEN
LOCATE v + 6, h
ELSEIF valeur >= 70 AND valeur < 80 THEN
LOCATE v + 7, h
ELSEIF valeur >= 80 AND valeur < 90 THEN
LOCATE v + 8, h
ELSEIF valeur >= 90 AND valeur <= 100 THEN
LOCATE v + 9, h
END IF
PRINT CHR$(219)
COLOR blancbrill, rouge
RETURN
END SUB


DEFINT A-Z
SUB saisienom2 (r$, nl, nom$(), r%(), n)
DIM re$(nl + 1)
r$ = ""
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG

debsaisie:
CALL cadre(10, 42, 24, 5, blanc)

GOSUB afficheliste2

ii = 0
DO
ii = ii + 1

saisie21:
IF ii <= 0 THEN ii = 1
COLOR noir, blanc
LOCATE 12, 44 + ii, 1: PRINT "_"
LOCATE 12, 44 + ii, 1

DO
re$(ii) = UCASE$(INKEY$)
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
IF (v_mouse >= 7 AND v_mouse <= 16) AND (h_mouse >= 13 AND h_mouse <= 27) THEN
z$ = ""
FOR i = 1 TO 15
w = SCREEN(v_mouse, 12 + i)
IF w = 32 OR (w >= 65 AND w <= 90) THEN
z$ = z$ + CHR$(w)
END IF
NEXT
z$ = RTRIM$(z$)

IF z$ = "" THEN
BEEP
ELSE
LOCATE , , 0
COLOR rouge, blanc: LOCATE v_mouse, 13: PRINT z$
COLOR noir, blanc: LOCATE 12, 45: PRINT z$; SPACE$(20 - LEN(z$))
r$ = z$
CALL attendre(.7)
EXIT SUB
END IF
ELSE
BEEP
END IF
END IF

LOOP WHILE re$(ii) = ""

SELECT CASE ASC(re$(ii))

CASE 27
r$ = CHR$(27): LOCATE , , 0
EXIT SUB

CASE 13
EXIT DO

CASE 42, 36, 56, 230, 43 'l'étoile "*"
r$ = "*": LOCATE , , 0
EXIT SUB

CASE 32
IF ii = 1 THEN
BEEP
GOTO saisie21
END IF

END SELECT

IF LEN(re$(ii)) = 2 THEN
z2 = ASC(RIGHT$(re$(ii), 1))
IF ii > 1 AND (z2 = 75 OR z2 = 83 OR z2 = 15) THEN
ii = ii - 2
IF ii <= 0 THEN ii = 0
GOTO saisie22
END IF
END IF

IF ii > 1 AND ASC(re$(ii)) = 8 THEN
ii = ii - 2
IF ii <= 0 THEN ii = 0
GOTO saisie22
END IF

IF ASC(re$(ii)) < 32 OR ASC(re$(ii)) > 90 THEN
BEEP: GOTO saisie21
END IF

IF ii = nl + 1 THEN
BEEP: GOTO saisie21
END IF

saisie22:
r$ = "": FOR jj = 1 TO ii: r$ = r$ + re$(jj): NEXT
r$ = LTRIM$(UCASE$(r$))
CALL cadre(10, 42, 24, 5, blanc)
COLOR noir, blanc
LOCATE 12, 45: PRINT r$

GOSUB afficheliste2
LOOP

r$ = LTRIM$(r$): r$ = RTRIM$(r$)
IF r$ = "" THEN BEEP: GOTO debsaisie

'on vérifie qu'il n'y a pas deux espaces ou plus
l = 1
DO
GOSUB espace2
LOOP WHILE z <> 0

LOCATE , , 0
EXIT SUB

afficheliste2:
CALL cadre(5, 10, 18, 14, rouge)
COLOR blancbrill, rouge
LOCATE 7
IF ii = 0 THEN
FOR i = 1 TO 10
LOCATE , 13
PRINT nom$(i)
NEXT
RETURN
END IF

reponse = 1
FOR i = 1 TO n
IF r$ <= LEFT$(nom$(i), ii) THEN
reponse = i
EXIT FOR
END IF
NEXT
dernier = reponse + 9: IF reponse + 9 > n THEN dernier = n
FOR i = reponse TO dernier
LOCATE , 13
PRINT nom$(i)
NEXT
RETURN

espace2:
z = INSTR(l, r$, " "): IF z = LEN(r$) THEN RETURN
IF ASC(MID$(r$, z + 1, 1)) = 32 THEN r$ = MID$(r$, 1, z) + MID$(r$, z + 2): RETURN
l = z + 1
RETURN


END SUB

DEFINT A-Z
SUB titre (w$)
IF couleur = 0 THEN CALL titrenb(w$): EXIT SUB
COLOR , noir: CLS
FOR i = 1 TO LEN(w$)
IF MID$(w$, i, 1) = "é" OR MID$(w$, i, 1) = "è" THEN
w$ = MID$(w$, 1, i - 1) + "E" + MID$(w$, i + 1)
END IF
NEXT
FOR i = 1 TO LEN(w$)
IF MID$(w$, i, 1) = "à" THEN
w$ = MID$(w$, 1, i - 1) + "A" + MID$(w$, i + 1)
END IF
NEXT

COLOR , vert
LOCATE 2, 1: PRINT SPACE$(80)
CALL centre(2, noir, UCASE$(w$))
LOCATE 21, 1: PRINT SPACE$(80)
VIEW PRINT 3 TO 20: COLOR blancbrill, bleu: CLS 2: VIEW PRINT

END SUB

DEFINT A-Z
SUB titrenb (w$)
COLOR , noir: CLS
FOR i = 1 TO LEN(w$)
IF MID$(w$, i, 1) = "é" OR MID$(w$, i, 1) = "è" THEN
w$ = MID$(w$, 1, i - 1) + "E" + MID$(w$, i + 1)
END IF
NEXT
CALL centre(1, blanc, UCASE$(w$))
LOCATE 2: COLOR blancbrill: PRINT STRING$(80, 196)
LOCATE 21, 1: PRINT STRING$(80, 196)
VIEW PRINT 3 TO 20: CLS 2: VIEW PRINT
END SUB

DEFINT A-Z
SUB transferttextes ()
DIM p$(3), cla$(50)

DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
DEF SEG
titr$ = "TRANSFERT"
CALL titre(titr$)
CALL cadre(4, 5, 70, 15, marron)
COLOR , blanc
CALL centre(6, noir, " Utilisation dans une salle informatique avec plusieurs postes afin ")
CALL centre(7, noir, SPACE$(15) + "d'éviter de devoir retaper les textes." + SPACE$(15))
COLOR , marron
CALL centre(9, blancbrill, "Ce module permet d'exporter ou d'importer les textes.")
CALL centre(11, blancbrill, "Il suffit d'introduire une disquette formatée dans le lecteur A:")
CALL centre(13, blancbrill, "On exporte les textes.")
CALL centre(15, blancbrill, "Puis on introduit la disquette sur un autre ordinateur")
CALL centre(16, blancbrill, "et on importe.")
COLOR , noir
CALL entree_echap(r)

'demander exporter ou importer

debuttrans:

CALL titre(titr$)
CALL centre(8, vertclair, "Votre choix :")
p$(1) = "Importation des textes": p$(2) = "Exportation des textes": p$(3) = "Fin"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(11, 30, p$(), 3, expimp, 1, 23, 35)
IF expimp = 3 OR expimp = 0 THEN COLOR , bleu: CLS : RUN "menu"

CALL titre(titr$)

'lecteur
CALL titre("Lecteur de disquette")
CALL cadre(8, 10, 60, 7, marron)
COLOR , marron
CALL centre(10, blancbrill, "Introduisez une disquette formatée")
CALL centre(12, blancbrill, "dans le lecteur A:")

CALL entree_echap(w)
IF w = 27 THEN COLOR , bleu: CLS : RUN "menu"

SELECT CASE expimp
CASE 1
'importation
CALL titre("importation des textes")
CALL lecdir(cla$(), ncl, "a:\", "TXT")
COLOR , bleu

IF ncl = 0 THEN
CALL cadre(8, 10, 60, 7, rouge)
COLOR , rouge
BEEP
CALL centre(10, blancbrill, "Il n'y a pas de textes sur cette disquette.")
CALL centre(12, blancbrill, "Vous devez d'abord exporter.")
CALL entree_echap(w)
GOTO debuttrans
END IF

f = 0
FOR i = 1 TO ncl
IF LCASE$(cla$(i)) = "fichier1" OR LCASE$(cla$(i)) = "fichier2" THEN f = 1: EXIT FOR
NEXT

IF f = 0 THEN
CALL cadre(8, 10, 60, 10, rouge)
COLOR , rouge
BEEP
CALL centre(10, blancbrill, "Le(s) fichier(s) contenant des textes sur cette disquette")
CALL centre(12, blancbrill, "ne sont pas corrects.")
CALL centre(15, blancbrill, "Vous devez d'abord exporter.")
CALL entree_echap(w)
GOTO debuttrans
END IF

CALL cadre(11, 10, 60, 3, marron)
COLOR , marron
CALL centre(12, blancbrill, "Ecriture des deux fichiers sur le disque dur.")
COLOR , noir
LOCATE 23
SHELL "copy a:\FICHIER1.TXT " + lecteur$
LOCATE 23
SHELL "copy a:\FICHIER2.TXT " + lecteur$
LOCATE 23, 1: PRINT SPACE$(40)
SLEEP 3
CALL titre("importation des textes")
CALL cadre(10, 20, 40, 5, blanc)
COLOR , blanc
CALL centre(12, noir, "Importation effectuée.")
CALL entree(w)

CASE 2
'exportation
CALL titre("exportation des textes")
CALL cadre(11, 10, 60, 3, marron)
COLOR , marron
CALL centre(12, blancbrill, "Ecriture des deux fichiers sur la disquette")
COLOR , noir
LOCATE 23
SHELL "copy FICHIER1.TXT a:\"
LOCATE 23
SHELL "copy FICHIER2.TXT a:\"
LOCATE 23, 1: PRINT SPACE$(40)
SLEEP 3
CALL titre("exportation des textes")
CALL cadre(10, 20, 40, 5, blanc)
COLOR , blanc
CALL centre(12, noir, "Exportation effectuée.")
CALL entree(w)

END SELECT

END SUB

DEFINT A-Z
SUB tri (nf, n$(), r%())

n = nf: m = n
530 m = INT(m / 2): K = n - m: j = 1
IF m = 0 THEN EXIT SUB
560 i = j
570 l1 = i + m: i2 = r%(i): l2 = r%(l1)
IF n$(i2, 1) <= n$(l2, 1) THEN 580 'tri des noms
SWAP r%(i), r%(l1)
i = i - m: IF i >= 1 THEN 570
580 j = j + 1: IF j > K THEN 530
GOTO 560

END SUB
 

  

DECLARE SUB fleches3 (r%, np%, w$(), flag%, gg$, gg2$, blancbrill%, blanc%, noir%, bleu%, couleur%)
DECLARE SUB MousePoll (row%, col%, lButton%, rButton%)
DECLARE SUB ouinon (r$, blanc%, jaune%)
DECLARE SUB entree_echap (rr%)
DECLARE SUB fleches (v%, h%, w$(), np%, r%, drap%, v2%, h2%)
DECLARE SUB attendre (tx!)
DECLARE SUB cadre (v%, h%, l%, nli%, c%)
DECLARE SUB centre (v%, coul%, ph$)
DECLARE SUB entree (rr%)
DECLARE SUB getinvimouse (rr%)
DECLARE SUB titre (w$)
DECLARE SUB tri (nf%, n$(), r%())
DECLARE SUB saisienom2 (r$, nl%, nom$(), r%(), n%)
DEFINT A-Z
'menu2
'Daniel CLERC
'1/11/96

TYPE TypeEnreg
nom AS STRING * 20
prenom AS STRING * 20
nbexo AS STRING * 21
Divers AS STRING * 50
notes AS STRING * 3000
END TYPE
DIM VarEnreg AS TypeEnreg


DEFINT A-Z
SUB aproposde (rt$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%, cyanclair%, rougeclair%, jaune%, blancbrill%)
CALL titre("A propos de...")
CALL cadre(4, 20, 40, 5, blanc)
COLOR , blanc
h = 23
CALL centre(5, noir, "A T E L I E R S")
CALL centre(7, noir, "A I D E et S O U T I E N")

CALL cadre(10, 20, 40, 10, rouge)
COLOR , rouge
CALL centre(12, vertclair, "Auteur : Daniel CLERC")
CALL centre(14, jaune, "Logiciel libre de droit")
CALL centre(16, jaune, "http://daniel.clerc2.free.fr")
'CALL centre(15, blanc, "Code : AAS")

'CALL centre(16, blanc, "418, av. Roland Garros - 78530 Buc")
'CALL centre(17, blanc, "Tél. : 01 39 56 17 56")
'CALL centre(18, blanc, "Fax. : 01 39 56 17 26")
CALL entree(w)

END SUB

DEFINT A-Z
SUB cadrebilan1 (v, h, debut, fin, blancbrill, rouge)
COLOR blancbrill, rouge
LOCATE v, h: PRINT "┌─────────────────────┬──┬──┬──┬───┐"
FOR i = debut TO fin
LOCATE , h: PRINT "│ │ │ │ │ │"
NEXT i
LOCATE , h: PRINT "└─────────────────────┴──┴──┴──┴───┘"

END SUB

DEFINT A-Z
SUB cadrebilan2 (v, h, debut, fin, blancbrill, rouge)
COLOR blancbrill, rouge
LOCATE v, h: PRINT "┌─────────────────────┬──┬──┬──┬──┬───┐"
FOR i = debut TO fin
LOCATE , h: PRINT "│ │ │ │ │ │ │"
NEXT i
LOCATE , h: PRINT "└─────────────────────┴──┴──┴──┴──┴───┘"

END SUB

DEFINT A-Z
SUB fleches3 (r, np, w$(), flag, gg$, gg2$, blancbrill, blanc, noir, rouge, couleur)
'bleu = 1
DIM p$(np)
'flag pour l'* (2)

COLOR blancbrill

FOR i = 1 TO np: p$(i) = w$(i): NEXT
l2 = 0
FOR i = 1 TO np
l1 = LEN(p$(i)): IF l2 < l1 THEN l2 = l1
NEXT
FOR i = 1 TO np
p$(i) = p$(i) + SPACE$(l2 - LEN(p$(i)))
NEXT

'données
souris = 0
ll = 13: v = 6: v_mini = v
r = 1: rr = 0
paire = 1
longueur = LEN(p$(1))

IF np <= ll THEN
h = 33: h1 = h: h2 = 0: h3 = 0
colonnes = 1
ll_dernier = np
ELSEIF np <= 2 * ll THEN
h = 17: h1 = h: h2 = 45: h3 = 0
ll = INT(np / 2)
IF np / 2 <> INT(np / 2) THEN paire = 0: ll = ll + 1
colonnes = 2
ll_dernier = np - ll
ELSE
h = 5: h1 = h: h2 = 33: h3 = 61
ll = INT(np / 3)
IF np / 3 <> INT(np / 3) THEN paire = 0: ll = ll + 1
colonnes = 3
ll_dernier = np - (2 * ll)
END IF

SELECT CASE colonnes
CASE 1
CALL cadre(v - 1, h1 - 2, longueur + 4, np + 2, rouge)
COLOR , rouge
LOCATE v
FOR i = 1 TO np: LOCATE , h1: PRINT p$(i): NEXT

CASE 2
CALL cadre(v - 1, h1 - 2, h2 - h1 + longueur + 4, ll + 2, rouge)
COLOR , rouge
LOCATE v
FOR i = 1 TO ll: LOCATE , h1: PRINT p$(i): NEXT
LOCATE v
FOR i = ll + 1 TO np: LOCATE , h2: PRINT p$(i): NEXT

CASE 3
z = h3 - h1 + longueur + 4
IF z + h1 >= 80 THEN z = 80 - h1
CALL cadre(v - 1, h1 - 2, z, ll + 2, rouge)
COLOR , rouge
LOCATE v
FOR i = 1 TO ll: LOCATE , h1: PRINT p$(i): NEXT
LOCATE v
FOR i = ll + 1 TO 2 * ll: LOCATE , h2: PRINT p$(i): NEXT
LOCATE v
FOR i = (2 * ll) + 1 TO np: LOCATE , h3: PRINT p$(i): NEXT
END SELECT

'fleches
COLOR blanc, noir
LOCATE 23, 5: IF colonnes = 1 THEN PRINT gg$ ELSE PRINT gg2$

IF couleur = 0 THEN COLOR noir, blanc ELSE COLOR rouge, blanc
LOCATE v, h - 1
PRINT " "; p$(1); " "
COLOR blancbrill, rouge

DO
DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE 1050, PEEK(1052)
DEF SEG

DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
IF v_mouse = 23 THEN
IF h_mouse >= 66 AND h_mouse <= 76 THEN
r$ = CHR$(27)
souris = 0
CALL attendre(.3)
EXIT DO

ELSEIF h_mouse = 5 THEN
'fleche haut
rr = 72
CALL attendre(.3)
souris = 1
EXIT DO
ELSEIF h_mouse = 7 THEN
'fleche bas
rr = 80
CALL attendre(.3)
souris = 1
EXIT DO
ELSEIF h_mouse = 9 AND (colonnes = 2 OR colonnes = 3) THEN
'fleche gauche
rr = 75
CALL attendre(.3)
souris = 1
EXIT DO
ELSEIF h_mouse = 11 AND (colonnes = 2 OR colonnes = 3) THEN
'fleche droite
rr = 77
CALL attendre(.3)
souris = 1
EXIT DO
ELSEIF h_mouse >= 14 AND h_mouse <= 16 AND colonnes = 1 THEN
'entree
r$ = CHR$(13)
CALL attendre(.3)
souris = 0
EXIT DO
ELSEIF h_mouse >= 18 AND h_mouse <= 20 AND (colonnes = 2 OR colonnes = 3) THEN
'entree
r$ = CHR$(13)
CALL attendre(.3)
souris = 0
EXIT DO
END IF
END IF

IF v_mouse >= v_mini AND v_mouse <= v_mini + ll - 1 THEN

SELECT CASE colonnes
CASE 1
IF h_mouse >= h1 AND h_mouse <= h1 + longueur THEN
LOCATE v_mini
FOR i = 1 TO np
LOCATE , h1 - 1: PRINT " "; p$(i); " "
NEXT
calcul = v_mouse - v_mini + 1
LOCATE v_mouse, h1 - 1
IF couleur = 0 THEN COLOR noir, blanc ELSE COLOR rouge, blanc
PRINT " "; p$(calcul); " "
CALL attendre(.5)
r = calcul
EXIT SUB
END IF

CASE 2
IF (h_mouse >= h1 AND h_mouse <= h1 + longueur) OR (h_mouse >= h2 AND h_mouse <= h2 + longueur) THEN
IF v_mouse = v_mini + ll - 1 AND (h_mouse >= h2 AND h_mouse <= h2 + longueur) AND paire = 0 THEN
BEEP
ELSE
LOCATE v_mini
FOR i = 1 TO ll
LOCATE , h1 - 1: PRINT " "; p$(i); " "
NEXT
LOCATE v_mini
FOR i = ll + 1 TO np
LOCATE , h2 - 1: PRINT " "; p$(i); " "
NEXT
IF h_mouse < h2 THEN
calcul = v_mouse - v_mini + 1
LOCATE v_mouse, h1 - 1
ELSE
calcul = (v_mouse + ll) - v_mini + 1
LOCATE v_mouse, h2 - 1
END IF
IF couleur = 0 THEN COLOR noir, blanc ELSE COLOR rouge, blanc
PRINT " "; p$(calcul); " "
CALL attendre(.5)
r = calcul
EXIT SUB
END IF
END IF

CASE 3
IF (h_mouse >= h1 AND h_mouse <= h1 + longueur) OR (h_mouse >= h2 AND h_mouse <= h2 + longueur) OR (h_mouse >= h3 AND h_mouse <= h3 + longueur) THEN
IF v_mouse = v_mini + ll - 1 AND (h_mouse >= h3 AND h_mouse <= h3 + longueur) AND paire = 0 THEN
BEEP
ELSE
LOCATE v_mini
FOR i = 1 TO ll
LOCATE , h1 - 1: PRINT " "; p$(i); " "
NEXT
LOCATE v_mini
FOR i = ll + 1 TO ll * 2
LOCATE , h2 - 1: PRINT " "; p$(i); " "
NEXT
LOCATE v_mini
FOR i = (ll * 2) + 1 TO np
LOCATE , h3 - 1: PRINT " "; p$(i); " "
NEXT
IF h_mouse < h2 THEN
calcul = v_mouse - v_mini + 1
LOCATE v_mouse, h1 - 1
ELSEIF h_mouse < h3 THEN
calcul = (v_mouse + ll) - v_mini + 1
LOCATE v_mouse, h2 - 1
ELSE
calcul = (v_mouse + (2 * ll)) - v_mini + 1
LOCATE v_mouse, h3 - 1
END IF
IF couleur = 0 THEN COLOR noir, blanc ELSE COLOR rouge, blanc
PRINT " "; p$(calcul); " "
CALL attendre(.5)
r = calcul
EXIT SUB
END IF
END IF

END SELECT

ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""

IF souris = 0 AND LEN(r$) < 2 THEN
rr = ASC(r$)
ELSEIF souris = 0 THEN
rr = ASC(RIGHT$(r$, 1))
END IF

SELECT CASE rr
CASE 27
r = 0: EXIT SUB
CASE 42, 36, 56, 230, 43
IF flag = 2 THEN r = 42: EXIT SUB
END SELECT

LOCATE v, h - 1
PRINT " "; p$(r); " "
GOSUB chedi
LOCATE v, h - 1
IF couleur = 0 THEN COLOR noir, blanc ELSE COLOR rouge, blanc
PRINT " "; p$(r); " "
COLOR blancbrill, rouge
LOOP WHILE rr <> 13
EXIT SUB

chedi:
IF colonnes = 1 THEN
GOTO chedi1
ELSEIF colonnes = 2 THEN
IF rr = 75 THEN r = r - ll: h = h1: GOTO chedi2 'gauche
IF rr = 77 THEN r = r + ll: h = h2: GOTO chedi2 'droite
ELSEIF colonnes = 3 THEN
IF rr = 75 THEN r = r - ll: h = h - 28: GOTO chedi2 'gauche
IF rr = 77 THEN r = r + ll: h = h + 28: GOTO chedi2 'droite
END IF
chedi1:
IF rr = 72 THEN v = v - 1: r = r - 1 'haut
IF rr = 80 THEN v = v + 1: r = r + 1 'bas
chedi2:
IF r = ll + 1 THEN v = v_mini: h = h2
IF r = ll THEN v = ll + (v_mini - 1): h = h1
IF r = 2 * ll + 1 THEN v = v_mini: h = h3
IF r = 2 * ll THEN v = ll + (v_mini - 1): h = h2
IF r > np THEN r = 1: v = v_mini: h = h1
IF r >= 1 THEN RETURN
r = np
IF np <= ll THEN v = (v_mini - 1) + np: RETURN
IF np <= 2 * ll THEN v = (v_mini - 1) + np - ll: h = h2: RETURN
v = (v_mini - 1 + np) - 2 * ll: h = h3
RETURN

END SUB

DEFINT A-Z
SUB importlect (gg$, gg2$, rt$, VarEnreg AS TypeEnreg, nf, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%, cyanclair%, rougeclair%, jaune%, blancbrill%, couleur)

DIM n$(nf, 2), r%(nf), m$(nf)
DIM nom$(39), pre$(39), nbexo$(39), notes$(39), Divers$(39)
DIM p$(3), n2$(nf, 2), r2%(nf), ne(nf), ne2$(nf), no2$(nf), m2$(nf), di$(nf)
fichierdisque$ = "import.dat"
'remarque ne() ne sert pas, c'est juste pour le tri
nombre = 0: nombre2 = 0: ok = 0

CALL titre("Importer/Exporter un élève")
CALL cadre(4, 3, 74, 16, marron)
LOCATE , , 0
COLOR , blanc
CALL centre(6, noir, " Utilisation dans une salle informatique avec plusieurs ordinateurs. ")
COLOR , marron
CALL centre(9, blancbrill, "Ce module permet d'exporter ou d'importer des élèves et leurs notes.")
CALL centre(11, blancbrill, "Il suffit d'introduire une disquette formatée dans le lecteur A:")
CALL centre(13, blancbrill, "On exporte en sélectionnant le ou les élèves.")
CALL centre(15, blancbrill, "On les efface de ce fichier si on le désire.")
CALL centre(17, blancbrill, "Puis on introduit la disquette sur un autre ordinateur et on importe.")
CALL entree_echap(r)

CALL titre("Importer/Exporter un élève")

CALL centre(8, vertclair, "Votre choix :")
p$(2) = "Importation d'un élève": p$(1) = "Exportation d'un élève": p$(3) = "Fin"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(11, 30, p$(), 3, reponse, 1, 23, 35)

IF reponse = 0 OR reponse = 3 THEN CLOSE : EXIT SUB

'lecteur
CALL titre("Lecteur de disquette")
CALL cadre(8, 10, 60, 7, marron)
COLOR , marron
IF reponse = 1 THEN
CALL centre(10, blancbrill, "Introduisez une disquette formatée")
ELSE
CALL centre(10, blancbrill, "Introduisez une disquette avec les élèves à importer")
END IF
CALL centre(12, blancbrill, "dans le lecteur A:")

CALL entree_echap(w)
IF w = 27 THEN COLOR , bleu: CLS : RUN "menu"

lecteur$ = "A:"

'test si fichier existe sur le disque
OPEN lecteur$ + fichierdisque$ FOR RANDOM AS #2 LEN = LEN(VarEnreg)
GET #2, 1, VarEnreg 'nombre de noms
nombre2 = VAL(VarEnreg.nom)
CLOSE #2
ok = 0
IF nombre2 > 0 THEN ok = 1

IF nombre2 = 0 AND reponse = 2 THEN
BEEP: COLOR blanc, noir
LOCATE 22, 2: PRINT "Il n'y a pas de noms sur la disquette."
LOCATE 23, 2: PRINT "Vous devez exporter à partir d'un autre ordinateur avant d'importer."
CALL getinvimouse(r)
CLOSE
EXIT SUB
END IF

IF ok = 1 AND reponse = 1 THEN
CALL titre("Exporter un élève")
BEEP
CALL centre(6, vertclair, "Il existe déjà un fichier contenant")
CALL centre(7, vertclair, "des noms sur la disquette.")

p$(1) = "Ajouter les élèves aux anciens"
p$(2) = "Créer un nouveau fichier"
p$(3) = "Fin"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(11, 24, p$(), 3, r, 1, 23, 35): COLOR , noir
IF r = 0 OR r = 3 THEN EXIT SUB

ajouter = 0
IF r = 1 THEN
ajouter = 1
END IF
END IF


SELECT CASE reponse

'+++++++++++++++++++++++++++++++++
CASE 1
'Exportation
import1:
CALL titre("choix de l'eleve a exporter")
GOSUB lectureclasse

flagtri = 2: CALL tri(nf2, n$(), r%())
FOR i = 1 TO nf2: m$(i) = n$(r%(i), 1): NEXT

import4:
CALL titre("Exportation d'un élève")
COLOR , noir
LOCATE 23: PRINT SPACE$(80): PRINT SPACE$(80)
LOCATE 23, 66: COLOR blanc: PRINT es$
IF nf2 < 40 THEN
CALL fleches3(r, nf2, m$(), 1, gg$, gg2$, blancbrill, blanc, noir, rouge, couleur)
COLOR , noir
IF r = 0 AND nombre = 0 THEN
CLOSE
EXIT SUB
ELSEIF r = 0 AND nombre > 0 THEN
GOTO import2
END IF
eleve = r%(r)
ELSE
CALL centre(23, blanc, "Tapez le nom de l'élève à exporter")
CALL saisienom2(n$, 20, m$(), r%(), nf2)
IF ASC(n$) = 27 THEN COLOR , bleu: CLS : RUN "menu"'===
FOR i = 1 TO nf2
IF n$ = n$(i, 1) THEN
eleve = i
CALL titre("Exporter un élève")
CALL cadre(6, 20, 40, 5, blanc)
COLOR , blanc
CALL centre(8, noir, n$(eleve, 2) + " " + n$(eleve, 1))
COLOR , bleu
CALL centre(12, jaune, "Voulez-vous exporter ce nom ?")

p$(1) = "oui"
p$(2) = "non"
COLOR blanc, noir
CALL centre(23, blanc, gg$)
CALL fleches(16, 38, p$(), 2, r, 1, 23, 35)

SELECT CASE r
CASE 0
RUN "menu" '===
CASE 1
f = 1
EXIT FOR
CASE 2
f = 0
END SELECT
END IF
NEXT i
IF eleve = 0 THEN
LOCATE 23, 1: PRINT SPACE$(80)
BEEP
CALL centre(23, rougeclair, "Nom absent du fichier")
CALL getinvimouse(w)
f = 0
END IF

IF f = 0 THEN GOTO import4 '===

END IF


IF ajouter = 0 THEN
IF nombre > 38 THEN
BEEP: COLOR , noir
LOCATE 23, 2: PRINT "Maximum : 39 élèves dans le fichier d'exportation."
CALL entree(r)
GOTO import6
END IF
ELSE
IF nombre + nombre2 > 38 THEN
BEEP: COLOR , noir
LOCATE 23, 2: PRINT "Maximum : 39 élèves dans le fichier d'exportation."
CALL entree(r)
GOTO import6
END IF
END IF

nombre = nombre + 1

'lecture élève dans fichier.dat
GET #1, eleve + 1, VarEnreg
nom$(nombre) = RTRIM$(VarEnreg.nom)
pre$(nombre) = RTRIM$(VarEnreg.prenom)
nbexo$(nombre) = VarEnreg.nbexo
Divers$(nombre) = VarEnreg.Divers
notes$(nombre) = VarEnreg.notes

'tester si l'élève n'a pas déjà été choisi
flag = 0
FOR i = 1 TO nombre - 1
IF nom$(i) = nom$(nombre) AND pre$(i) = pre$(nombre) THEN flag = 2: EXIT FOR
NEXT
IF flag = 2 THEN
LOCATE 23, 1: PRINT SPACE$(80)
LOCATE 23, 2: BEEP: COLOR , noir
PRINT nom$(nombre); " "; pre$(nombre); " a déjà été choisi(e)."
CALL getinvimouse(r)
nombre = nombre - 1
GOTO import4
END IF

'on efface l'élève ?

COLOR 15, noir: LOCATE 23, 2: PRINT "Effacer "; nom$(nombre); " "; pre$(nombre); " de cet ordinateur ? ";
CALL ouinon(r$, blanc%, jaune%)

IF r$ = "O" THEN
GET #1, 1, VarEnreg
nf2 = VAL(VarEnreg.nom) - 1
VarEnreg.nom = RTRIM$(STR$(nf2))
PUT #1, 1, VarEnreg

IF eleve <> nf2 THEN
FOR i = eleve TO nf2
GET #1, i + 2, VarEnreg
PUT #1, i + 1, VarEnreg
NEXT
END IF
END IF

IF nf2 = 0 THEN
LOCATE 23, 1: PRINT SPACE$(80)
BEEP: LOCATE 23, 2: PRINT "Le fichier est vide."
CALL entree(r)
GOTO import6
END IF

'un autre ?
import2:
COLOR jaune: LOCATE 22, 2
IF nombre = 1 THEN
PRINT "Elève sélectionné :"; nombre
ELSE
PRINT "Elèves sélectionnés :"; nombre
END IF

LOCATE 23, 1: PRINT SPACE$(80)
COLOR 15, noir: LOCATE 23, 2: PRINT "Exporter un autre élève ? ";
CALL ouinon(r$, blanc%, jaune%)

IF r$ = "O" THEN
LOCATE 23, 1: PRINT SPACE$(80)
GOTO import1
END IF

'écriture sur la disquette : nombre,élèves+notes
import6:
LOCATE 23, 2
IF nombre = 1 THEN
PRINT "Ecriture de l'élève sélectionné sur la disquette."
ELSE
PRINT "Ecriture des"; nombre; "élèves sélectionnés sur la disquette."
END IF
CALL attendre(1)
CLOSE
OPEN lecteur$ + fichierdisque$ FOR RANDOM AS #2 LEN = LEN(VarEnreg)

IF ajouter = 0 THEN
VarEnreg.nom = LTRIM$(STR$(nombre))
ELSE
VarEnreg.nom = LTRIM$(STR$(nombre + nombre2))
END IF
PUT #2, 1, VarEnreg 'nombre d'élèves dans enregistrement 1

FOR j = 1 TO nombre
LOCATE 23: PRINT SPACE$(80)
LOCATE 23, 2: PRINT "Ecriture de "; nom$(j); " "; pre$(j)
VarEnreg.nom = nom$(j)
VarEnreg.prenom = pre$(j)
VarEnreg.nbexo = nbexo$(j)
VarEnreg.Divers = Divers$(j)
VarEnreg.notes = notes$(j)

IF ajouter = 0 THEN
PUT #2, j + 1, VarEnreg
ELSE
PUT #2, j + 1 + nombre2, VarEnreg
END IF
CALL attendre(.7)
NEXT
CLOSE #2
COLOR blanc
LOCATE 22: PRINT SPACE$(80)
LOCATE 22, 2: PRINT "Exportation terminée."
LOCATE 23, 2: PRINT "Vous pouvez retirer la disquette et importer sur un autre ordinateur."
CALL getinvimouse(w)

'++++++++++++++++++++++++++
CASE 2
'importation
GOSUB lecturedisque

flagtri = 2: CALL tri(nombre, n2$(), r2%()) 'ne() ne sert pas
FOR i = 1 TO nombre: m2$(i) = n2$(r2%(i), 1): NEXT

CALL titre("Choix de l'élève à importer")

import10:
COLOR , noir
LOCATE 22: PRINT SPACE$(80): PRINT SPACE$(80)
CLOSE #1
GOSUB lectureclasse

COLOR blanc, noir: LOCATE 23: PRINT SPACE$(80)
LOCATE 23, 66: PRINT es$
CALL fleches3(choix, nombre, m2$(), 1, gg$, gg2$, blancbrill, blanc, noir, rouge, couleur)
COLOR , noir
eleve = r2%(choix)

'tester si l'élève n'est pas déjà inscrit
flag = 0
FOR jj = 1 TO nf2
IF n$(jj, 1) = n2$(eleve, 1) AND n$(jj, 2) = n2$(eleve, 2) THEN flag = 2: EXIT FOR
NEXT
IF flag = 2 THEN
BEEP
LOCATE 22, 2: COLOR blanc, noir: PRINT n2$(eleve, 1); " "; n2$(eleve, 2); " est déjà inscrit dans la classe "; classe2$
LOCATE 23, 2: PRINT "On le remplace par le nouveau ? ";
CALL ouinon(r$, blanc%, jaune%)

IF r$ = "N" THEN
GOTO import10
ELSE
'remplacer
VarEnreg.nom = n2$(eleve, 1)
VarEnreg.prenom = n2$(eleve, 2)
VarEnreg.nbexo = ne2$(eleve)
VarEnreg.Divers = di$(eleve)
VarEnreg.notes = no2$(eleve)

PUT #1, jj + 1, VarEnreg
LOCATE 23, 1: PRINT SPACE$(80): PRINT SPACE$(80)
LOCATE 23, 2: PRINT "Ecriture de "; n2$(eleve, 1); " "; n2$(eleve, 2)
CALL attendre(.7)
GOTO import10
END IF
END IF

'écrire le nouvel élève
IF n2$(eleve, 1) = "" THEN CLOSE : EXIT SUB

IF nf2 >= 200 THEN
CALL titre("Importer un élève")
BEEP
CALL cadre(9, 10, 60, 7, rouge)
COLOR , rouge
CALL centre(11, blancbrill, "Le fichier est limité à 200 élèves.")
CALL centre(13, blancbrill, "Vous devez effacer des élèves avant d'importer.")
CALL entree(w)
CLOSE : EXIT SUB
END IF

nf2 = nf2 + 1
VarEnreg.nom = LTRIM$(STR$(nf2))
PUT #1, 1, VarEnreg

VarEnreg.nom = n2$(eleve, 1)
VarEnreg.prenom = n2$(eleve, 2)
VarEnreg.nbexo = ne2$(eleve)
VarEnreg.Divers = di$(eleve)
VarEnreg.notes = no2$(eleve)
PUT #1, nf2 + 1, VarEnreg'===

LOCATE 23, 1: PRINT SPACE$(80): PRINT SPACE$(80)
LOCATE 23, 2: PRINT "Ecriture de "; n2$(eleve, 1); " "; n2$(eleve, 2)
CALL attendre(.7)

LOCATE 23, 1: PRINT SPACE$(80)
COLOR 15, noir: LOCATE 23, 2: PRINT "Importer un autre élève ? ";
CALL ouinon(r$, blanc%, jaune%)

IF r$ = "O" THEN
LOCATE 23, 1: PRINT SPACE$(80)
GOTO import10
END IF

END SELECT
CLOSE

EXIT SUB

'+++++++++++++++++++++++++++++++++


lecturedisque:
OPEN lecteur$ + fichierdisque$ FOR RANDOM AS #2 LEN = LEN(VarEnreg)

GET #2, 1, VarEnreg
nombre = VAL(VarEnreg.nom)
FOR i = 1 TO nombre
GET #2, i + 1, VarEnreg
n2$(i, 1) = RTRIM$(VarEnreg.nom)
n2$(i, 2) = RTRIM$(VarEnreg.prenom)
ne2$(i) = VarEnreg.nbexo
di$(i) = VarEnreg.Divers
no2$(i) = VarEnreg.notes
r2%(i) = i
NEXT i
CLOSE #2
RETURN

lectureclasse:
CLOSE
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, 1, VarEnreg
nf2 = VAL(VarEnreg.nom)
FOR i = 1 TO nf2
GET #1, i + 1, VarEnreg
n$(i, 1) = RTRIM$(VarEnreg.nom)
n$(i, 2) = RTRIM$(VarEnreg.prenom)
r%(i) = i
NEXT
RETURN
END SUB

DEFINT A-Z
SUB lecdir (cla$(), ncl, dire$, s$)
DIM ligne$(150), pointeur(5), mot$(5)
'6/5/95
SHELL "DIR " + dire$ + " > catalog.dat"
OPEN "catalog.dat" FOR INPUT AS #1
i = 1
DO UNTIL EOF(1)
INPUT #1, ligne$(i)
i = i + 1
LOOP
CLOSE

nl = i - 1

ncl = 0
FOR i = 1 TO nl
ligne$(i) = LTRIM$(ligne$(i))
ligne$(i) = UCASE$(RTRIM$(ligne$(i)))
NEXT

ff = 0: f2 = 0
FOR i = 1 TO nl
'on cherche les <ctrl I> dans la ligne
l = LEN(ligne$(i))
FOR kk = 1 TO l
IF ASC(MID$(ligne$(i), kk, 1)) = 9 THEN
'dos 5 et +
IF MID$(ligne$(i), 1, 3) = "[.]" AND MID$(ligne$(i), kk + 1, 4) = "[..]" THEN
ff = 1: f2 = 1
EXIT FOR
END IF
'dos 3.3
IF MID$(ligne$(i), 1, 1) = "." AND MID$(ligne$(i), kk + 1, 2) = ".." THEN
ff = 1: f2 = 2
EXIT FOR
END IF
END IF
NEXT kk
IF ff = 1 THEN EXIT FOR
NEXT i

IF ff = 0 THEN
'directory en liste
FOR i = 1 TO nl
ligne$(i) = RTRIM$(MID$(ligne$(i), 1, 14))
IF RIGHT$(ligne$(i), 3) = s$ THEN
s = INSTR(ligne$(i), ".")
IF s > 1 THEN
ncl = ncl + 1: cla$(ncl) = MID$(ligne$(i), 1, s - 1)
ELSE
ncl = ncl + 1: cla$(ncl) = RTRIM$(MID$(ligne$(i), 1, 8))
END IF
END IF

IF ncl = 39 THEN EXIT FOR
NEXT i

ELSE
'dir /w
FOR ii = 1 TO nl
'on cherche les <ctrl I> dans la ligne
l = LEN(ligne$(ii))
jj = 1: flag = 0
FOR kk = 1 TO l
IF ASC(MID$(ligne$(ii), kk, 1)) = 9 THEN
jj = jj + 1: flag = 1
pointeur(jj) = kk + 1
pointeur = ii
END IF
NEXT

's'il y a des ctrl I on affecte les mots
IF flag = 1 THEN
mot$(1) = MID$(ligne$(ii), 1, 12)
FOR kk = 2 TO jj
mot$(kk) = MID$(ligne$(ii), pointeur(kk), 12)
NEXT kk
'on cherche les classes
IF f2 = 1 THEN
'dos 5 et +
FOR j = 1 TO jj
s = INSTR(mot$(j), ".")
IF MID$(mot$(j), s + 1, 3) = s$ THEN
ncl = ncl + 1: cla$(ncl) = MID$(mot$(j), 1, s - 1)
END IF
NEXT j

ELSEIF f2 = 2 THEN
'dos 3.3
FOR j = 1 TO jj
s = INSTR(9, mot$(j), s$)
IF s > 8 AND s < 15 THEN
ncl = ncl + 1: cla$(ncl) = RTRIM$(MID$(mot$(j), 1, 8))
END IF
NEXT j
END IF

'si c'est la ligne suivante avec un seul mot on l'affecte
ELSEIF ii = pointeur + 1 THEN
mot$(1) = MID$(ligne$(ii), 1, 12)
s = INSTR(mot$(1), ".")
IF MID$(mot$(1), s + 1, 3) = s$ THEN
ncl = ncl + 1: cla$(ncl) = MID$(mot$(1), 1, s - 1)
END IF
END IF
IF ncl = 39 THEN EXIT FOR
NEXT ii


END IF

KILL "catalog.dat"

END SUB

DEFINT A-Z
SUB ouinon (r$, blanc%, jaune%)
h = POS(0)
v = CSRLIN

LOCATE v, h
COLOR blanc: PRINT "["; : COLOR jaune: PRINT "O"; : COLOR blanc: PRINT "]ui ou ["; : COLOR jaune: PRINT "N"; : COLOR blanc: PRINT "]on"
DO
r$ = ""
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
IF v_mouse = v AND (h_mouse >= h AND h_mouse <= h + 5) THEN
r$ = "o"
CALL attendre(.3)
ELSEIF v_mouse = v AND (h_mouse >= h + 10 AND h_mouse <= h + 14) THEN
r$ = "n"
CALL attendre(.3)
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""

r$ = UCASE$(r$)
LOOP UNTIL r$ = "O" OR r$ = "N"
END SUB

DEFINT A-Z
SUB testespace (z$)
'on vérifie qu'il n'y a pas deux espaces ou plus
l = 1
DO
GOSUB espace
LOOP WHILE z <> 0
EXIT SUB

espace:
z = INSTR(l, z$, " ")

IF z = LEN(z$) THEN RETURN
IF ASC(MID$(z$, z + 1, 1)) = 32 THEN
z$ = MID$(z$, 1, z) + MID$(z$, z + 2)
RETURN
END IF
l = z + 1
RETURN

END SUB

DEFINT A-Z
SUB testtiret (z$)
'on remplace " - " ou "- " ou " -" par "-"
l = 1
DO
GOSUB test1
LOOP WHILE z <> 0
EXIT SUB


test1:
z = INSTR(l, z$, " - ")
IF z <> 0 THEN
z$ = MID$(z$, 1, z - 1) + "-" + MID$(z$, z + 3)
END IF

z = INSTR(l, z$, " -")
IF z <> 0 THEN
z$ = MID$(z$, 1, z - 1) + MID$(z$, z + 1)
END IF

z = INSTR(l, z$, "- ")
IF z <> 0 THEN
z$ = MID$(z$, 1, z) + MID$(z$, z + 2)
END IF

l = z + 1
RETURN
END SUB
 

 

Précédente Accueil Remonter Suivante