Précédente Accueil Remonter Suivante

GESTION TEXTES

Visual Basic for MS-DOS

 

DECLARE SUB affiche (s$, w$)
DECLARE SUB afformate (nm%, m$(), erreur%)
DECLARE SUB ajoutertexte (nbtextes%, titre$(), m$(), parag$(), nbparag%(), pp$())
DECLARE SUB attendre (tx!)
DECLARE SUB cadre (v%, h%, l%, nli%, c%)
DECLARE SUB centre (v%, coul%, ph$)
DECLARE SUB choixtexte (nbtextes%, titre$(), nbparag%(), pp$(), parag$())
DECLARE SUB efface (v%, hk%)
DECLARE SUB effacer (nbtextes%, titre$(), m$(), parag$(), nbparag%(), pp$())
DECLARE SUB enregistrer (nbtextes%, titre$(), nbparag%(), parag$())
DECLARE SUB entree (rr%, y%, z%)
DECLARE SUB entree_echap (rr%)
DECLARE SUB epuration (mo$)
DECLARE SUB exporter (texte$, nbtextes%, titre$(), parag$(), nbparag%())
DECLARE SUB fleches (v%, h%, w$(), np%, r%, coul%, drap%, v2%, h2%)
DECLARE SUB getinvi (r%, r$)
DECLARE SUB impression (parag$(), nbparag%(), t%)
DECLARE SUB imprime2 (s$, w$)
DECLARE SUB imprimer (nbtextes%, titre$(), parag$(), nbparag%(), pp$())
DECLARE SUB inputline (r$, nl%)
DECLARE SUB inserer (nbtextes%, titre$(), m$(), parag$(), nbparag%(), pp$())
DECLARE SUB lire (nbtextes%, titre$(), parag$(), nbparag%(), s$(), s%(), m$(), te$(), r%(), pp$())
DECLARE SUB listeecran (nbtextes%, titre$(), nbparag%(), parag$(), m$(), t%)
DECLARE SUB modifier (nbtextes%, titre$(), m$(), parag$(), nbparag%(), pp$())
DECLARE SUB ouinon (r$)
DECLARE SUB pleinecran (r$, l$, m$, v1%, v2%)
DECLARE SUB pleineligne (r$, m$, np%, v%, h%)
DECLARE SUB recupere (m$, v1%, v2%)
DECLARE SUB titr (w$)
DECLARE SUB titr2 (w$)
DECLARE SUB titrnb (tit$)
DECLARE SUB transforme (m$)
DECLARE SUB trouvemot (m$, m$(), nm%)
'Gestion textes  LECTURE souris
'Clerc Daniel 18/12/2001
'version 1.4.3

DEFINT A-Z

COMMON SHARED es$, lecture$, tit$, gg$, fle$, fe$, 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'


SCREEN 9
SCREEN 0

CONST FALSE = 0
CONST TRUE = NOT FALSE

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

ON ERROR GOTO corrigeerreur '===

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

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

LOCATE , , 0: COLOR , noir: CLS

texte$ = "EXPORT.TXT"

DIM m$(250), nbparag(10), parag$(10, 5), p$(11), pp$(11), titre$(11), s$(3000), s%(3000), te$(3000), r%(3000)

DATA Visualiser,Ajouter,Modifier,Insérer,Effacer,Imprimer,Exporter,Fin
FOR i = 1 TO 8: READ p$(i): NEXT
Fh$ = CHR$(24): Fb$ = CHR$(25)
FG$ = CHR$(27): FD$ = CHR$(26)
rt$ = CHR$(17) + CHR$(196) + CHR$(217)
fle$ = Fh$ + " " + Fb$ + " " + FG$ + " " + FD$
gg$ = Fh$ + " " + Fb$ + " puis " + rt$
es$ = "[Echap]=Fin"
fe$ = gg$ + SPACE$(13) + es$


