'
'   JM. :: Hecho en Ronda
'
'
'  Procedente de...        es.geocities.com/jm00092
'
'______________________________________________________________________
'                          
'
'               PROGRAMA BASIC PARA RECONOCIMIENTO DE ADITIOS
'
'
'
DECLARE SUB salida ()
DECLARE FUNCTION numero! (nomb$)
DECLARE SUB caja (F1!, C1!, F2!, C2!, papel!, marco!, FONDO!, sombra!)
DECLARE SUB inicio ()
DECLARE FUNCTION nota$ (num!)
DECLARE FUNCTION nombre$ (num$)

DIM SHARED mat$(1 TO 10, 1 TO 5)

'1=E...
'2=Toxico/No txico
'3=CEE
'4=Nombre
'5=notas

inicio

COLOR 15, 1: LOCATE 13, 15: INPUT "", cad$

cad$ = UCASE$(cad$)
IF cad$ = "" THEN BEEP: salida


cad$ = cad$ + "-"
p = 0
Linea$ = ""
FOR n = 1 TO LEN(cad$)
   letra$ = MID$(cad$, n, 1)
   SELECT CASE letra$
      CASE "-": p = p + 1: mat$(p, 1) = Linea$: Linea$ = ""
      CASE ELSE: Linea$ = Linea$ + letra$
   END SELECT
NEXT
IF p > 10 THEN p = 10
NUMLINEAS = p
FOR n = 1 TO NUMLINEAS
   PRINT mat$(n, 1)
NEXT

COLOR 7, 7: LOCATE 3
FOR n = 3 TO 24
   PRINT SPACE$(80);
NEXT


caja 5, 6, 16, 40, 7, 15, 0, 8
caja 5, 44, 16, 75, 7, 1, 3, 8

caja 18, 6, 23, 75, 7, 1, 3, 8
LOCATE 8, 45: PRINT STRING$(30, "")
LOCATE 14, 45: PRINT STRING$(30, "")


 COLOR 7, 5: LOCATE 25, 1: PRINT "      Moverse por la lista de aditivos        Salir                     ";
COLOR 15, 5: LOCATE 25, 1: PRINT "   ";
COLOR 15, 5: LOCATE 25, 43: PRINT "ESC";
COLOR 15, 5: LOCATE 25, 65: PRINT "Hecho en Ronda  ";


FOR nnn = 1 TO NUMLINEAS
   IF LEN(mat$(nnn, 1)) > 4 THEN mat$(nnn, 1) = MID$(mat$(nnn, 1), 1, 4) + "."
   IF MID$(mat$(nnn, 1), 1, 1) <> "E" THEN mat$(nnn, 3) = "No reconocido por la CEE":  ELSE mat$(nnn, 3) = "                        "

   nom$ = nombre$(mat$(nnn, 1))
   C = 7
   SELECT CASE MID$(nom$, 24, 2)
      CASE "  ": mat$(nnn, 2) = "No txico          ": C = 10
      CASE "* ": mat$(nnn, 2) = "Posiblemente txico": C = 14
      CASE "":   mat$(nnn, 2) = "No txico          ": C = 10
      CASE "*":  mat$(nnn, 2) = "Posiblemente txico": C = 14
      CASE "**": mat$(nnn, 2) = "TXICO             ": C = 12
   END SELECT

   mat$(nnn, 4) = MID$(nom$, 1, 23)

   numnota = VAL(MID$(nom$, 27, 2))
   COLOR 15
   IF numnota > 0 THEN
      mat$(nnn, 5) = nota$(numnota)
   END IF


   IF mat$(nnn, 4) = "No encontrado" THEN
      mat$(nnn, 2) = ""
      mat$(nnn, 3) = ""
      mat$(nnn, 5) = ""
      C = 7
   END IF


   LOCATE nnn + 5, 8: COLOR C, 0: PRINT mat$(nnn, 1), mat$(nnn, 4)
  
NEXT

cual = NUMLINEAS + 1


