Informations sur: C:\DICO\CHER_MOT.BAS (Version 2)

Publié par SFLPMEA le 27/01/2010

Description

Source Qbasic. Recherche dans l’ODS 3 de mots en connaissant quelques uns de ses caractères, destiné aux cruciverbistes (remplace la version précédente). Par SFLPMEA

Code source (langage qbasic)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
' *****************************************
' * RECHERCHE de MOTS POUR CRUCIVERBISTES *  ----->  C:\DICO\CHER_MOT.BAS
' *****************************************
' Ecrit par SFLPMEA le 15/01/2010
    OPTION BASE 1: DEFSTR A-Z: CLOSE
    SCREEN 12: WINDOW SCREEN (1, 1)-(640, 480): CLS
  
    Cfd% = 0               ' COUL DE FOND ECRAN
    Ccv% = 11              ' COUL CADRE VIDE
    Cct% = 10: Cte% = 14   ' COUL CADRE/TITRE
    Cdd% = 11              ' COUL DESIGNATIONS DONNEES
    Cdav% = 13             ' COUL DONNEES AVT SAISIE
    Cdas% = 14             ' COUL DONNEES … SAISIR
    Cds% = 15              ' COUL DONNEES APRES SAISIE
   
    BVR& = 65536 * 5 + 256 * 5 + 5
    PALETTE 0, BVR&
    K% = 11: GOSUB GS00.CADRE
    DIM Lettre&(400), LX&(65 TO 90, 400), Largeur%(90), G&(73)
    DIM Position.Init&(65 TO 91)
    Largeur%(32) = 30  ' ***** Modifiable
    'GOTO AAAAA
    ' ***** Chargement des Tables 'caracteres' de A … V
    FOR ASKI% = 65 TO 86
        L = CHR$(ASKI%)
        OPEN "C:\ALPHABET\CES40VAR\L_" + L + ".LET" FOR INPUT AS #1
        FOR I% = 1 TO 400: INPUT #1, LX&(ASKI%, I%): NEXT I%
        INPUT #1, Largeur%(ASKI%): CLOSE
    NEXT ASKI%
   
    ' ***** LIGNE 1
    Ecri = "RECHERCHES"      ' ***** Modifiable
    Y% = 113: GOSUB GS02.AFFICHE
   
    ' ***** LIGNE 2
    Ecri = "POUR*LES"       ' ***** Modifiable
    Y% = 213: GOSUB GS02.AFFICHE
   
    ' ***** LIGNE 3
    Ecri = "MOTS CROISES"   ' ***** Modifiable
    Y% = 313: GOSUB GS02.AFFICHE
    ' *****
    LOCATE 26, 13: COLOR 15: PRINT " VERSION 2.0 "
    Debut# = TIMER: RANDOMIZE TIMER
    ' ***** Clignottement
    DO
    FOR Y% = 133 TO 333 STEP 100: FOR X% = 30 TO 600 STEP 8
        K% = INT(RND * 8) + 8: IF K% < 9 THEN K% = K% + 1
            IF POINT(X%, Y%) > 0 THEN PAINT (X%, Y%), K%, 0
    NEXT X%, Y%
    LOOP UNTIL TIMER > Debut# + 5 OR INKEY$ > ""
    ' ***** Effacement ecran
    Xc% = INT(RND * 214) + 214: Yc% = INT(RND * 161) + 160
    K% = INT(RND * 16)
    RANDOMIZE TIMER: K% = INT(RND * 16)
    FOR X% = 320 TO 1 STEP -1: LINE (Xc%, Yc%)-(X%, 1), K%: NEXT X%
    FOR Y% = 1 TO 480: LINE (Xc%, Yc%)-(1, Y%), K%: NEXT Y%
    FOR X% = 1 TO 640: LINE (Xc%, Yc%)-(X%, 480), K%: NEXT X%
    FOR Y% = 480 TO 1 STEP -1: LINE (Xc%, Yc%)-(640, Y%), K%: NEXT Y%
    FOR X% = 640 TO 320 STEP -1: LINE (Xc%, Yc%)-(X%, 1), K%: NEXT X%
