|
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%, h3%)
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%(), niveauxmath3%(),
niveauxlecture%(), niveauxgeometrie%(), francais1$(), francais2$(),
math1$(), math3$(), geometrie$(), lecture$(), VarEnreg AS ANY)
DECLARE SUB bilanmath3 (r%(), eleve%, VarEnreg AS ANY,
niveauxmath3%(), math3$())
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), math3$(21), francais1$(21), francais2$(21),
lecture$(11), geometrie$(21)
DIM niveauxmath1(21), niveauxmath3(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(), niveauxmath3(), niveauxlecture(), niveauxgeometrie(),
francais1$(), francais2$(), math1$(), math3$(), 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 math3$(i), niveauxmath3(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 bilanmath3 (r%(), eleve, VarEnreg AS TypeEnreg, niveauxmath3(),
math3$())
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$(), niveauxmath3())
'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 math3$(i); " "; LEFT$(ll$, 20 - LEN(math3$(i)))
NEXT
LOCATE 8
FOR i = 12 TO ma
LOCATE , 43: PRINT math3$(i); " "; LEFT$(ll$, 20 - LEN(math3$(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 + (niveauxmath3(valeur) - 1)
h = 24: GOSUB place
debut = fin + 1: v = v + 1
NEXT
v = 8
FOR valeur = 12 TO ma
fin = debut + (niveauxmath3(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(), niveauxmath3(), niveauxlecture(),
niveauxgeometrie(), francais1$(), francais2$(), math1$(), math3$(),
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 bilanmath3(r%(), eleve, VarEnreg, niveauxmath3(), math3$())
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, h3)
'PRINT v2, h3
'v2 et h3 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 = h3 THEN
rr = 72 'fleche haut
souris = 1
CALL attendre(.2)
EXIT DO
ELSEIF v_mouse = v2 AND h_mouse = h3 + 2 THEN
rr = 80 'fleche bas
souris = 1
CALL attendre(.2)
EXIT DO
ELSEIF v_mouse = v2 AND (h_mouse >= h3 + 9 AND h_mouse <= h3 + 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
h3 = h
f = 0 'recouvrement
ple1:
IF NOT f THEN LOCATE v, h, 1, 0, 7 ELSE LOCATE v, h, 1, 7
IF h < h3 THEN h = h3
IF h > np + h3 THEN h = np + h3
IF h - h3 > LEN(r$) THEN h = LEN(r$) + h3
LOCATE v, h3, 0: PRINT SPACE$(np + 1)
LOCATE v, h3: PRINT r$
lc = h - (h3 - 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 + h3 THEN h = np + h3
GOTO ple1
END IF
IF r2 = 8 THEN 'delete
IF h <> h3 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 = h3 'home
CASE 79
h = np + h3 '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
|