DO
   DO
      kbd$ = INKEY$
   LOOP WHILE kbd$ = ""
  
   FOR nnn = 1 TO NUMLINEAS
      SELECT CASE mat$(nnn, 2)
         CASE "No txico          ": C = 10
         CASE "Posiblemente txico": C = 14
         CASE "TXICO             ": C = 12
         CASE ELSE: C = 7
      END SELECT
      LOCATE nnn + 5, 7: COLOR C, 0: PRINT SPACE$(33)
      LOCATE nnn + 5, 8:  PRINT mat$(nnn, 1), mat$(nnn, 4)
   NEXT

   SELECT CASE kbd$
      CASE CHR$(0) + "P": cual = cual + 1
      CASE CHR$(0) + "H": cual = cual - 1
      CASE CHR$(27): salida
      CASE ELSE: SOUND 3000, .4
   END SELECT

   IF cual > NUMLINEAS THEN cual = 1
   IF cual < 1 THEN cual = NUMLINEAS

   SELECT CASE mat$(cual, 2)
      CASE "No txico          ": C = 10
      CASE "Posiblemente txico": C = 14
      CASE "TXICO             ": C = 12
      CASE ELSE: C = 7
   END SELECT
   LOCATE cual + 5, 7: COLOR C, 1: PRINT SPACE$(33)
   LOCATE cual + 5, 8:  PRINT mat$(cual, 1), mat$(cual, 4)


   nu = numero(mat$(cual, 1))
   SELECT CASE nu
      CASE 100 TO 199: quee$ = "Colorante"
      CASE 200 TO 299: quee$ = "Conservante"
      CASE 300 TO 406: quee$ = "Antoxidante o emulsionante"
      CASE 407 TO 599: quee$ = "Estabilizante"
      CASE 600 TO 999: quee$ = "Aromatizante"
      CASE ELSE: quee$ = ""
   END SELECT

   IF mat$(cual, 4) = "No encontrado" THEN quee$ = ""
   COLOR 0, 3
   LOCATE 6, 46: PRINT SPACE$(28)
   LOCATE 7, 46: PRINT SPACE$(28)
   LOCATE 10, 48: PRINT SPACE$(26)
   LOCATE 12, 50: PRINT SPACE$(24)
   LOCATE 15, 46: PRINT SPACE$(28)

   LOCATE 6, 46: PRINT mat$(cual, 1)
   LOCATE 7, 46: PRINT mat$(cual, 4)
   LOCATE 10, 48: PRINT quee$
   LOCATE 12, 50: PRINT mat$(cual, 2)
   LOCATE 15, 46: PRINT mat$(cual, 3)

   FOR n = 19 TO 22
      LOCATE n, 8: PRINT SPACE$(66)
   NEXT
   COLOR 12, 3
   LOCATE 19, 8: PRINT MID$(mat$(cual, 5), 1, 66)
   LOCATE 20, 8: PRINT MID$(mat$(cual, 5), 67, 66)
   LOCATE 21, 8: PRINT MID$(mat$(cual, 5), 133, 66)
   LOCATE 22, 8: PRINT MID$(mat$(cual, 5), 199, 66)

LOOP

'
'   JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                          
SUB caja (F1, C1, F2, C2, papel, marco, FONDO, sombra) STATIC
IF F2 - F1 = 0 THEN : marco = FONDO
COLOR marco, FONDO
ANCHO = C2 - C1 + 1
LOCATE F1, C1
PRINT ""; STRING$(ANCHO - 2, ""); "";
LOCATE F1, C1 + ANCHO: COLOR sombra, papel: PRINT "";
FOR a = F1 + 1 TO F2 - 1
   LOCATE a, C1
   COLOR marco, FONDO: PRINT ""; SPACE$(ANCHO - 2); "";
   LOCATE a, C1 + ANCHO: COLOR sombra, papel: PRINT "";
NEXT a
LOCATE F2, C1
COLOR marco, FONDO: PRINT ""; STRING$(ANCHO - 2, ""); "";
IF F2 - F1 > 0 THEN : LOCATE F2, C1 + ANCHO: COLOR sombra, papel: PRINT "";
LOCATE F2 + 1, C1 + 1: COLOR sombra, papel:  PRINT STRING$(ANCHO, "");
COLOR marco, FONDO
END SUB