AAAAA:
    K% = 11: GOSUB GS00.CADRE
    Titre = "  RECHERCHES POUR MOTS CROISES  "
    L% = 3: GOSUB GS08.GAUCHE: Cr% = 4: GOSUB GS08.REMPLI
    Titre = " TOUT en MAJUSCULES sans ACC. "
    L% = 6: C% = 6: GOSUB GS08.TITRE: Cr% = 1: GOSUB GS08.REMPLI
    
    GOSUB GS21.OPEN: Nb.Mots& = LOF(1) / 32
    LOCATE 11, 7: COLOR 12: PRINT "CINQ Secondes de Patience ..."
 
    FOR Nf1& = 1 TO Nb.Mots&
        GOSUB GS21.LECTURE
        IF LEFT$(Mot, 1) > Init.Pr THEN
            Position.Init&(ASC(LEFT$(Mot, 1))) = Nf1&
            Init.Pr = LEFT$(Mot, 1)
        END IF
    NEXT Nf1&
   
    Position.Init&(91) = Nb.Mots&
    OPEN "C:\DICO\SELECTIO.DIC" FOR RANDOM AS #2 LEN = 28' (Nf2&)
    FIELD #2, 27 AS F.Sel
   
A01.NOUVEAU: ' ***** Nouvelle recherhe
    Lchg% = 5: Cchg% = 3: Lcbd% = 28: Ccbd% = 39
    Ccv% = Cct%: GOSUB GS09.CV
    Lchg% = 2: Cchg% = 41: Lcbd% = 28: Ccbd% = 78
    Ccv% = Cct%: GOSUB GS09.CV
    LOCATE 3, 48: COLOR 11: PRINT "R‚sultats de la Recherche"
    Lc% = 3: Cc% = 48: Nc% = 25: GOSUB GS08.ENCADRE
    FOR L% = 9 TO 27: LOCATE L%, 4: PRINT SPACE$(35): NEXT L%
    FOR L% = 4 TO 27: LOCATE L%, 42: PRINT SPACE$(36): NEXT L%
    Lchg% = 9: Cchg% = 6: Lcbd% = 12: Ccbd% = 37: GOSUB GS09.CV
    LOCATE 10, 10: COLOR Cte%: PRINT "A Rechercher ...."
    LOCATE 13, 5: PRINT "'0000' pour Sortir, ou :"
    LOCATE 13, 6: COLOR 11: PRINT "0000"
    LOCATE 14, 5: COLOR 14: PRINT "Fournir Lettres en leur Position"
    ' ***** A Rechercher
    L% = 11: C% = 10: Nbc% = 15  ' **** Pr‚voir 25 pour autres dicos
    S.Pr = S.Pr1: GOSUB GS07.ALPHA
    IF LEFT$(Saisie, 4) = "0000" GOTO E03.CEFINI
    Saisie = UCASE$(Saisie)
    LOCATE 11, 9: COLOR 10: PRINT "*" + Saisie + "*": S.Pr1 = Saisie
    LOCATE 11, 10: COLOR 13: PRINT Saisie
    ' *** Indiquer Ligne, colonne et nb caractŠres
    Lc% = 11: Cc% = 10: Nc% = Nbc%:
    GOSUB GS08.ENCADRE
    Lchg% = 15: Cchg% = 6: Lcbd% = 18: Ccbd% = 37: GOSUB GS09.CV
    LOCATE 16, 10: COLOR 14: PRINT "Mots Lus ......"
    LOCATE 17, 10: PRINT "S‚lectionn‚s..."
    LOCATE 16, 30: COLOR 13: PRINT USING "######"; Nb.Mots&
    
    LOCATE 4, 49: COLOR 12: PRINT "*" + Saisie + "*"
    LOCATE 4, 50: COLOR 15: PRINT Saisie
    Lc% = 4: Cc% = 50: Nbc% = 25: GOSUB GS08.ENCADRE
   
    A.Rech = RTRIM$(Saisie): A.R% = LEN(A.Rech): Nbc% = 0
    'LOCATE 26, 5: PRINT "*" + A.Rech + "*";
    FOR P% = 1 TO A.R%
        IF MID$(A.Rech, P%, 1) > " " THEN
            Nbc% = Nbc% + 1
        END IF
    NEXT
    
    IF Nbc% < 2 THEN
        M = " Donnez-moi au moins 2 CaractŠres ...... (Pressez Espace)"
        GOSUB GS05.ERREUR: GOTO A01.NOUVEAU
    END IF
    Nf2& = 0: Debut! = TIMER
   
    IF LEFT$(A.Rech, 1) >= "A" AND LEFT$(A.Rech, 1) <= "Z" THEN
        Debut.Recherche& = Position.Init&(ASC(LEFT$(A.Rech, 1)))
        Fin.Recherche& = Position.Init&(ASC(LEFT$(A.Rech, 1)) + 1)
    ELSE
        Debut.Recherche& = 1
        Fin.Recherche& = Nb.Mots&
    END IF
   
    FOR Nf1& = Debut.Recherche& TO Fin.Recherche&
        GOSUB GS21.LECTURE
        'LOCATE 16, 21: COLOR 11: PRINT USING "###### /"; Nf1&
        ' ***** LA LIGNE CI-DESSUS RALENTIT TERRIBLEMENT L'EXECUTION
       
        IF Nf1& MOD 500 = 0 THEN
            LOCATE 16, 21: COLOR 11: PRINT USING "###### /"; Nf1&
        END IF
       
        Correct = "OUI"
            FOR P% = 1 TO A.R%
                ' A.R% est la longueur de la recherche
                ' A.Rech est la recherche … faire dans Mot
                IF MID$(A.Rech, P%, 1) > " " THEN
                  ' ***** Dans cette position, pas de caractere
                  IF MID$(A.Rech, P%, 1) <> MID$(Mot, P%, 1) THEN
                    ' *** Le caractŠre est diff‚rent
                    Correct = "NON": EXIT FOR
                  END IF
                END IF
            NEXT P%
           
            IF Correct = "OUI" THEN
                Nf2& = Nf2& + 1
                LOCATE 17, 30: COLOR 13: PRINT USING "######"; Nf2&
                LSET F.Sel = Mot: PUT #2, Nf2&
                'LOCATE 27, 5: PRINT "-" + F.Sel': SLEEP 1
            END IF
        NEXT Nf1&
   
    LOCATE 16, 21: COLOR 11: PRINT USING "###### /"; Nf1& - 1
    LOCATE 28, 5: COLOR 15: PRINT USING "####.##"; TIMER - Debut!
    IF Nf2& = 0 THEN
        Titre = "   AUCUN MOT DE SELECTIONNE !!   "
        L% = 20: GOSUB GS08.GAUCHE: Cr% = 4: GOSUB GS08.REMPLI
        SLEEP 5: GOTO A01.NOUVEAU
    END IF
    Lchg% = 19: Cchg% = 6: Lcbd% = 21: Ccbd% = 37: GOSUB GS09.CV
    LOCATE 20, 10: COLOR 14: PRINT "Affichage (0 si oui)"
    L% = 20: C% = 31: Nbc% = 1: S.Pr = "0":  GOSUB GS07.ALPHA
    Nf2.Tot& = Nf2&
    IF Saisie <> "0" GOTO A01.NOUVEAU
    LOCATE 22, 5: COLOR 14: PRINT "Presser '*' pour autre recherche"
    LOCATE 22, 14: COLOR 12: PRINT "*"
    LOCATE 23, 5: COLOR 14: PRINT "TOUTES fleches pour se d‚placer"
    LOCATE 23, 5: COLOR 12: PRINT "TOUTES"
    LOCATE 24, 5: COLOR 12: PRINT "'-' pour 500 AVANT"
    LOCATE 24, 9: COLOR 11: PRINT "pour 500"
    LOCATE 25, 5: COLOR 12: PRINT "'+' pour 500 APRES"
    LOCATE 25, 9: COLOR 11: PRINT "pour 500"
    NE2H& = 1: GOSUB A01.AFFICHAGE: GOTO A02.OPTION
 