'lecture
OPEN lecture$ FOR INPUT AS #1
'nbtextes
INPUT #1, nbtextes
IF nbtextes = 0 THEN
CLOSE
tit$ = "Ajouter"
DO
CALL ajoutertexte(nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
LOOP WHILE nbtextes = 0
CALL enregistrer(nbtextes, titre$(), nbparag(), parag$())
RUN
END IF

'titres
FOR i = 1 TO nbtextes
LINE INPUT #1, titre$(i)
NEXT
'nbparag
FOR i = 1 TO nbtextes
INPUT #1, nbparag(i)
NEXT
'paragraphe$
FOR i = 1 TO nbtextes
FOR j = 1 TO nbparag(i)
LINE INPUT #1, parag$(i, j)
parag$(i, j) = parag$(i, j) + " "
NEXT j
NEXT i

CLOSE

'+++++++++++++++++
'menu principal
DO
COLOR , bleu: CLS

DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE &H417, (PEEK(&H417) AND &HBF) 'minuscules
DEF SEG
SELECT CASE nbtextes
CASE 10, 9
v = 8
CASE 8, 7, 6
v = 9
CASE ELSE
v = 10
END SELECT

CALL cadre(v, 10, 60, nbtextes + 2, vert)
COLOR blancbrill, vert
LOCATE v + 1
FOR j = 1 TO nbtextes
LOCATE , 15: PRINT titre$(j);
LOCATE , 38 - LEN(STR$(nbparag(j)))
PRINT "("; MID$(STR$(nbparag(j)), 2); " parag.)"
NEXT

COLOR blanc, bleu
LOCATE v - 1, 15
IF LCASE$(lecture$) = "fichier1.txt" THEN PRINT "Niveau I" ELSE PRINT "Niveau II"
'===
LOCATE 7, 49: COLOR jaune: PRINT "GESTION DES TEXTES"
CALL cadre(8, 50, 14, 12, rouge)
COLOR blanc, bleu
LOCATE 20, 53: PRINT gg$

FOR i = 1 TO 8: pp$(i) = p$(i): NEXT

DO
CALL fleches(10, 53, pp$(), 8, r, rouge, 0, 20, 53)
LOOP WHILE r = 27
tit$ = p$(r)

SELECT CASE r
CASE 1
CALL lire(nbtextes, titre$(), parag$(), nbparag(), s$(), s%(), m$(), te$(), r%(), pp$())
CASE 2
CALL ajoutertexte(nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
CASE 3
CALL modifier(nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
CASE 4
CALL inserer(nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
CASE 5
CALL effacer(nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
CASE 6
CALL imprimer(nbtextes, titre$(), parag$(), nbparag(), pp$())
CASE 7
CALL exporter(texte$, nbtextes, titre$(), parag$(), nbparag())
CASE 8
CALL enregistrer(nbtextes, titre$(), nbparag(), parag$())
COLOR , noir: CLS
RUN "menu"
END
END SELECT
LOOP
'++++++++++++++++

corrigeerreur:
programme$ = "gestion"
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 getinvi(r, r$)
IF r = 27 THEN COLOR , noir: CLS : END
COLOR , bleu: CLS : RUN programme$
RESUME


DEFINT A-Z
SUB affiche (s$, w$)
w$ = (".(" + w$ + ")")
l1 = LEN(w$)
l2 = LEN(s$) + l1
IF l2 > 14 THEN
ss$ = MID$(s$, 1, 14 - l1)
ELSEIF l2 < 14 THEN
ss$ = s$ + MID$(STRING$(15, "."), 1, 14 - (LEN(s$) + l1))
ELSE
ss$ = s$
END IF
PRINT ss$; : COLOR jaune: PRINT w$: COLOR blancbrill

END SUB

DEFINT A-Z
SUB afformate (nm, m$(), erreur)
erreur = 0
i = 1: l2 = 0: co = 80
DO
l = LEN(m$(i))
IF l > 39 THEN
BEEP
COLOR , noir
CALL centre(23, rougeclair, "Un mot du texte dépasse les 39 caractères. Corrigez.")
CALL getinvi(w, w$)
erreur = 1
EXIT SUB
END IF
l2 = l2 + l
IF l2 > co THEN
PRINT : i = i - 1: l2 = 0
ELSEIF l2 = co THEN
PRINT m$(i); : l2 = 0
ELSEIF l2 = co - 1 THEN
PRINT m$(i): l2 = 0
ELSE
PRINT m$(i); " "; : l2 = l2 + 1
END IF
i = i + 1
LOOP WHILE i <= nm
PRINT

END SUB

DEFINT A-Z
SUB ajoutertexte (nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
CALL titr(tit$)
COLOR , noir
IF nbtextes = 10 THEN
BEEP
CALL centre(23, rougeclair, "Maximum de textes : 10")
CALL getinvi(r, r$)
EXIT SUB
END IF

IF nbtextes = 0 THEN
BEEP
CALL centre(22, rougeclair, "La bibliothèque est vide.")
CALL centre(23, rougeclair, "Vous devez taper un nouveau texte.")
CALL getinvi(w, w$)
CALL efface(22, 2)
END IF

CALL centre(23, blanc, "Tapez le titre du texte.")
CALL cadre(10, 20, 40, 5, rouge)
DO
COLOR blancbrill, rouge
LOCATE 12, 30: PRINT STRING$(20, 46)
LOCATE 12, 30: CALL inputline(r$, 20)
LOOP WHILE r$ = CHR$(13)
IF r$ = CHR$(27) THEN EXIT SUB

titre$(nbtextes + 1) = r$
p = 0: f = 0

CALL titr2(tit$)
COLOR cyanclair, noir
LOCATE 1, 73: PRINT "Texte"; RTRIM$(STR$(nbtextes + 1))
LOCATE 1, 1: COLOR vertclair: PRINT titre$(nbtextes + 1)
COLOR , rouge: LOCATE 11, 1: PRINT SPACE$(80): COLOR , bleu
v1 = 5: v2 = v1 + 5

aj1:
p = p + 1
m$ = ""

aj4:
COLOR jaune, bleu
LOCATE v1 - 2, 1: PRINT "Paragraphe "; LTRIM$(RTRIM$(STR$(p)))

CALL pleinecran(r$, STRING$(80, 196), m$, v1, v2)

CALL efface(21, 3)
CALL recupere(m$, v1, v2)

IF r$ = CHR$(27) THEN
COLOR , noir
'paragraphe vide
IF m$ = CHR$(255) AND p = 1 THEN EXIT SUB

pp$(1) = "Enregistrer le texte et finir"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Finir sans enregistrer"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
COLOR , noir: CALL efface(21, 3): COLOR , bleu
SELECT CASE r
CASE 1
'paragraphe vide
IF m$ = CHR$(255) THEN
nbtextes = nbtextes + 1
COLOR , noir
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
EXIT SUB
END IF
CALL transforme(m$)
CALL efface(v1, 5)
CALL trouvemot(m$, m$(), nm)
LOCATE v1: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO aj4
COLOR , noir
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
parag$(nbtextes + 1, p) = m$
nbparag(nbtextes + 1) = p
nbtextes = nbtextes + 1
EXIT SUB
CASE 2
GOTO aj4
CASE 3
EXIT SUB
END SELECT
END IF

IF m$ = CHR$(255) THEN BEEP: m$ = "": GOTO aj4
CALL efface(v1, 5)
COLOR blancbrill, bleu
CALL transforme(m$)
CALL trouvemot(m$, m$(), nm)
LOCATE v1: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO aj4

COLOR , noir
CALL efface(21, 3)
'paragraphe suivant ?
IF p < 5 THEN
pp$(1) = "Introduire un autre paragraphe"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Enregistrer le texte et finir"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
SELECT CASE r
CASE 2
GOTO aj4
CASE 1
'monter les paragraphes
COLOR blanc, bleu
LOCATE 3, 1: PRINT "Paragraphe "; LTRIM$(RTRIM$(STR$(p)))
CALL efface(5, 5)
LOCATE 5: CALL afformate(nm, m$(), z)
IF p <> 1 THEN
CALL efface(13, 5)
END IF
v1 = 14: v2 = v1 + 5

parag$(nbtextes + 1, p) = m$
nbparag(nbtextes + 1) = p
f = 1
GOTO aj1
CASE 3
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 2
parag$(nbtextes + 1, p) = m$
nbparag(nbtextes + 1) = p
nbtextes = nbtextes + 1
EXIT SUB
END SELECT

ELSE
pp$(1) = "Modifier encore ce paragraphe"
pp$(2) = "Enregistrer le texte et finir"
DO
CALL fleches(22, 2, pp$(), 2, r, noir, 0, 23, 35)
LOOP WHILE r = 27
SELECT CASE r
CASE 1
GOTO aj4
CASE 2
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
parag$(nbtextes + 1, p) = m$
nbparag(nbtextes + 1) = p
nbtextes = nbtextes + 1
EXIT SUB
END SELECT
END IF

END SUB

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 cadre (v%, h%, l%, nli%, c)
'c est l'intérieur
'le fond est bleu

v2 = v

'ombré
COLOR , 0 'noir
LOCATE v + 1
FOR i = 1 TO nli - 1
LOCATE , h + l + 2
PRINT " "
NEXT
LOCATE v + nli - 1, h + 1
PRINT STRING$(l + 1, 223)

'cadre
COLOR c, 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 , bleu '=== fond de l'écran
LOCATE v2 + 1, h: PRINT CHR$(223)
COLOR , 0
LOCATE v2 + 1, h + 1: PRINT STRING$(l + 1, 223)
COLOR blancbrill

END SUB

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

END SUB

DEFINT A-Z
SUB choixtexte (nbtextes, titre$(), nbparag(), pp$(), parag$())
IF nbtextes = 0 THEN
CALL enregistrer(nbtextes, titre$(), nbparag(), parag$())
RUN "gestion"
END IF

CALL titr(tit$)

v2 = 8

w$ = LTRIM$(STR$(nbtextes)) + " texte": IF nbtextes > 1 THEN w$ = w$ + "s"
w$ = w$ + " dans la bibliothèque"

CALL cadre(v2 - 4, 16, 45, 3, blanc)
COLOR , blanc
CALL centre(v2 - 3, noir, w$)
COLOR , bleu
FOR i = 1 TO nbtextes: pp$(i) = "Texte" + STR$(i): NEXT
COLOR cyanclair
FOR j = 1 TO nbtextes
LOCATE v2 - 1 + j, 16
PRINT pp$(j)
LOCATE v2 - 1 + j, 55 - LEN(STR$(nbparag(j)))
PRINT "("; MID$(STR$(nbparag(j)), 2); " parag.)"
NEXT j

END SUB

DEFINT A-Z
SUB efface (v, hk)
IF v > 20 THEN COLOR , noir
LOCATE v, 1: FOR i = 1 TO hk: PRINT SPACE$(80): NEXT: LOCATE v, 1
END SUB

DEFINT A-Z
SUB effacer (nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
DIM p2$(2)
DO '+++++++
IF nbtextes = 0 THEN
CALL enregistrer(nbtextes, titre$(), nbparag(), parag$())
RUN "gestion"
END IF

CALL titr(tit$)
CALL choixtexte(nbtextes, titre$(), nbparag(), pp$(), parag$())
v = 8
CALL cadre(v - 1, 26, 22, nbtextes + 2, marron)

COLOR blanc, marron
FOR j = 1 TO nbtextes
LOCATE v - 1 + j, 28
PRINT titre$(j)
NEXT j

COLOR , vert: LOCATE 20: PRINT SPACE$(80)
COLOR blanc, noir
PRINT SPACE$(80)
pp$(3) = "La bibliothèque"
pp$(1) = "Un texte"
pp$(2) = "Un paragraphe"
CALL fleches(21, 2, pp$(), 3, rx, noir, 0, 23, 23)
IF rx = 27 THEN EXIT SUB
CALL efface(21, 3)

IF rx = 3 THEN
GOSUB creer
EXIT SUB
END IF

DO
DEF SEG = 0
POKE &H417, (PEEK(&H417) OR &H20)'numérique
POKE &H417, (PEEK(&H417) OR &H40) 'MAJ
DEF SEG
COLOR blanc
LOCATE 22, 1: PRINT "Numéro du texte : ";
CALL inputline(r$, 2)
IF r$ = CHR$(27) THEN EXIT SUB
t = VAL(r$)
LOOP WHILE t < 1 OR t > nbtextes

IF nbparag(t) = 1 THEN rx = 1
ff = -1: IF rx = 1 THEN ff = 0

CALL listeecran(nbtextes, titre$(), nbparag(), parag$(), m$(), t)
ff = 0
COLOR , noir

IF rx = 2 THEN
DO
DEF SEG = 0
POKE &H417, (PEEK(&H417) OR &H20)'numérique
POKE &H417, (PEEK(&H417) OR &H40) 'MAJ
DEF SEG
LOCATE 23, 1: COLOR blanc: PRINT "Numéro du paragraphe : ";
CALL inputline(r$, 2)
IF r$ = CHR$(27) THEN EXIT SUB
p = VAL(r$)
LOOP WHILE p < 1 OR p > nbparag(t)
END IF

DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE &H417, (PEEK(&H417) AND &HBF) 'minuscules
DEF SEG

DO
LOCATE 23: PRINT SPACE$(80)
LOCATE 23, 1: COLOR blanc: PRINT "Effacement "; : CALL ouinon(r$)
IF ASC(r$) = 27 OR UCASE$(r$) = "N" THEN GOTO effac3
LOOP WHILE UCASE$(r$) <> "O"

SELECT CASE rx

CASE 1
'_efface texte & titre_
nbtextes = nbtextes - 1
IF t < nbtextes + 1 THEN

FOR i = t TO nbtextes
FOR p = 1 TO 5
parag$(i, p) = parag$(i + 1, p)
NEXT p
NEXT i

FOR i = t TO nbtextes
titre$(i) = titre$(i + 1)
nbparag(i) = nbparag(i + 1)
NEXT
END IF

CASE 2
'_effacer paragraphe_
IF p < nbparag(t) THEN
FOR i = p TO nbparag(t) - 1
parag$(t, i) = parag$(t, i + 1)
NEXT
END IF
nbparag(t) = nbparag(t) - 1

END SELECT

effac3:
CALL entree_echap(r)
IF r = 27 THEN EXIT SUB
LOOP '+++++

creer:
CALL titr(tit$)
BEEP
CALL cadre(5, 19, 41, 5, blanc)
COLOR , blanc
CALL centre(7, noir, "Effacer tous les textes.")
COLOR , bleu
CALL centre(12, rougeclair, "Vous confirmez ?")
p2$(1) = "oui"
p2$(2) = "non"
CALL fleches(15, 38, p2$(), 2, r, rouge, 1, 23, 35)

SELECT CASE r
CASE 0
COLOR , bleu: CLS : RUN "gestion"
CASE 1
CLOSE : KILL lecture$
nbtextes = 0
OPEN lecture$ FOR OUTPUT AS #1
PRINT #1, 0
CLOSE
RUN "gestion"
END SELECT

RETURN

END SUB

DEFINT A-Z
SUB enregistrer (nbtextes, titre$(), nbparag(), parag$())
OPEN lecture$ FOR OUTPUT AS #1
'nbtextes
PRINT #1, nbtextes
'titres
FOR i = 1 TO nbtextes
PRINT #1, titre$(i)
NEXT
'nbparag
FOR i = 1 TO nbtextes
PRINT #1, nbparag(i)
NEXT
'paragraphe$
FOR i = 1 TO nbtextes
FOR j = 1 TO nbparag(i)
m$ = RTRIM$(LTRIM$(parag$(i, j)))
PRINT #1, m$
NEXT j
NEXT i

CLOSE

END SUB

DEFINT A-Z
SUB entree (rr, y, z)
COLOR , y
CALL efface(23, 1)
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(.3)
END IF
LOOP WHILE r$ = ""

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

COLOR blancbrill
COLOR , z
END SUB

DEFINT A-Z
SUB entree_echap (rr)
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
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
'LOCATE 22, 1: PRINT "Position de la souris : "; v_mouse; ", "; h_mouse '===
IF lButton THEN
IF v_mouse = 23 AND (h_mouse >= 53 AND h_mouse <= 63) THEN
r$ = CHR$(27)
CALL attendre(.3)
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 epuration (mo$)
F1 = 0
IF LEN(mo$) = 1 THEN EXIT SUB
IF RIGHT$(mo$, 3) = "..." THEN mo$ = MID$(mo$, 1, LEN(mo$) - 3)
az = ASC(RIGHT$(mo$, 1))
IF az = 33 OR az = 34 OR az = 39 OR az = 41 OR az = 44 OR az = 45 OR az = 46 OR az = 58 OR az = 59 OR az = 63 THEN mo$ = MID$(mo$, 1, LEN(mo$) - 1): F1 = 1
az = ASC(LEFT$(mo$, 1))
IF F1 = 0 AND (az = 34 OR az = 39 OR az = 40 OR az = 44 OR az = 45 OR az = 46 OR az = 58 OR az = 59) THEN mo$ = MID$(mo$, 2, LEN(mo$) - 1): GOTO epur2
IF az = 34 OR az = 39 OR az = 40 OR az = 44 OR az = 45 OR az = 46 OR az = 58 OR az = 59 THEN mo$ = MID$(mo$, 2, LEN(mo$) - 1)
epur2:
IF MID$(mo$, 2, 1) = "'" THEN mo$ = MID$(mo$, 3)
IF mo$ = "" THEN mo$ = " "

END SUB

DEFINT A-Z
SUB exporter (texte$, nbtextes, titre$(), parag$(), nbparag())
CALL titr(tit$)
'Obtient le lecteur en cours
curdrive$ = LEFT$(CURDIR$, 2)
CALL cadre(7, 5, 70, 9, blanc)
COLOR , blanc
CALL centre(9, noir, "Les textes vont être exportés en ASCII sous le nom : " + texte$)
CALL centre(11, noir, "au niveau supérieur du disque (racine).")
CALL centre(13, noir, "Vous pourrez les récupérer avec un traitement de textes.")
CALL entree_echap(r)
IF r = 27 THEN EXIT SUB
CALL efface(23, 1)
CALL centre(23, blanc, "Exportation des textes")
OPEN curdrive$ + "\" + texte$ FOR OUTPUT AS #2

FOR t = 1 TO nbtextes
PRINT #2, titre$(t)
FOR j = 1 TO nbparag(t)
PRINT #2, parag$(t, j)
NEXT j
PRINT #2, CHR$(13)
NEXT t
CLOSE #2
SLEEP 2

END SUB

DEFINT A-Z
SUB fleches (v%, h%, w$(), np%, r%, coul, drap, v2, h2)
'LOCATE 19, 1: 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
'LOCATE 22, 1: PRINT v_mini, v_maxi, h_mini, h_maxi '===
'cadre
IF drap = 1 THEN
CALL cadre(v - 1, h - 3, l2 + 4, np + 2, coul)
END IF
flag = 0
IF v2 = 23 AND h2 = 35 THEN
COLOR , noir
CALL centre(23, blanc, gg$)
ELSEIF v2 = 23 AND h2 = 23 THEN
COLOR , noir
CALL centre(23, blanc, gg$ + SPACE$(13) + es$)
flag = 2
END IF

COLOR blancbrill, coul

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
'pointé l'article
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
v = v_mouse
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 'entree
souris = 1
CALL attendre(.3)
EXIT DO
ELSEIF v_mouse = v2 AND (h_mouse >= h2 + 25 AND h_mouse <= h2 + 35) AND flag = 2 THEN
r = 27 'echap
CALL attendre(.3)
EXIT SUB
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 = 27: 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 getinvi (r, r$)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
DO
r$ = INKEY$
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN r = ASC(r$) ELSE r = ASC(RIGHT$(r$, 1))

END SUB

DEFINT A-Z
SUB impression (parag$(), nbparag(), t)

FOR o = 1 TO nbparag(t)
r$ = parag$(t, o)
l = 1: colonne = 79
DO
imp3:
IF LEN(r$) <= colonne THEN PRINT #3, r$: EXIT DO
z = INSTR(l, r$, " ")

IF z > colonne OR z = 0 THEN
PRINT #3, MID$(r$, 1, r)
r$ = MID$(r$, r + 1)
l = 1
GOTO imp3
END IF
r = z
l = z + 1
LOOP

NEXT o

END SUB

DEFINT A-Z
SUB imprime2 (s$, w$)
w$ = (".(" + w$ + ")")
l1 = LEN(w$)
l2 = LEN(s$) + l1
IF l2 > 14 THEN
ss$ = MID$(s$, 1, 14 - l1)
ELSEIF l2 < 14 THEN
ss$ = s$ + MID$(STRING$(15, "."), 1, 14 - (LEN(s$) + l1))
ELSE
ss$ = s$
END IF
PRINT #3, ss$; w$; " ";

END SUB

DEFINT A-Z
SUB imprimer (nbtextes, titre$(), parag$(), nbparag(), pp$())
DO
IM = 0
CALL choixtexte(nbtextes, titre$(), nbparag(), pp$(), parag$())
IF nbtextes > 1 THEN
i = nbtextes + 1: titre$(i) = "Tous"
CALL fleches(8, 28, titre$(), i, r, marron, 1, 23, 23)
IF r = 27 THEN EXIT SUB
t = r: IF r = nbtextes + 1 THEN IM = -1
ELSE
LOCATE 8, 28: PRINT titre$(1)
t = 1
END IF
CALL efface(23, 1)
CALL centre(23, blanc, "Tapez " + rt$ + " quand l'imprimante sera prête.")
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(.3)
END IF
LOOP WHILE r$ = ""

IF r$ = CHR$(27) THEN EXIT SUB

CALL efface(23, 1)
OPEN "lpt1:" FOR OUTPUT AS #3
'PRINT #3, CHR$(27); "@" ===
WIDTH #3, 80
IF NOT IM THEN
CALL impression(parag$(), nbparag(), t)
ELSE
FOR t = 1 TO nbtextes
COLOR blanc: LOCATE 23, 30: PRINT "Impression texte n°"; t
PRINT #3, STRING$(79, "-")
PRINT #3, titre$(t); " - Texte"; t; "-"
CALL impression(parag$(), nbparag(), t)
NEXT t
PRINT #3, STRING$(79, "-")
END IF
PRINT #3, CHR$(12)
CLOSE #3
CLS
IF IM THEN EXIT SUB
CALL titr(tit$)
CALL entree_echap(r)
IF r = 27 THEN EXIT SUB
LOOP

END SUB

DEFINT A-Z
SUB inputline (r$, nl)
DIM re$(30)
LOCATE , , 1
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
FOR ii = 1 TO nl + 1
inpdebut:
COLOR blancbrill
IF ii <= 0 THEN ii = 1
DO
re$(ii) = INKEY$
LOOP WHILE re$(ii) = ""
IF re$(ii) = CHR$(27) THEN r$ = CHR$(27): GOTO inpfin
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 inpdebut
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 inpdebut
IF re$(ii) = "*" THEN GOTO inpdebut
IF ASC(re$(ii)) < 32 OR ASC(re$(ii)) > 165 THEN GOTO inpdebut
IF ii = nl + 1 THEN BEEP: GOTO inpdebut
PRINT re$(ii);
NEXT ii
PRINT
r$ = "": FOR JJ = 1 TO ii - 1: r$ = r$ + re$(JJ): NEXT
r$ = LTRIM$(r$): r$ = RTRIM$(r$)
IF r$ = "" THEN r$ = CHR$(13)
inpfin:
LOCATE , , 0

END SUB

DEFINT A-Z
SUB inserer (nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())

IF nbtextes > 1 THEN
CALL choixtexte(nbtextes, titre$(), nbparag(), pp$(), parag$())
CALL fleches(8, 28, titre$(), nbtextes, r, marron, 1, 23, 23)
IF r = 27 THEN EXIT SUB
t = r
ELSE
t = 1
END IF

IF nbparag(t) = 5 THEN
COLOR , noir
BEEP
LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, rougeclair, "5 paragraphes maximum par texte !")
CALL getinvi(r, r$)
EXIT SUB
END IF
ff = -1: CALL listeecran(nbtextes, titre$(), nbparag(), parag$(), m$(), t)
ff = 0
DO '+++++++++++++++
insere0:
COLOR , vert: LOCATE 20: PRINT SPACE$(80): COLOR , noir
i = 3: IF nbparag(t) = 1 THEN i = 2
flag = 0
pp$(1) = "Au début du texte": pp$(2) = "A la fin du texte": pp$(3) = "Entre deux parag."
CALL efface(21, 3)

CALL fleches(21, 2, pp$(), i, r, noir, 0, 23, 35)
CALL efface(21, 3)

SELECT CASE r
CASE 27
EXIT SUB
CASE 3
DEF SEG = 0
POKE &H417, (PEEK(&H417) OR &H20)'numérique
POKE &H417, (PEEK(&H417) OR &H40) 'MAJ
DEF SEG
DO
LOCATE 22, 1: COLOR blanc: PRINT "Avant quel paragraphe : ";
CALL inputline(r$, 2)
IF r$ = CHR$(27) THEN EXIT SUB
LOOP WHILE VAL(r$) < 1 OR VAL(r$) > nbparag(t)
DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE &H417, (PEEK(&H417) AND &HBF) 'minuscules
DEF SEG
IF r$ = CHR$(27) THEN GOTO insere0
p = VAL(r$): flag = 1

CASE 1
p = 1: flag = 1
CASE 2
p = nbparag(t) + 1
END SELECT

CALL titr2(tit$)
m$ = ""

ins2:
COLOR cyanclair, noir
LOCATE 1, 73: PRINT "Texte"; RTRIM$(STR$(t))
LOCATE 1, 1: COLOR vertclair: PRINT titre$(t)

COLOR jaune, bleu: LOCATE 3, 1: PRINT "Paragraphe"; p

CALL pleinecran(r$, STRING$(80, 196), m$, 9, 14)

CALL efface(21, 3)
CALL recupere(m$, 9, 14)

IF r$ = CHR$(27) THEN
COLOR , noir
'paragraphe vide
IF m$ = CHR$(255) THEN EXIT SUB

pp$(1) = "Enregistrer et finir"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Finir sans enregistrer"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
COLOR , noir: CALL efface(21, 3): COLOR , bleu
SELECT CASE r
CASE 1
CALL transforme(m$)
CALL efface(9, 5)
CALL trouvemot(m$, m$(), nm)
LOCATE 9: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO ins2
COLOR , noir
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
nbparag(t) = nbparag(t) + 1
IF flag = 0 THEN
parag$(t, p) = m$
ELSE
FOR i = nbparag(t) - 1 TO p STEP -1
parag$(t, i + 1) = parag$(t, i)
NEXT
parag$(t, p) = m$
END IF
EXIT SUB
CASE 2
GOTO ins2
CASE 3
EXIT SUB
END SELECT

END IF

IF m$ = CHR$(255) THEN BEEP: m$ = "": GOTO ins2
CALL efface(9, 5)
CALL transforme(m$)
CALL trouvemot(m$, m$(), nm)
LOCATE 9: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO ins2

COLOR , noir

pp$(1) = "Enregistrer le paragraphe"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Finir sans enregistrer"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
COLOR , noir: CALL efface(21, 3): COLOR , bleu
SELECT CASE r
CASE 1
nbparag(t) = nbparag(t) + 1
IF flag = 0 THEN
parag$(t, p) = m$
ELSE
FOR i = nbparag(t) - 1 TO p STEP -1
parag$(t, i + 1) = parag$(t, i)
NEXT
parag$(t, p) = m$
END IF

CASE 2
GOTO ins2
CASE 3
EXIT SUB
END SELECT

CALL listeecran(nbtextes, titre$(), nbparag(), parag$(), m$(), t)
IF nbparag(t) = 5 THEN CALL entree(r, noir, noir): EXIT SUB
CALL entree_echap(r)
IF r = 27 THEN EXIT SUB

LOOP '+++++++++++

END SUB

DEFINT A-Z
SUB lire (nbtextes, titre$(), parag$(), nbparag(), s$(), s%(), m$(), te$(), r%(), pp$())
CALL titr(tit$)
pp$(1) = "Textes": pp$(2) = "Liste des mots"
CALL fleches(11, 33, pp$(), 2, r, rouge, 1, 23, 23)
CALL efface(11, 3)

SELECT CASE r
CASE 27
EXIT SUB
CASE 1 '+++++++++++++

IF nbtextes = 1 THEN
CALL listeecran(1, titre$(), nbparag(), parag$(), m$(), 1)
CALL entree(w, noir, noir)
EXIT SUB
END IF

DO
CALL choixtexte(nbtextes, titre$(), nbparag(), pp$(), parag$())
i = nbtextes + 1
IF nbtextes = 1 THEN i = nbtextes ELSE titre$(i) = "Tous"
CALL fleches(8, 28, titre$(), i, r, marron, 1, 23, 23)
IF r = 27 THEN EXIT DO
f = 0: t = r: IF r = nbtextes + 1 THEN f = -1
IF NOT f THEN
CALL listeecran(nbtextes, titre$(), nbparag(), parag$(), m$(), t)
ELSE
FOR t = 1 TO nbtextes
CALL listeecran(nbtextes, titre$(), nbparag(), parag$(), m$(), t)
CALL entree_echap(r)
IF r = 27 THEN EXIT DO
NEXT t
EXIT DO
END IF
CALL entree_echap(r)
IF r = 27 THEN EXIT DO
COLOR , noir: CLS
LOOP

CASE 2 '+++++++
GOSUB listemots
FOR i = 1 TO nm: s%(i) = 0: NEXT
END SELECT

EXIT SUB


listemots:
tit$ = "Liste des mots": CALL titr(tit$)
te = 1
COLOR blanc, noir: LOCATE 23, 25: PRINT "Textes restant à lire :"
FOR t = 1 TO nbtextes
FOR p = 1 TO nbparag(t)
m$ = parag$(t, p)
LOCATE 23, 49: COLOR jaune: PRINT nbtextes + 1 - t; : COLOR blancbrill: PRINT " "
CALL trouvemot(m$, m$(), nm)
IF nm > 3000 THEN nm = 3000
FOR i = 1 TO nm
mo$ = m$(i)
CALL epuration(mo$)
IF LEN(mo$) = 1 AND ASC(mo$) < 64 THEN 5080
CALL epuration(mo$)
te$(te) = mo$: r%(te) = te: te = te + 1
5080 NEXT i
NEXT p
NEXT t
COLOR , bleu
CALL centre(12, vertclair, LTRIM$(STR$(te)) + " mots dans la bibliothèque.")
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, blanc, "Tri des mots...")
'tri shell-metzner
n = te: m = n
5130 m = INT(m / 2): K = n - m: j = 1
IF m = 0 THEN 5220
5150 i = j
5160 l1 = i + m: I2 = r%(i): l2 = r%(l1)
IF te$(I2) <= te$(l2) THEN 5200
SWAP r%(i), r%(l1)
i = i - m: IF i >= 1 THEN 5160
5200 j = j + 1: IF j > K THEN 5130
GOTO 5150
5220 nm = 1: s$(nm) = te$(r%(1))
FOR i = 2 TO te
IF te$(r%(i)) = s$(nm) THEN s%(nm) = s%(nm) + 1: GOTO 5240
nm = nm + 1: s$(nm) = te$(r%(i))
5240 NEXT
nm = nm - 1

affiche:
CALL titr(tit$)
pp$(1) = "Ecran": pp$(2) = "Imprimante"
'CALL a
CALL fleches(11, 35, pp$(), 2, r, rouge, 1, 23, 23)
IF r = 27 THEN RETURN
IF r = 1 THEN
CALL titr(tit$)
GOSUB affcol
GOTO affiche
END IF
COLOR , noir: LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, blanc, "Tapez " + rt$ + " quand l'imprimante est prête.")
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(.3)
END IF
LOOP WHILE r$ = ""

IF r$ = CHR$(27) THEN GOTO affiche

LOCATE 23, 1: PRINT SPACE$(80)
OPEN "lpt1:" FOR OUTPUT AS #3
'PRINT #3, CHR$(27); "@" ===
WIDTH #3, 80
PRINT #3, STRING$(79, "-")
PRINT #3, "Liste des mots :"
PRINT #3, STRING$(79, "-")
FOR i = 2 TO nm STEP 5
IF i = nm THEN GOTO impfin
w$ = LTRIM$(STR$(s%(i) + 1))
s$ = s$(i)
CALL imprime2(s$, w$)
IF i = nm THEN GOTO impfin

w$ = LTRIM$(STR$(s%(i + 1) + 1))
s$ = s$(i + 1)
CALL imprime2(s$, w$)
IF i = nm THEN GOTO impfin

w$ = LTRIM$(STR$(s%(i + 2) + 1))
s$ = s$(i + 2)
CALL imprime2(s$, w$)
IF i = nm THEN GOTO impfin

w$ = LTRIM$(STR$(s%(i + 3) + 1))
s$ = s$(i + 3)
CALL imprime2(s$, w$)
IF i = nm THEN GOTO impfin

w$ = LTRIM$(STR$(s%(i + 4) + 1))
s$ = s$(i + 4)
CALL imprime2(s$, w$)

CALL centre(23, vertclair, LTRIM$(STR$(i)) + " mots sur" + STR$(nm))
w$ = INKEY$: IF w$ = CHR$(27) THEN PRINT #3, CHR$(10); "Impression interrompue": CLOSE #3: GOTO affiche
NEXT

impfin:
PRINT #3, CHR$(12)
CLOSE #3
RETURN

affcol:
'affichage en colonne
h = 1: mot = 2: e = 1
FOR i = 1 TO nm
FOR y = 1 TO 16
LOCATE 3 + y, h
CALL affiche(s$(mot), LTRIM$(STR$(s%(mot) + 1)))
IF mot > nm THEN CALL entree(r, noir, noir): RETURN
mot = mot + 1
NEXT y
h = h + 16
IF i = 5 * e THEN
CALL entree(r, noir, noir)
IF r = 27 THEN RETURN ELSE CALL titr(tit$): h = 1: e = e + 1
END IF
NEXT i
CALL entree(r, noir, noir)
RETURN

END SUB

DEFINT A-Z
SUB listeecran (nbtextes, titre$(), nbparag(), parag$(), m$(), t)
CALL titr(tit$)
COLOR cyanclair, noir
w$ = "texte " + LTRIM$(STR$(t))
LOCATE 1, 81 - LEN(w$): PRINT w$
COLOR vertclair
LOCATE 1, 1: PRINT titre$(t)

COLOR blancbrill, bleu
nl = 16: LOCATE 2, 1
FOR ir = 1 TO nbparag(t)
m$ = parag$(t, ir)
IF nl < 6 THEN
nl = 16
CALL entree(r, noir, noir)
LOCATE 23, 1: PRINT SPACE$(80)
VIEW PRINT 3 TO 18: COLOR , bleu: CLS 2: VIEW PRINT
LOCATE 2, 1
END IF

PRINT : PRINT
CALL trouvemot(m$, m$(), nm)
CALL afformate(nm, m$(), z)
nl = nl - (INT(LEN(m$) / 80) + 2)
NEXT ir

END SUB

DEFINT A-Z
SUB modifier (nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())

DO '++++++++++++
CALL choixtexte(nbtextes, titre$(), nbparag(), pp$(), parag$())
IF nbtextes > 1 THEN
CALL fleches(8, 28, titre$(), nbtextes, r, marron, 1, 23, 23)
IF r = 27 THEN EXIT SUB
ELSE
r = 1
END IF

t = r
v = r + 7
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, blanc, "Modifiez le titre puis " + rt$)
DO
m$ = titre$(t)
COLOR jaune: CALL pleineligne(r$, m$, 19, v, 28): COLOR blancbrill
m$ = RTRIM$(m$): m$ = LTRIM$(m$)
LOOP WHILE m$ = ""

IF r$ = CHR$(27) THEN EXIT SUB

titre$(t) = m$
' IF nbparag(t) = 1 THEN p = 1: GOTO 4090

FOR p = 1 TO nbparag(t)
GOSUB modif
NEXT p

CALL titr(tit$)
CALL entree_echap(r)
IF r = 27 THEN EXIT SUB
LOOP '++++++++++++

modif:
m$ = parag$(t, p)
modi:
CALL titr2(tit$)
COLOR cyanclair, noir
LOCATE 1, 73: PRINT "Texte"; RTRIM$(STR$(t))
LOCATE 1, 1: COLOR vertclair: PRINT titre$(t)
COLOR jaune, bleu: LOCATE 3, 1: PRINT "Paragraphe"; p

CALL pleinecran(r$, STRING$(80, 196), m$, 9, 14)

CALL efface(21, 3)
CALL recupere(m$, 9, 14)

IF r$ = CHR$(27) THEN
COLOR , noir
'paragraphe vide
IF m$ = CHR$(255) THEN EXIT SUB

pp$(1) = "Enregistrer et finir"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Finir sans enregistrer"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
COLOR , noir: CALL efface(21, 3): COLOR , bleu
SELECT CASE r
CASE 1
CALL transforme(m$)
CALL efface(9, 5)
CALL trouvemot(m$, m$(), nm)
COLOR blancbrill
LOCATE 9: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO modi
COLOR , noir
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
parag$(t, p) = m$
EXIT SUB
CASE 2
GOTO modi
CASE 3
EXIT SUB
END SELECT
END IF

IF m$ = CHR$(255) THEN BEEP: GOTO modif
CALL efface(9, 5)
CALL transforme(m$)
CALL trouvemot(m$, m$(), nm)
LOCATE 9: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO modi

COLOR , noir

pp$(1) = "Enregistrer le paragraphe"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Finir sans enregistrer"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
COLOR , noir: CALL efface(21, 3): COLOR , bleu
SELECT CASE r
CASE 1
COLOR , noir
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
parag$(t, p) = m$
CASE 2
GOTO modi
CASE 3
EXIT SUB
END SELECT

RETURN

END SUB

DEFINT A-Z
SUB ouinon (r$)
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" OR r$ = CHR$(27)
END SUB

DEFINT A-Z
SUB pleinecran (r$, l$, m$, v1, v2)
m$ = RTRIM$(m$)
co = 80
'_saisie plein ecran_
f = -1: 'insertion
COLOR , noir
CALL efface(21, 3)
CALL centre(22, vertclair, "Ret.Arr Suppr Inser Origine Fin " + fle$ + " Ctrl-x")
CALL centre(23, blanc, rt$ + " = terminer" + SPACE$(13) + "[Echap] = abandon")
COLOR blancbrill, bleu
VIEW PRINT v1 - 1 TO v2
v = v1: h = 1

pl0:
CLS 2
pl1:
LOCATE v1, 1, 0: PRINT m$
pl2:
IF h < 1 THEN h = 1: BEEP
IF v < v1 THEN v = v1: BEEP
IF h > co THEN h = 1: v = v + 1

lc = h + (co * (v - v1))
IF lc > LEN(m$) THEN 'fin texte
lc = LEN(m$) + 1
v = INT(LEN(m$) / co)
h = (LEN(m$) - (co * v)) + 1
v = v + v1
END IF

IF v = v2 AND h > 38 THEN h = 38

IF NOT f THEN LOCATE v, h, 1, 0, 7 ELSE LOCATE v, h, 1, 7

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 >= v1 AND v_mouse <= v2 THEN
v = v_mouse: h = h_mouse
CALL attendre(.2)
souris = 1
EXIT DO
ELSEIF v_mouse = 23 AND (h_mouse >= 46 AND h_mouse <= 62) THEN
r$ = CHR$(27)
CALL attendre(.3)
ELSEIF v_mouse = 23 AND (h_mouse >= 19 AND h_mouse <= 32) THEN
r$ = CHR$(13)
CALL attendre(.3)
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""

IF souris = 1 THEN GOTO pl2

IF r$ = CHR$(27) OR r$ = CHR$(13) THEN VIEW PRINT: LOCATE , , 0: EXIT SUB
IF LEN(r$) = 2 THEN GOTO pl3
r2 = ASC(r$)

IF r2 > 31 AND r2 < 166 THEN
IF LEN(m$) > 357 THEN
BEEP
VIEW PRINT
COLOR , noir
LOCATE , , 0
CALL centre(23, rougeclair, "Le paragraphe ne doit pas dépasser 355 caractères.")
CALL getinvi(w, w$)
CALL efface(23, 1)
CALL centre(23, blanc, rt$ + " = terminer" + SPACE$(13) + "[Echap] = abandon")
LOCATE , , 1
COLOR , bleu
VIEW PRINT v1 - 1 TO v2
m$ = LEFT$(m$, 357)
END IF
IF f THEN
m$ = MID$(m$, 1, lc - 1) + r$ + MID$(m$, lc)
ELSE
m$ = MID$(m$, 1, lc - 1) + r$ + MID$(m$, lc + 1)
END IF
h = h + 1
GOTO pl1
END IF

IF r2 = 8 THEN 'delete
IF h = 1 AND v = v1 THEN GOTO pl0
m$ = MID$(m$, 1, lc - 2) + MID$(m$, lc): h = h - 1
IF h < 1 AND v > v1 THEN h = co: v = v - 1
GOTO pl0
END IF

IF r2 = 24 THEN m$ = LEFT$(m$, lc - 1): GOTO pl0'^X

pl3:
'carac étendu
r2 = ASC(RIGHT$(r$, 1))
IF r2 = 72 THEN v = v - 1 'haut
IF r2 = 80 THEN v = v + 1 'bas
IF r2 = 77 THEN h = h + 1 'droite
IF r2 = 71 THEN h = 1: GOTO pl2 'home
IF r2 = 79 THEN h = co: GOTO pl2 'end
IF r2 = 73 THEN v = v1: h = 1: GOTO pl2'pgup
IF r2 = 81 THEN v = v2: h = co: GOTO pl2'pgdown
IF r2 = 75 THEN h = h - 1: IF h < 1 AND v > v1 THEN h = co: v = v - 1: GOTO pl2 'gauche
IF r2 = 82 THEN f = NOT f: GOTO pl0 'ins
IF r2 = 83 THEN 'suppr
m$ = MID$(m$, 1, lc - 1) + MID$(m$, lc + 1)
GOTO pl0
END IF
GOTO pl2

END SUB

DEFINT A-Z
SUB pleineligne (r$, m$, np, v, h)

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(m$) THEN h = LEN(m$) + h2
LOCATE v, h2 - 1, 0: PRINT SPACE$(np + 1)
LOCATE v, h2: PRINT m$
lc = h - (h2 - 1)

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

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

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

IF r2 > 31 AND r2 < 255 THEN
IF LEN(m$) >= np THEN BEEP: IF f THEN m$ = MID$(m$, 1, LEN(m$) - 1)
IF f THEN
m$ = MID$(m$, 1, lc - 1) + r$ + MID$(m$, lc)
ELSE
m$ = MID$(m$, 1, lc - 1) + r$ + MID$(m$, 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 m$ = MID$(m$, 1, lc - 2) + MID$(m$, lc): h = h - 1
GOTO ple1
END IF

plecaet:
'carac étendu
r2 = ASC(RIGHT$(r$, 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
m$ = MID$(m$, 1, lc - 1) + MID$(m$, lc + 1) 'suppr
END SELECT
GOTO ple1

END SUB

DEFINT A-Z
SUB recupere (m$, v1, v2)
LOCATE 23, 1: COLOR , noir: PRINT SPACE$(80): COLOR , bleu
'_recuperation texte_
m$ = ""
FOR y = v1 TO v2
FOR x = 1 TO 80
s = SCREEN(y, x)
m$ = m$ + CHR$(s)
NEXT x
NEXT y
'FOR x = 1 TO 38
's = SCREEN(17, x)
'm$ = m$ + CHR$(s)
'NEXT

IF LEFT$(m$, 355) = SPACE$(355) THEN m$ = CHR$(255): EXIT SUB
m$ = RTRIM$(m$): m$ = LTRIM$(m$)
ASS = ASC(RIGHT$(m$, 1))
IF ASS = 33 OR ASS = 46 OR ASS = 58 OR ASS = 59 OR ASS = 63 THEN
m$ = m$ + " "
ELSE
m$ = m$ + ". "
END IF

END SUB

DEFINT A-Z
SUB titr (w$)
IF couleur = 0 THEN CALL titrnb(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
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 titr2 (w$)
IF couleur = 0 THEN CALL titrnb(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
COLOR , vert
LOCATE 2, 1: PRINT SPACE$(80)
CALL centre(2, noir, UCASE$(w$))
LOCATE 20, 1: PRINT SPACE$(80)
VIEW PRINT 3 TO 19: COLOR blancbrill, bleu: CLS 2: VIEW PRINT

END SUB

DEFINT A-Z
SUB titrnb (tit$)
COLOR jaune, noir: CLS
w$ = tit$
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
COLOR blancbrill, noir: LOCATE 2: PRINT STRING$(80, 196)
CALL centre(2, blancbrill, UCASE$(w$))
LOCATE 21, 1: PRINT STRING$(80, 196)
VIEW PRINT 3 TO 20: COLOR blancbrill, bleu: CLS 2: VIEW PRINT
END SUB

DEFINT A-Z
SUB transforme (m$)
e$ = " ": GOSUB sup

e$ = "(": GOSUB avant
e$ = CHR$(34): GOSUB avant

e$ = CHR$(34): GOSUB apres
e$ = ")": GOSUB apres
e$ = ",": GOSUB apres
e$ = ".": GOSUB apres

e$ = ":": GOSUB avap
e$ = "!": GOSUB avap
e$ = "?": GOSUB avap
e$ = ";": GOSUB avap
e$ = "'": GOSUB avap '1° étape

GOSUB ctrl
GOSUB ctrl2
GOSUB ctrl3 '2° étape
GOSUB ctrl4

e$ = "! ! !": e2$ = "!!!": GOSUB ctrl5
e$ = "? ? ?": e2$ = "???": GOSUB ctrl5
e$ = ". . .": e2$ = "...": GOSUB ctrl5

IF LEN(m$) > 360 THEN
IF MID$(m$, 358, 1) = " " THEN
m$ = LEFT$(m$, 357) + ". "
ELSE
m$ = LEFT$(m$, 358) + ". "
END IF
BEEP
COLOR , noir
CALL centre(23, rougeclair, "Paragraphe trop long (355 caractères max.) -> il sera tronqué.")
CALL getinvi(w, w$)
CALL efface(23, 1)
COLOR blancbrill, bleu
END IF

EXIT SUB

apres:
l = 1: f = 0
DO
GOSUB espace
LOOP WHILE z <> 0
RETURN

espace:
z = INSTR(l, m$, e$): IF z = 0 THEN RETURN
IF e$ = CHR$(34) THEN f = f + 1
IF f / 2 <> INT(f / 2) AND e$ = CHR$(34) THEN l = z + 1: RETURN

IF ASC(MID$(m$, z + 1, 1)) <> 32 THEN m$ = MID$(m$, 1, z) + " " + MID$(m$, z + 1) 'pas espace après
IF z = 1 THEN l = z + 1: GOTO espace

IF ASC(MID$(m$, z - 1, 1)) = 32 THEN m$ = MID$(m$, 1, z - 2) + MID$(m$, z): 'espace avant
l = z + 1

RETURN

avant:
l = 1: f = 0
DO
GOSUB espace2
LOOP WHILE z <> 0
RETURN

espace2:
z = INSTR(l, m$, e$): IF z = 0 THEN RETURN
IF e$ = CHR$(34) THEN f = f + 1
IF f / 2 = INT(f / 2) AND e$ = CHR$(34) THEN l = z + 1: RETURN 'pair
IF ASC(MID$(m$, z + 1, 1)) = 32 THEN m$ = MID$(m$, 1, z) + MID$(m$, z + 2)'un espace après
IF z = 1 THEN GOTO esp2
IF ASC(MID$(m$, z - 1, 1)) <> 32 THEN m$ = MID$(m$, 1, z - 1) + " " + MID$(m$, z): z = z + 1 'pas d'espace
esp2:
l = z + 1
RETURN

avap:
l = 1
DO
GOSUB espace3
LOOP WHILE z <> 0
RETURN

espace3:
z = INSTR(l, m$, e$): IF z = 0 THEN RETURN
IF ASC(MID$(m$, z + 1, 1)) <> 32 THEN m$ = MID$(m$, 1, z) + " " + MID$(m$, z + 1)
IF z = 1 THEN l = z + 1: GOTO espace3
IF ASC(MID$(m$, z - 1, 1)) <> 32 THEN m$ = MID$(m$, 1, z - 1) + " " + MID$(m$, z) 'pas d'espace
l = z + 1
RETURN

sup:
l = 1
DO
GOSUB espace4
LOOP WHILE z <> LEN(m$)
RETURN

espace4:
z = INSTR(l, m$, e$): IF z = LEN(m$) THEN RETURN
IF ASC(MID$(m$, z + 1, 1)) = 32 THEN m$ = MID$(m$, 1, z) + MID$(m$, z + 2): RETURN
l = z + 1
RETURN

ctrl:
l = 1: f = 0
DO
GOSUB espace5
LOOP WHILE z <> 0
RETURN

espace5:
z = INSTR(l, m$, CHR$(34)): IF z = 0 THEN RETURN
f = f + 1
IF f / 2 <> INT(f / 2) THEN l = z + 1: RETURN
t$ = MID$(m$, z - 2, 2)
IF t$ = ". " OR t$ = "? " OR t$ = "! " OR t$ = ") " THEN
m$ = MID$(m$, 1, z - 2) + MID$(m$, z)
END IF
l = z + 1
RETURN

ctrl2:
l = 1
DO
GOSUB espace6
LOOP WHILE z <> 0
RETURN

espace6:
z = INSTR(l, m$, CHR$(34)): IF z = 0 THEN RETURN
IF z = 1 THEN l = z + 1: RETURN
t$ = MID$(m$, z - 2, 2)
IF t$ = "( " THEN
m$ = MID$(m$, 1, z - 2) + MID$(m$, z)
END IF
l = z + 1
RETURN

ctrl3:
l = 1
DO
GOSUB espace7
LOOP WHILE z <> 0
RETURN

espace7:
z = INSTR(l, m$, " ' "): IF z = 0 THEN RETURN
m$ = MID$(m$, 1, z - 1) + "'" + MID$(m$, z + 3)
l = z + 1
RETURN

ctrl4:
l = 1
DO
GOSUB espace8
LOOP WHILE z <> 0
RETURN

espace8:
z = INSTR(l, m$, ")"): IF z = 0 THEN RETURN
t$ = MID$(m$, z - 2, 2)
IF t$ = ". " OR t$ = "? " OR t$ = "! " THEN
m$ = MID$(m$, 1, z - 2) + MID$(m$, z)
END IF
l = z + 1
RETURN

ctrl5:
l = 1
DO
GOSUB espace9
LOOP WHILE z <> 0
RETURN

espace9:
z = INSTR(l, m$, e$): IF z = 0 THEN RETURN
m$ = MID$(m$, 1, z - 1) + e2$ + MID$(m$, z + 5)
l = z + 1
RETURN

END SUB

DEFINT A-Z
SUB trouvemot (m$, m$(), nm)
j = 1: mm$ = ""
FOR i = 1 TO LEN(m$)
mm$ = mm$ + MID$(m$, i, 1)
IF ASC(MID$(m$, i, 1)) = 32 THEN m$(j) = MID$(mm$, 1, LEN(mm$) - 1): mm$ = "": j = j + 1: IF LEN(m$(j - 1)) = 0 THEN j = j - 1
NEXT

nm = j - 1

END SUB
 

 

 

Précédente Accueil Remonter Suivante