'
'   JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                          
SUB inicio

SCREEN 0
COLOR 0, 7: CLS
PALETTE 3, 63
PALETTE 6, 62
PALETTE 5, 56
PALETTE 12, 36
PALETTE 10, 50
PALETTE 1, 9
COLOR 15, 1:  PRINT "                 PROGRAMA BASIC PARA RECONOCIMIENTO DE ADITIVOS                 "
COLOR 0, 3:  PRINT "  Entrada                                                                       "

 COLOR 7, 5: LOCATE 25, 1: PRINT "   Un momento, por favor                                                ";
COLOR 15, 5: LOCATE 25, 65: PRINT "Hecho en Ronda  ";

caja 9, 21, 18, 60, 7, 1, 6, 8

LOCATE 11, 25: PRINT "        A D I T I V O S"
LOCATE 13, 25: PRINT "              1.0"
LOCATE 16, 25: PRINT " Hecho en Ronda  Junio de 1997"

SLEEP 2

COLOR 7, 7: LOCATE 3
FOR n = 3 TO 20
   PRINT SPACE$(80);
NEXT

COLOR 7, 5: LOCATE 25, 1: PRINT "   Para empezar rellenar este cuadro de dilogo                         ";
COLOR 15, 5: LOCATE 25, 65: PRINT "Hecho en Ronda  ";
caja 7, 10, 19, 71, 7, 0, 3, 8
LOCATE 9, 14: PRINT "Nombre del producto:"
LOCATE 12, 14: PRINT "Nmeros que aparecen en la etiqueta:"
COLOR 1: LOCATE 10, 14: PRINT STRING$(53, 219)
COLOR 7: LOCATE 13, 14: PRINT STRING$(53, 219)

COLOR 15, 1: LOCATE 10, 15: INPUT "", np$
IF np$ = "" THEN np$ = "Producto sin determinar"

COLOR 1: LOCATE 13, 14: PRINT STRING$(53, 219)

COLOR 7, 3
LOCATE 14, 14: PRINT "Son nmeros de tres cifras que pueden llevar o no"
LOCATE 15, 14: PRINT "delante la letra E mayscula. Escribir hasta un"
LOCATE 16, 14: PRINT "mximo de 10 separados por guiones."
LOCATE 17, 14: PRINT "Ejemplo: E420-E153-375-E481-442-E307-927-622"

COLOR 0, 3:  LOCATE 2, 1: PRINT SPACE$(80)
LOCATE 2, 3: PRINT np$


END SUB

'
'   JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                          
FUNCTION nombre$ (num$)

num = numero(num$)

SELECT CASE num