A01.AFFICHAGE: L% = 4: NE2H.PR& = NE2H&
  
    FOR NE2H& = NE2H& TO NE2H& + 22
        Nf2& = NE2H&: L% = L% + 1: GET #2, Nf2&
        IF Nf2& <= Nf2.Tot& THEN
            COLOR 11: LOCATE L%, 42: PRINT USING "#######"; Nf2&
            COLOR 15: LOCATE L%, 50: PRINT F.Sel
        ELSE
            LOCATE L%, 42: PRINT SPACE$(7)
            LOCATE L%, 50: PRINT SPACE$(25)
        END IF
    NEXT NE2H&
    NE2H& = NE2H.PR&
    RETURN
 
A02.OPTION: K = INKEY$: IF K = "" GOTO A02.OPTION
    SELECT CASE K
        CASE CHR$(27): 
E03.CEFINI:  COLOR 15: CLOSE : KILL "C:\DICO\SELECTIO.DIC"
                                K% = 10: GOSUB GS00.CADRE
                                ' ***** LIGNE 1
                                Ecri = "CRUCIVERBISTE"
                                Y% = 113
                                GOSUB GS02.AFFICHE
                                ' ***** LIGNE 2
                                Ecri = "AUaREVOIR"
                                Y% = 213
                                GOSUB GS02.AFFICHE
                                ' ***** LIGNE 3
                                Ecri = "AZBIENTOT"
                                Y% = 313
                                GOSUB GS02.AFFICHE
                               
                                END
 
        CASE "*", "æ":          GOTO A01.NOUVEAU
        CASE CHR$(0) + "H":     NE2H& = NE2H& - 1
        CASE CHR$(0) + "I":     NE2H& = NE2H& - 23
        CASE CHR$(0) + "P":     NE2H& = NE2H& + 1
        CASE CHR$(0) + "Q":     NE2H& = NE2H& + 23
        CASE "-":               NE2H& = NE2H& - 500
        CASE "+":               NE2H& = NE2H& + 500
        CASE ELSE:              GOTO A02.OPTION
    END SELECT
    IF NE2H& < 1 THEN NE2H& = 1: BEEP
    IF NE2H& > Nf2.Tot& THEN NE2H& = Nf2.Tot&: BEEP
    GOSUB A01.AFFICHAGE: GOTO A02.OPTION
 
