| 10 ' LABELMATIC / disc - AMSTRAD CPC
20 ' Michel Archambault - juillet 1985 30 ' Copyright ARCHAMBAULT/SORACOM 1985 40 GOSUB 51000 50 OPENOUT "BIDON" 60 MEMORY HIMEM-1 70 CLOSEOUT 100 MODE 0:BORDER 16:INK 0,1:INK 1,24:PAPER 11:CLS 110 LOCATE 1,7:PEN 12:PRINT "L A B E L--M A T I C" 120 LOCATE 1,13:PEN 4:PRINT "Editeur d'Etiquettes 130 LOCATE 2,21:PEN 0:PRINT "M.Achambault-1985" 140 FOR I=1 TO 3000:NEXT 200 MODE 1:BORDER 2:PAPER 0:PEN 1:CLS 210 DIM AD$(200,5):DEFINT A-Z 1000 'MENU PRINCIPAL 1010 CLS:INK 0,1:INK 1,24 1020 LOCATE 17,2:PEN 3:PRINT "M E N U":PEN 2:LOCATE 29,2:PRINT NF;"fiches":PEN 1 1030 LOCATE 6,4:PRINT "N = Nouveau fichier" 1040 LOCATE 6,6:PRINT "C = Chargement-lecture d'un fichier" 1050 LOCATE 6,8:PRINT "S = Suite d'un fichier chargé" 1060 LOCATE 6,10:PRINT "M = Modification du fichier" 1070 LOCATE 6,12:PRINT "E = Enregistrement sur disquette" 1080 LOCATE 6,14:PRINT "V = Visionner ou rechercher" 1090 LOCATE 6,16:PRINT "L = impression en LABELS" 1100 LOCATE 6,18:PRINT "G = impression GLOBALE(en lignes)" 1105 LOCATE 6,20:PRINT "T = TRI du Fichier" 1110 LOCATE 6,22:PRINT "F = Fin" 1150 TEX$="NCSMEVLGTF":GOSUB 50000 1160 ON K GOTO 2000,3000,4000,5000,6000,7000,8000,9000,12000,1500 1170 GOTO 1000 1500 'FINAL 1510 CLS:LOCATE 10,12:PRINT "VOUS POUVEZ ETEINDRE.":PRINT:PRINT 1520 END 2000 ' NOUVEAU FICHIER 2010 CLS 2020 LOCATE 6,4:PRINT "CREATION D'UN NOUVEAU FICHIER:" 2030 LOCATE 12,7:PRINT "( 200 fiches maxi )" 2040 LOCATE 3,12:PRINT "Nous effaçons le Fichier en Mémoire." 2050 LOCATE 15,14:PRINT "D'ACCORD ?" 2060 TEX$="ON":GOSUB 50000 2070 IF K=2 THEN 1000 2080 N=1:NF=0:GOSUB 10000 2090 NF=N:GOTO 1000 3000 ' CHARGEMENT FICHIER 3010 CLS:LOCATE 3,3:PRINT "LECTURE D'UN FICHIER SUR DISQUETTE:" 3020 LOCATE 16,10:PRINT "D'ACCORD ?" 3030 TEX$="ON":GOSUB 50000 3040 IF K=2 THEN 1000 3050 CLS:LOCATE 12,5:INPUT "NOM DU FICHIER: ",FICH$ 3055 IF LEN(FICH$) >8 THEN FICH$=LEFT$(FICH$,8) ELSE IF FICH$="" THEN 3050 3060 LOCATE 3,8:PRINT "Dés que la Disquette est positionnée" 3070 LOCATE 11,10:PRINT "Pressez une Touche." 3080 WHILE INKEY$="":WEND 3090 OPENIN FICH$ 3100 INPUT #9,NF,FICH$:FOR I=1 TO NF:FOR J=0 TO 5:INPUT #9,AD$(I,J):NEXT:NEXT 3110 CLOSEIN 3120 LOCATE 12,15:PRINT "Il-y-a";nf;"Fiches." 3130 FOR I=1 TO 2500:NEXT 3140 GOTO 1000 4000 'SUITE DE SAISIE 4010 CLS 4020 LOCATE 2,4:PRINT "SUITE DE SAISIE DU FICHIER EN MEMOIRE." 4030 LOCATE 16,10:PRINT "D'ACCORD ?":TEX$="ON":GOSUB 50000 4040 IF K=2 THEN 1000 4050 N=NF+1:GOSUB 10000:NF=N 4060 GOTO 1000 5000 'MODIFICATION 5010 CLS 5020 LOCATE 10,5:PRINT "MODIFICATION DE FICHE:" 5030 LOCATE 12,11:PRINT "( Pour FIN --> 0 )" 5040 LOCATE 12,9:INPUT "QUEL NUMERO ?",NR$ 5050 IF NR$="0" THEN 1000 5060 NR=VAL(NR$):IF NR=0 OR NR>NF THEN PRINT CHR$(7):GOTO 5040 5070 N=NR:GOSUB 10000:GOTO 5000 6000 'ENREGISTREMENT 6010 CLS:LOCATE 7,5:PRINT "ENREGISTREMENT SUR DISQUETTE" 6020 LOCATE 16,10:PRINT "D'ACCORD ?":TEX$="ON":GOSUB 50000 6030 IF K=2 THEN 1000 6040 LOCATE 1,24:PRINT CHR$(18):LOCATE 8,10:PRINT "Préparez une Disquette" 6050 LOCATE 13,12:PRINT "non protègée." 6070 LOCATE 12,15:INPUT"NOM DU FICHIER: ",FICH$ 6075 IF LEN(FICH$) >8 THEN FICH$=LEFT$(FICH$,8) ELSE IF FICH$="" THEN 6070 6080 OPENOUT FICH$ 6090 WRITE #9,NF,FICH$:FOR I=1 TO NF:FOR J=0 TO 5:WRITE #9,AD$(I,J):NEXT:NEXT 6100 CLOSEOUT 6200 GOTO 1000 7000 'VISIONNER,RECHERCHER 7010 CLS:LOCATE 12,4:PRINT "VISION ou RECHERCHE:" 7020 LOCATE 6,8:PRINT "T = TOUS,depuis le début." 7030 LOCATE 6,10:PRINT "N = Numéro." 7035 LOCATE 6,12:PRINT "R = Recherche d'un Nom" 7040 LOCATE 6,14:PRINT "F = FIN." 7050 TEX$="TNRF":GOSUB 50000 7060 ON K GOTO 7100,7200,7300,7500 7100 N=1:GOSUB 11000:GOTO 7000 7200 LOCATE 12,16:INPUT "QUEL NUMERO ?",NR$ 7210 NR=VAL(NR$):IF NR=0 OR NR>NF THEN PRINT CHR$(7):GOTO 7200 7220 N=NR:GOSUB 11000:GOTO 7000 7300 LOCATE 12,17:LINE INPUT "NOM cherché:",NM$ 7310 FOR N=1 TO NF 7320 IF INSTR(3,AD$(N,0),NM$)>0 THEN GOSUB 11000 7330 NEXT 7500 GOTO 1000 8000 ' IMPRESSION 2 LABELS / 80 col. 8010 CLS:LOCATE 8,5:PRINT "IMPRESSION DES ETIQUETTES:":LOCATE 16,11:PRINT "D'ACCORD ?" 8020 TEX$="ON":GOSUB 50000:IF K=2 THEN 1000 8030 CLS:LOCATE 7,5:PRINT "Deux Etiquettes par Rangée." 8040 LOCATE 12,8:INPUT "NUMERO DEPART: ",ND$:ND=VAL(ND$):IF ND=0 OR ND>=NF THEN PRINT CHR$(7):GOTO 8040 8050 LOCATE 14,12:PRINT "( D pour dernier )" 8060 LOCATE 13,10:INPUT "NUMERO FINAL: ",NA$:IF UPPER$(NA$)="D" THEN NA=NF:GOTO 8080 8070 NA=VAL(NA$):IF NA<=ND OR NA>NF THEN 8060 8080 LOCATE 10,17:PRINT "Vérifiez l'Imprimante,":LOCATE 9,19:PRINT "puis pressez une Touche." 8090 WHILE INKEY$="":WEND 8100 PRINT #8,CHR$(27)"R"CHR$(1); 8120 FOR I=ND TO NA STEP 2 8130 PRINT #8,SPC((37-LEN(AD$(I,0)))/2);AD$(I,0);SPC((43-LEN(AD$(I,0)))/2);SPC((40-LEN(AD$(I+1,0)))/2);AD$(I+1,0) 8140 PRINT #8,SPC((37-LEN(AD$(I,1)))/2);AD$(I,1);SPC((43-LEN(AD$(I,1)))/2);SPC((40-LEN(AD$(I+1,1)))/2);AD$(I+1,1) 8150 PRINT #8,SPC((37-LEN(AD$(I,2)))/2);AD$(I,2);SPC((43-LEN(AD$(I,2)))/2);SPC((40-LEN(AD$(I+1,2)))/2);AD$(I+1,2) 8160 PRINT #8,SPC((36-LEN(AD$(I,3))-LEN(AD$(I,4)))/2);AD$(I,3);" ";AD$(I,4);SPC((42-LEN(AD$(I,3))-LEN(AD$(I,4)))/2);SPC((41-LEN(AD$(I+1,3))-LEN(AD$(I+1,4)))/2);AD$(I+1,3);" ";AD$(I+1,4) 8170 PRINT #8,SPC(17);AD$(I,5);SPC(42);AD$(I+1,5) 8180 FOR J=1 TO 4:PRINT #8:NEXT 8190 NEXT 8200 GOTO 1000 9000 ' IMPRESSION GLOBALE 9010 CLS:LOCATE 12,5:PRINT "IMPRESSION GLOBALE:" 9020 LOCATE 12,7:PRINT "( ligne à ligne )":LOCATE 16,11:PRINT "D'ACCORD ?" 9030 TEX$="ON":GOSUB 50000:IF K=2 THEN 1000 9040 CLS:LOCATE 10,5:PRINT "Préparez l'Imprimante,":LOCATE 9,10:PRINT "puis pressez une Touche." 9050 WHILE INKEY$="":WEND 9060 PRINT #8,CHR$(27)"R"CHR$(1);SPC((80-LEN(FICH$))/2);FICH$ 9070 PRINT #8:FOR I=1 TO NF 9090 PRINT #8,USING "###";I;:PRINT#8,"-";AD$(I,0);":";AD$(I,1);" ";AD$(I,2);" ";AD$(I,3);" ";AD$(I,4);" *Secteur ";AD$(I,5):NEXT 9100 PRINT #8,STRING$(78,"_") 9110 GOTO 1000 10000 ' SAISIE 10010 CLS:INK 0,13:INK 1,0 10020 LOCATE 10,2:PRINT "SAISIE FICHE NUMERO";N 10030 LOCATE 13,5:PRINT STRING$(22,CHR$(144));CHR$(151) 10040 LOCATE 8,5:LINE INPUT "NOM: ",AD$(N,0) 10050 IF LEN(AD$(N,0))>22 THEN AD$(N,0)=LEFT$(AD$(N,0),22):PRINT CHR$(7) 10060 LOCATE 13,7:PRINT STRING$(22,CHR$(144));CHR$(151) 10070 LOCATE 2,7:LINE INPUT "ADRESSE 1: ",AD$(N,1) 10080 IF LEN(AD$(N,1))>22 THEN AD$(N,1)=LEFT$(AD$(N,1),22):PRINT CHR$(7) 10090 LOCATE 13,9:PRINT STRING$(22,CHR$(144));CHR$(151) 10100 LOCATE 2,9:LINE INPUT "ADRESSE 2: ",AD$(N,2) 10110 IF LEN(AD$(N,2))>22 THEN AD$(N,2)=LEFT$(AD$(N,2),22):PRINT CHR$(7) 10120 LOCATE 13,11:PRINT STRING$(5,CHR$(144));CHR$(151) 10130 LOCATE 2,11:INPUT "CODE POST: ",AD$(N,3) 10140 LOCATE 13,13:PRINT STRING$(16,CHR$(144));CHR$(151) 10150 LOCATE 6,13:LINE INPUT "VILLE: ",AD$(N,4) 10160 IF LEN(AD$(N,4))>16 THEN AD$(N,4)=LEFT$(AD$(N,4),16):PRINT CHR$(7) 10170 LOCATE 13,15:PRINT STRING$(3,CHR$(144));CHR$(151) 10180 LOCATE 4,15:INPUT "SECTEUR: ",AD$(N,5) 10190 LOCATE 2,19:PRINT "SUITE (S) , ERREUR (E) , FIN (F) ?" 10200 TEX$="SEF":GOSUB 50000 10210 IF K=1 THEN N=N+1:GOTO 10000 10220 IF K=2 THEN 10000 10230 RETURN 11000 'AFFICHAGE 11010 CLS:INK 0,13:INK 1,0 11020 LOCATE 10,2:PRINT "VISION FICHE NUMERO";N 11030 LOCATE 8,5:PRINT "NOM: ";AD$(N,0) 11040 LOCATE 2,7:PRINT "ADRESSE 1: ";AD$(N,1) 11050 LOCATE 2,9:PRINT "ADRESSE 2: ";AD$(N,2) 11060 LOCATE 2,11:PRINT "CODE POST: ";AD$(N,3) 11070 LOCATE 6,13:PRINT "VILLE: ";AD$(N,4) 11080 LOCATE 4,15:PRINT "SECTEUR: ";AD$(N,5) 11090 LOCATE 8,19:PRINT "Précèdent , Suivant , Fin" 11100 TEX$="PSF":GOSUB 50000:ON K GOTO 11200,11300,11400 11200 N=N-1:IF N=0 THEN PRINT CHR$(7):N=1 11210 GOTO 11010 11300 N=N+1:IF N>NF THEN PRINT CHR$(7):N=NF 11310 GOTO 11010 11400 RETURN 12000 'TRI 12010 CLS:LOCATE 13,4:PRINT "TRI DU FICHIER:":LOCATE 16,11:PRINT "D'ACCORD ?":TEX$="ON":GOSUB 50000:IF K=2 THEN 1000 12020 CLS:LOCATE 13,4:PRINT "CRITERE DU TRI:":LOCATE 9,8:PRINT "N = NOM" 12030 LOCATE 9,10:PRINT "A = ADRESSE 1":LOCATE 9,12:PRINT "L = Lieu-dit (adresse 2)":LOCATE 9,14:PRINT "C = Code postal" 12040 LOCATE 9,16:PRINT "V = VILLE":LOCATE 9,18:PRINT "S = SECTEUR" 12050 TEX$="NALCVS":GOSUB 50000:T=K-1:LOCATE 16,21:PRINT "Patience..." 12060 F=0:FOR J=1 TO NF 12070 IF AD$(J,T)>=AD$(J-1,T) THEN 12090 12080 FOR R=0 TO 5:AD$(0,R)=AD$(J,R):AD$(J,R)=AD$(J-1,R):AD$(J-1,R)=AD$(0,R):NEXT:F=1 12090 NEXT 12100 IF F=1 THEN 12060 12110 GOTO 1000 50000 'REPONSE A UN MENU 50010 LT=LEN(TEX$):R$="" 50020 LOCATE 15-LT,24:PRINT "Réponse ("; 50030 FOR I=1 TO LT-1 50040 PRINT MID$(TEX$,I,1);",";:NEXT 50050 PRINT RIGHT$(TEX$,1);")";CHR$(154);CHR$(243);CHR$(207) 50060 TEX$=UPPER$(TEX$) 50070 WHILE R$="":R$=INKEY$:WEND 50080 R$=UPPER$(R$):K=INSTR(TEX$,R$) 50090 IF K=0 THEN R$="":PRINT CHR$(7);:GOTO 50070 50100 RETURN 51000 ' AZERTY ACCENTUE 51010 SYMBOL AFTER 8 51020 SYMBOL 64,96,48,120,12,124,204,118,0 51030 SYMBOL 91,0,56,108,56,0,0,0,0 51040 SYMBOL 92,0,0,60,102,96,102,60,24 51050 SYMBOL 93,60,96,60,102,60,6,60,0 51060 SYMBOL 123,12,24,60,102,126,96,60,0 51070 SYMBOL 124,48,24,102,102,102,102,62,0 51080 SYMBOL 125,48,24,60,102,126,96,60,0 51100 RETURN 65535 'FIN DE LISTING |