CASE 100: n$ = "Curcmina"
CASE 101: n$ = "Lactoflavina"
CASE 102: n$ = "Tartraina              **"
CASE 104: n$ = "Quinoleina             **"
CASE 107: n$ = "Amarillo 2G            ** 1"
CASE 110: n$ = "Amarillo Sunset        **"
CASE 120: n$ = "Cochinilla             *  2"
CASE 122: n$ = "Carmisina o Azorrubina **"
CASE 123: n$ = "Amaranto               **"
CASE 124: n$ = "Ponceau 4R             **"
CASE 127: n$ = "Eritrosina             **"
CASE 128: n$ = "Rojo 2G                **"
CASE 131: n$ = "Azul Potente V         **"
CASE 132: n$ = "Carmn ndigo          **"
CASE 133: n$ = "Azul Brillante         **"
CASE 140 TO 141: n$ = "Clorofila"
CASE 142: n$ = "Verde lisamina         **"
CASE 150: n$ = "Caramelo               *  3"
CASE 151: n$ = "Negro PN               **"
CASE 153: n$ = "Carbn"
CASE 154: n$ = "Marrn FK              **"
CASE 155: n$ = "Marrn HT              **"
CASE 160 TO 162: n$ = "Similar a Vitamina A"
CASE 163: n$ = "Antocianina"
CASE 170: n$ = "Yeso"
CASE 171: n$ = "Oxido de titanio"
CASE 172: n$ = "Oxido de hierro"
CASE 173: n$ = "Aluminio               *"
CASE 174: n$ = "Plata                  *"
CASE 175: n$ = "Oro                    *"
CASE 180: n$ = "Pigmento de rub       **"
CASE 200: n$ = "cido srbico"
CASE 201 TO 203: n$ = "Sorbato"
CASE 210: n$ = "cido benzoico         **"
CASE 211 TO 213: n$ = "Benzoato               **"
CASE 214 TO 219: n$ = "Benzoato complejo      ** 4"
CASE 220: n$ = "Dixido de azufre      ** 5"
CASE 221 TO 229: n$ = "Sulfito                ** 5"
CASE 230 TO 232: n$ = "Binefilo               **"
CASE 233: n$ = "Tiabendazol               7"
CASE 234: n$ = "Misina                    7"
CASE 236: n$ = "cido frmico          *  8"
CASE 237 TO 238: n$ = "Formiato               *  8"
CASE 239: n$ = "Hexamina               ** 9"
CASE 249 TO 252: n$ = "Nitrito o nitrato      ** 10"
CASE 260: n$ = "cido actico"
CASE 261 TO 263: n$ = "Acetato"
CASE 270: n$ = "cido lctico          *  11"
CASE 280: n$ = "cido propionico"
CASE 281 TO 283: n$ = "Propionatos               12"
CASE 290: n$ = "Dixido de carbono     *  13"
CASE 296: n$ = "cido mlico"
CASE 297: n$ = "cido fumrico"

CASE 300 TO 304: n$ = "Ascorbato"
CASE 306: n$ = "Vitamina E"
CASE 307 TO 309: n$ = "Tocoferol sinttico"
CASE 310 TO 312: n$ = "Galato                 ** 14"
CASE 320: n$ = "BHA                    ** 15"
CASE 321: n$ = "BHT                    ** 15"
CASE 322: n$ = "Lecitina"
CASE 325 TO 327: n$ = "Lactatos               *  15"
CASE 330: n$ = "cido ctrico"
CASE 331 TO 333: n$ = "Citrato"
CASE 334 TO 337: n$ = "Tartrato"
CASE 338 TO 341: n$ = "Fosfato"
CASE 350 TO 352: n$ = "Malato"
CASE 353: n$ = "cido metatartrico"
CASE 355: n$ = "cido adpico"
CASE 365: n$ = "cido succnico"
CASE 370: n$ = "Heptonolactona         *"
CASE 375: n$ = "cido nicotnico"
CASE 380 TO 381: n$ = "Citrato"
CASE 385: n$ = "Sal de EDTA            *  17"
CASE 400: n$ = "cido algnico"
CASE 401 TO 405: n$ = "Alginato"
CASE 406: n$ = "Agar-agar"