GS00.CADRE: CLS
    LINE (1, 1)-(640, 464), 0, BF
    FOR I% = 1 TO 16: LINE (I%, I%)-(I%, 232), K%, , 32752: NEXT I%
    Y% = 234
    FOR X% = 1 TO 16: Y% = Y% - 1: LINE (X%, Y%)-(X%, 464), K%, , 4095: NEXT X%
    FOR I% = 1 TO 16: LINE (I%, I%)-(320, I%), K%, , 32752: NEXT I%
    X% = 322
    FOR Y% = 1 TO 16: X% = X% - 1: LINE (X%, Y%)-(640, Y%), K%, , 4095: NEXT Y%
    Y% = 465
    FOR X% = 1 TO 16: Y% = Y% - 1: LINE (X%, Y%)-(320, Y%), K%, , 32752: NEXT X%
    X% = 322: Y% = 465
    FOR I% = 1 TO 16: X% = X% - 1: Y% = Y% - 1
        LINE (X%, Y%)-(640, Y%), K%, , 4095
    NEXT I%
    X% = 641
    FOR Y% = 1 TO 16: X% = X% - 1: LINE (X%, Y%)-(X%, 232), K%, , 32752: NEXT Y%
    X% = 641: Y% = 234
    FOR I% = 1 TO 16: X% = X% - 1: Y% = Y% - 1
        LINE (X%, Y%)-(X%, 464), K%, , 4095
    NEXT I%
    K% = 12
    LINE (1, 1)-(24, 24), K%, B: LINE (1, 1)-(24, 24), K%
    LINE (1, 24)-(24, 1), K%: PAINT (6, 12), K%, K%
    PAINT (12, 6), K%, K%: PAINT (18, 12), K% - 8, K%
    PAINT (12, 18), K% - 8, K%: LINE (1, 1)-(12, 12), 15
    GET (1, 1)-(24, 24), G&: PUT (1, 220), G&, PSET
    PUT (1, 441), G&, PSET: PUT (308, 1), G&, PSET
    PUT (308, 441), G&, PSET: PUT (617, 1), G&, PSET
    PUT (617, 220), G&, PSET: PUT (617, 441), G&, PSET
    RETURN
 