CASE 407: n$ = "Carraginina"
CASE 410: n$ = "Goma de algarroba"
CASE 412: n$ = "Goma de guar"
CASE 413: n$ = "Goma tragacanto"
CASE 415 TO 416: n$ = "Gomas naturales"
CASE 420: n$ = "Sorbitol"
CASE 421: n$ = "Mantiol                   19"
CASE 422: n$ = "Glicerina"
CASE 430 TO 431: n$ = "Estearato              ** 20"
CASE 432 TO 436: n$ = "Polioxietileno         *  21"
CASE 440: n$ = "Pectina"
CASE 442: n$ = "Fosftido amnico      *"
CASE 450: n$ = "Polifosfato            ** 22"
CASE 460 TO 461: n$ = "Celulosa"
CASE 463 TO 466: n$ = "Celulosa"
CASE 470 TO 478: n$ = "Grasa o jabn          *  23"
CASE 481 TO 483: n$ = "Estearilo              *"
CASE 491 TO 495: n$ = "Sorbitano              *  24"
CASE 500 TO 504: n$ = "Carbonato"
CASE 507 TO 510: n$ = "Cloruro                *  25"
CASE 513: n$ = "cido sulfrico        *  26"
CASE 514: n$ = "Sulfato sdico         *"
CASE 515: n$ = "Sulfato potsico"
CASE 516: n$ = "Sulfato clcico"
CASE 518: n$ = "Sulfato magnsico"
CASE 524: n$ = "Hidrxido sdico       *  26"
CASE 525: n$ = "Hidrxido potsico     *  26"
CASE 526: n$ = "Hidrxido clcico"
CASE 527: n$ = "Hidrxido amnico      *  26"
CASE 528: n$ = "Hidrxido magnsico"
CASE 529: n$ = "Cal viva               *"
CASE 530: n$ = "xido magnsico        *"
CASE 535 TO 536: n$ = "Ferrocianuro           ** 27"
CASE 541: n$ = "Fosfato                   28"
CASE 542: n$ = "Fosfato seo           *  29"
CASE 544 TO 545: n$ = "Polifosfato            ** 22"
CASE 551 TO 552: n$ = "Silicato"
CASE 553: n$ = "Talco"
CASE 554: n$ = "Silicato alunico      ** 28"
CASE 556: n$ = "Silicato alunico      ** 28"
CASE 585: n$ = "Bentonita              *"
CASE 559: n$ = "Caoln"
CASE 570: n$ = "Caoln"
CASE 572: n$ = "Estearato                 20"
CASE 575: n$ = "Gluconodeltalactona    *"
CASE 576 TO 578: n$ = "Gluconato"

CASE 620: n$ = "cido glutmico        **"
CASE 621: n$ = "Glutamato sdico       **"
CASE 622 TO 623: n$ = "Glutamato              **"
CASE 627: n$ = "Guanliato              ** 31"
CASE 631: n$ = "Inosinato              ** 31"
CASE 635: n$ = "Guanliato o inosinato  ** 31"
CASE 636: n$ = "Maltol                 ** 30"
CASE 637: n$ = "Etilmaltol             ** 30"
CASE 900: n$ = "Dimeticona             *"
CASE 901: n$ = "Cera de abeja"
CASE 903: n$ = "Cera carnauba"
CASE 904: n$ = "Laca                      29"
CASE 905: n$ = "Hidrocarburo mineral      32"
CASE 907: n$ = "Cera de petroleo"
CASE 920: n$ = "Derivado de un aminocido"
CASE 924: n$ = "Bromato                   33"
CASE 925: n$ = "Cloro                     33"
CASE 927: n$ = "Azoformamida              8"

CASE ELSE: n$ = "No encontrado"
END SELECT


nombre$ = n$

END FUNCTION

'
'   JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                        
FUNCTION nota$ (num)