GS02.AFFICHE: Lg% = 0: Espace% = 10
    FOR P% = 1 TO LEN(Ecri)
        L = MID$(Ecri, P%, 1): L% = ASC(L)
        IF L >= "A" AND L <= "V" THEN
            Lg% = Lg% + Largeur%(L%) + Espace%
        ELSE
            Lg% = Lg% + Espace% * 5
        END IF
    NEXT P%
    Lg% = Lg% - Espace%: X% = 320 - Lg% / 2
    Y1% = Y% - 20: Y2% = Y1% + 80
    X1% = 320 - Lg% / 2 - 20: X2% = 320 + Lg% / 2 + 20
    LINE (X1%, Y1%)-(X2%, Y2%), 12, BF
    Y3% = Y1% + 7: Y4% = Y2% - 7: X3% = X1% + 7: X4% = X2% - 7
    LINE (X3%, Y3%)-(X4%, Y4%), 0, BF
    FOR P% = 1 TO LEN(Ecri)
        L = MID$(Ecri, P%, 1): L% = ASC(L)
            IF L >= "A" AND L <= "V" THEN
                FOR A% = 1 TO 400
                    Lettre&(A%) = LX&(L%, A%)
                NEXT A%
                PUT (X%, Y%), Lettre&, PSET
                X% = X% + Largeur%(L%) + Espace%
            ELSE
                X% = X% + Espace% * 5
            END IF
    NEXT P%
    RETURN
 
GS02.ESPACE: M = "Appuyez sur la TOUCHE ESPACE pour POURSUIVRE"
    GOTO GS05.ERREUR
GS03.BIP: FOR B% = 1 TO 2: PLAY "O2 L32 CC+DD+EFF+": NEXT B%
    RETURN
GS04.SIRENE: FOR Z% = 500 TO 100 STEP -5: SOUND Z%, Z% / 5000: NEXT Z%
    RETURN
' ***** AFFICHAGE MESSAGE en Ligne 30
GS05.ERREUR: Col.Er% = 40 - LEN(M) / 2: GOSUB GS04.SIRENE
    LOCATE 30, Col.Er%: COLOR 14: PRINT M; : GOSUB GS06.ATTENTE
    LOCATE 30, 1: PRINT SPACE$(80);
    RETURN
GS06.ATTENTE: K = INKEY$: IF K = "" GOTO GS06.ATTENTE
    IF K = CHR$(27) THEN COLOR 15: END
    IF K <> " " GOTO GS06.ATTENTE
    RETURN
 
GS07.ALPHA: ' ***** SAISIE ALPHANUMERIQUE
    Lsp% = LEN(S.Pr): IF Lsp% < Nbc% THEN S.Pr = S.Pr + SPACE$(Nbc% - Lsp%)
    P% = 0: S = S.Pr
    Xhg% = (C% - 1) * 8 - 1: Yhg% = (L% - 1) * 16 - 1
    Xbd% = Xhg% + Nbc% * 8 + 2: Ybd% = Yhg% + 18
    LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), 12, B
GS07A: COLOR 15: LOCATE L%, C%: PRINT S
    COLOR 12: LOCATE L%, C% + P%: PRINT MID$(S, P% + 1, 1);
    IF MID$(S, P% + 1, 1) = " " THEN LOCATE L%, C% + P%: PRINT CHR$(14);
GS07B: ' ***** Clignottement
    SELECT CASE INT(TIMER * 10) MOD 4
        CASE 0: LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), 12, B, &HF0F0
        CASE 1: LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), 13, B, &H7878
        CASE 2: LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), 14, B, &H3636
        CASE 3: LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), 15, B, &HF0F0
    END SELECT
    K = INKEY$: IF K = "" GOTO GS07B
    SELECT CASE K
        CASE CHR$(3), CHR$(27):
            CLS : COLOR 15: END     'CTRL + C ou ECHAP
        CASE CHR$(0) + "K" '… Gauche
            IF P% = 0 THEN GOSUB GS04.SIRENE: GOTO GS07B
            P% = P% - 1: GOTO GS07A
        CASE CHR$(0) + "M" '… Droite
            IF P% = Nbc% THEN GOSUB GS04.SIRENE: GOTO GS07B
            P% = P% + 1: GOTO GS07A
        CASE CHR$(13) 'Entr‚e
            IF P% = 0 THEN S = S.Pr: GOTO GS07D ELSE GOTO GS07C
        CASE CHR$(0) + "R" ' Insertion case blanche
            IF RIGHT$(S, 1) <> " " THEN GOSUB GS04.SIRENE
            S = LEFT$(S, P%) + " " + RIGHT$(S, Nbc% - P%)
            S = LEFT$(S, Nbc%): GOTO GS07A
        CASE CHR$(0) + "S" ' Suppression
            S = LEFT$(S, P%) + RIGHT$(S, Nbc% - P% - 1) + " ": GOTO GS07A
        CASE CHR$(0) + "G" ' Retour au D‚but
            P% = 0: GOTO GS07A
        CASE CHR$(0) + "O" ' … la fin
            P% = LEN(RTRIM$(S)): GOTO GS07A
        CASE CHR$(8) ' Effacement caractŠre pr‚c‚dent
            IF P% = 0 THEN GOSUB GS04.SIRENE: GOTO GS07B
            IF P% = 1 THEN
                S = RIGHT$(S, Nbc% - 1) + " "
            ELSE
                S = LEFT$(S, P% - 1) + RIGHT$(S, Nbc% - P%) + " "
            END IF
            P% = P% - 1: GOTO GS07A
        CASE CHR$(9), CHR$(29)
            GOSUB GS03.BIP: GOTO GS07A
        CASE ELSE
            P% = P% + 1
            IF P% > Nbc% THEN GOSUB GS04.SIRENE: P% = Nbc%: GOTO GS07A
            MID$(S, P%, 1) = K: GOTO GS07A
    END SELECT