SELECT CASE num
'>>>>>>>>>>>>>>..................................................................------------------------------------------------------------------..................................................................------------------------------------------------------------------
CASE 1:  n$ = "Colorante azoico peligroso para los asmticos, los nios          hiperactivos y aquellos sensibles a la aspirina."
CASE 2:  n$ = "Puede causar hiperactividad en los nios"
CASE 3:  n$ = "Preparado de varias formas, algunas de ellas pueden producir      deficiencia de vitamina B5 por lo que se estn reduciendo el      nmero de las permitidas. Constituye el 98% en peso de los        colorantes alimentarios."
CASE 4:  n$ = "Peligroso para alrgicos, asmticos e hipersensibles."
CASE 5:  n$ = "Vigilar que no vayan a llevarlo determinados frutos sin cocinar.  Peligroso para asmticos e hipersensibles. Reduce la cantidad de  vitamina E en la harina y de vitamina B1 en otros alimentos."
CASE 6:  n$ = "Pueden atravezar la piel de los ctricos."
CASE 7:  n$ = "Se aplica sobre la piel de ctricos y pltanos"
CASE 8:  n$ = "El cido frmico irrita mucho la piel. l y los formiatos tienen  efecto diurtico."
CASE 9:  n$ = "Puede alterar el intestino, el sistema urinario y algunaa vez la  piel. Puede ser cancergeno. "
CASE 10: n$ = "Pueden reaccionar con aminas en el estmago para producir         nitrosaminas que son sustancias muy cancergenas. Interfieren     peligrosamente con las clulas sanguneas infantiles."
CASE 11: n$ = "No debe encontrarse en los alimentos de los nios pequeos."
CASE 12: n$ = "Debe evitarlo quien tenga migraas."
CASE 13: n$ = "Aumenta la absorcin intestinal y por tanto el efecto del alcohol."
CASE 14: n$ = "Benzoatos no permitidos en alimentos infantiles.                  Pueden perjudicar a personas asmticas y sensibles a la aspirina."
CASE 15: n$ = "Se esta investigando su inocuidad. Puede contribuir directamente  al desperdicio de la vitamina D acumulada en el cuerpo.           No permitidos en alimentos infantiles."
CASE 16: n$ = "Es conveniente que no est en alimentos infantiles."
CASE 17: n$ = "Puede alterar la absorcin de Hierro, Zinc y Cobre."
CASE 18: n$ = "Es txica ingerida pura y algunos prouctos tienen hasta un 45% "
CASE 19: n$ = "Puede producir hipersensibilidad"
CASE 20: n$ = "Alguno puede producir alergias en la piel y piedras de rin."
CASE 21: n$ = "Hay poca informacin sobre l. Altera la absorcin de grasas."
CASE 22: n$ = "Se emplea para que los productos crnicos retengan agua y         normalmente los fabricantes abusan de l para aumentar el peso y  el precio del producto. Vigilar especialmente el pollo y el jamn."
CASE 23: n$ = "Hay poca informacin sobre l. Puede interferir con la absorcin  y el funcionamiento del instestino."
CASE 24: n$ = "Hay poca informacin sobre l. Puede aumentar mucho la absorcin  intestinal de las parafinas que son irritantes."
CASE 25: n$ = "Hay muy poca informacin sobre l. Puede ser corrosivo para el    intestino y alterar los lquidos del cuerpo."
CASE 26: n$ = "Hay poca informacin sobre como se emplea. Es corrosivo."
CASE 27: n$ = "Nuestra salud depende de que su lenta absorcin por el intestino  no sea alterada por nada."
CASE 28: n$ = "Contiene aluminio y puede ser perjudicial para alguien."
CASE 29: n$ = "Es un chasco para los vegetarianos."
CASE 30: n$ = "Junto con sal y azucar todos los aromatizantes producen cambios enel apetito y pueden ser responsables de la obesidad."
CASE 31: n$ = "Las purinas estan prohibidas para los nios y deben evitarlas     quien tenga gota o reuma."
CASE 32: n$ = "Causa diarrea e irritaciones."
CASE 33: n$ = "No se esta seguro de su inocuidad. Por ser un blanqueante destruyela vitamina E de la harina y de otros nutrientes. Puede producir  alteraciones intestinales fuertes y espasmos."

END SELECT

nota$ = n$



END FUNCTION

'
'   JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                        
FUNCTION numero (nomb$)
SELECT CASE MID$(nomb$, 1, 1)
   CASE "E": nu = VAL(MID$(nomb$, 2, 3))
   CASE ELSE: nu = VAL(MID$(nomb$, 1, 3))
END SELECT
numero = nu
END FUNCTION

'
'   JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                        
SUB salida

COLOR 0, 3:  LOCATE 2, 1: PRINT SPACE$(80); ""
COLOR 0, 3:  LOCATE 2, 3: PRINT "Salida"

COLOR 7, 7: LOCATE 3
FOR n = 3 TO 24
   PRINT SPACE$(80);
NEXT



caja 9, 21, 18, 60, 7, 1, 6, 8

LOCATE 11, 25: PRINT "        A D I T I V O S"
LOCATE 13, 25: PRINT "              1.0"
LOCATE 16, 25: PRINT " Hecho en Ronda  Junio de 1997"


COLOR 7, 5
END
END SUB