GS07C: IF P% = Nbc% GOTO GS07D
    Pk% = INSTR(S, "æ"): IF Pk% = 0 THEN Pk% = INSTR(S, "*")
    IF Pk% > 0 THEN S = LEFT$(S, Pk% - 1)
    Ls% = LEN(S): IF Ls% < Nbc% THEN S = S + SPACE$(Nbc% - Ls%)
GS07D: LOCATE L%, C%: COLOR Cds%: PRINT S
    Saisie = S: LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), Cfd%, B
    RETURN
 
' ***** TITRE ENTOURE d'un CADRE *****
GS08.GAUCHE: L% = L% - 1: C% = 4: GOTO GS08.TITRE
GS08.CENTRE: L% = L% - 1: C% = 39 - LEN(Titre) / 2: GOTO GS08.TITRE
GS08.DROIT: L% = L% - 1: C% = 76 - LEN(Titre)
GS08.TITRE: Lg% = LEN(Titre): COLOR Cct%
    LOCATE L%, C%: PRINT "É"; STRING$((Lg%), "Í"); "»"
    LOCATE L% + 1, C%: PRINT "º": LOCATE L% + 1, C% + Lg% + 1: PRINT "º"
    LOCATE L% + 2, C%: PRINT "È"; STRING$((Lg%), "Í"); "¼"
    LOCATE L% + 1, C% + 1: COLOR Cte%: PRINT Titre;
    RETURN
GS08.REMPLI: Xg% = C% * 8: Xd% = (C% + Lg%) * 8 + 1
    Yh% = (L%) * 16 - 6: Yb% = Yh% + 26
    FOR X% = Xg% TO Xd%: FOR Y% = Yh% TO Yb%
        IF POINT(X%, Y%) = 0 THEN PSET (X%, Y%), Cr%
    NEXT Y%, X%
    RETURN
GS08.ENCADRE: Xchg% = (Cc% - 1) * 8 + 1: Ychg% = (Lc% - 1) * 16 + 1
    Xcbd% = (Cc% + Nc% - 1) * 8: Ycbd% = Ychg% + 14: Kc% = 15
    LINE (Xchg%, Ychg%)-(Xcbd%, Ycbd%), Kc%, B, &H3333
    LINE (Xchg%, Ychg%)-(Xcbd%, Ycbd%), 12, B, &HCCCC
    RETURN
 
' ***** AFFICHAGE CADRE VIDE *****
GS09.CV: COLOR Ccv%
    LOCATE Lchg%, Cchg%: PRINT "É"; STRING$((Ccbd% - Cchg% - 1), "Í"); "»"
    LOCATE Lcbd%, Cchg%: PRINT "È"; STRING$((Ccbd% - Cchg% - 1), "Í"); "¼"
    FOR L% = Lchg% + 1 TO Lcbd% - 1
        LOCATE L%, Cchg%: PRINT "º": LOCATE L%, Ccbd%: PRINT "º"
    NEXT L%
    RETURN
 
' ***** FICHIER Dictionnaire
GS21.OPEN: OPEN "C:\DICO\DIC_ODS3.ODS" FOR RANDOM AS #1 LEN = 32
    FIELD #1, 31 AS F.Mot, 1 AS F.Sup
    RETURN
GS21.LECTURE: GET #1, Nf1&
    Mot = F.Mot: Sup = F.Sup
    RETURN
 
v6 © Computaid SPRL 2005-2012 - Tous droits réservés - Hébergé par eTigris - Page générée en 0,040 s - Crédits - Stats
1 connecté