home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / chemie / molmasse / molmasse.gfa (.txt) next >
Encoding:
GFA-BASIC Atari  |  1991-04-07  |  7.5 KB  |  365 lines
  1. ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2. '  Wilfried Cordes, Kennedystraße 20, 2900 Oldenburg, Tel.: 0441-53088
  3. '  Accessory zur Bestimmung von Molmassen
  4. ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  5. ' 1000 Bytes Speicher reichen
  6. $m1000
  7. '
  8. ' Anwendung beim AES anmelden
  9. ap_id&=APPL_INIT()
  10. programm!=ap_id&=0
  11. ' *
  12. ' * Ressourcebaumadressen holen
  13. ' *
  14. ' ## INLINE:
  15. ' $0000: 00 00 03 ba 03 2e 03 2e 03 20 00 00 00 24 02 a8 
  16. ' $0010: 00 00 07 02 00 23 00 02 00 05 00 00 00 01 00 00 
  17. ' $0020: 00 00 07 0a 4d 6f 6c 6d 61 73 73 65 6e 62 65 73 
  18. ' $0030: 74 69 6d 6d 75 6e 67 00 53 75 6d 6d 65 6e 66 6f 
  19. ' $0040: 72 6d 65 6c 3a 00 61 62 63 64 65 66 67 68 69 6a 
  20. ' $0050: 6b 6c 6d 6e 6f 70 71 72 73 74 75 76 77 78 79 7a 
  21. ' $0060: 84 94 00 5f 5f 5f 5f 5f 5f 5f 5f 5f 5f 5f 5f 5f 
  22. ' $0070: 5f 5f 5f 5f 5f 5f 5f 5f 5f 5f 5f 5f 5f 5f 5f 00 
  23. ' $0080: 58 58 58 58 58 58 58 58 58 58 58 58 58 58 58 58 
  24. ' $0090: 58 58 58 58 58 58 58 58 58 58 58 58 00 4d 6f 6c 
  25. ' $00a0: 6d 61 73 73 65 3a 00 31 32 33 34 35 36 37 38 39 
  26. ' $00b0: 30 00 47 72 61 6d 6d 00 52 65 63 68 6e 65 00 53 
  27. ' $00c0: 63 68 6c 75 9e 00 47 65 77 69 63 68 74 73 70 72 
  28. ' $00d0: 6f 7a 65 6e 74 65 3a 00 41 42 43 44 45 46 47 48 
  29. ' $00e0: 49 4a 4b 00 41 42 43 44 45 46 47 48 49 4a 4b 00 
  30. ' $00f0: 41 42 43 44 45 46 47 48 49 4a 4b 00 41 42 43 44 
  31. ' $0100: 45 46 47 48 49 4a 4b 00 41 42 43 44 45 46 47 48 
  32. ' $0110: 49 4a 4b 00 41 42 43 44 45 46 47 48 49 4a 4b 00 
  33. ' $0120: 41 42 43 44 45 46 47 48 49 4a 4b 00 41 42 43 44 
  34. ' $0130: 45 46 47 48 49 4a 4b 00 41 42 43 44 45 46 47 48 
  35. ' $0140: 49 4a 4b 00 41 42 43 44 45 46 47 48 49 4a 4b 00 
  36. ' $0150: 41 42 43 44 45 46 47 48 49 4a 4b 00 41 42 43 44 
  37. ' $0160: 45 46 47 48 49 4a 4b 00 57 69 6c 66 72 69 65 64 
  38. ' $0170: 20 43 6f 72 64 65 73 00 00 43 20 48 20 45 20 4d 
  39. ' $0180: 20 50 20 4c 20 4f 20 54 20 20 20 53 20 54 00 00 
  40. ' $0190: 4b 65 6e 6e 65 64 79 73 74 72 61 e1 65 20 32 30 
  41. ' $01a0: 00 32 39 30 30 20 4f 6c 64 65 6e 62 75 72 67 00 
  42. ' $01b0: 27 4d 4f 4c 4d 41 53 53 45 27 20 77 75 72 64 65 
  43. ' $01c0: 20 6d 69 74 20 47 46 41 2d 42 61 73 69 63 20 33 
  44. ' $01d0: 2e 35 20 65 72 73 74 65 6c 6c 74 2e 00 53 79 6d 
  45. ' $01e0: 62 6f 6c 65 20 62 69 74 74 65 20 6b 6f 72 72 65 
  46. ' $01f0: 6b 74 20 67 72 6f 9e 2f 6b 6c 65 69 6e 20 73 63 
  47. ' $0200: 68 72 65 69 62 65 6e 3a 00 00 00 53 62 2c 20 42 
  48. ' $0210: 72 20 73 74 61 74 74 20 53 42 2c 20 42 52 20 6f 
  49. ' $0220: 64 65 72 20 67 61 72 20 73 42 20 6f 64 65 72 20 
  50. ' $0230: 73 62 2e 00 00 00 4a 6f 64 20 69 73 74 20 61 6c 
  51. ' $0240: 73 20 27 49 27 20 65 69 6e 7a 75 67 65 62 65 6e 
  52. ' $0250: 2e 00 00 00 27 4d 4f 4c 4d 41 53 53 45 27 20 69 
  53. ' $0260: 73 74 20 50 75 62 6c 69 63 20 44 6f 6d 61 69 6e 
  54. ' $0270: 2e 20 45 73 20 64 61 72 66 20 73 6f 6d 69 74 00 
  55. ' $0280: 61 6e 20 6a 65 64 65 20 75 6e 64 20 6a 65 64 65 
  56. ' $0290: 6e 20 77 65 69 74 65 72 67 65 67 65 62 65 6e 20 
  57. ' $02a0: 77 65 72 64 65 6e 2e 00 00 00 00 00 00 00 00 08 
  58. ' $02b0: 00 00 00 08 00 40 00 04 10 42 00 04 08 44 00 0c 
  59. ' $02c0: 04 08 00 08 00 c0 00 08 01 e0 00 0c 03 f3 80 00 
  60. ' $02d0: 3b f0 00 0c 01 e0 00 0c 00 c8 00 0c 02 04 00 0c 
  61. ' $02e0: 04 42 00 0c 08 40 00 0c 00 40 00 0c 00 43 ff cc 
  62. ' $02f0: 00 02 00 4c 00 02 db 4c 00 02 db 4c 00 02 db 4c 
  63. ' $0300: 00 fe 00 4c 1e 80 00 4c 12 b6 db 4c 12 b6 db 4c 
  64. ' $0310: 1e b6 db 7c 1e 80 00 4c 12 ff ff cc 00 00 00 00 
  65. ' $0320: 00 00 02 a8 00 04 00 1e 00 00 00 00 00 01 00 00 
  66. ' $0330: 00 46 00 00 00 63 00 00 00 80 00 03 00 06 00 00 
  67. ' $0340: 11 80 00 00 ff ff 00 1d 00 1d 00 00 01 78 00 00 
  68. ' $0350: 01 79 00 00 01 8f 00 03 00 06 00 02 11 01 00 00 
  69. ' $0360: ff fd 00 01 00 16 00 00 01 dd 00 00 02 09 00 00 
  70. ' $0370: 02 0a 00 03 00 06 00 00 11 00 00 00 ff ff 00 2c 
  71. ' $0380: 00 01 00 00 02 0b 00 00 02 34 00 00 02 35 00 03 
  72. ' $0390: 00 06 00 00 11 00 00 00 ff ff 00 29 00 01 00 00 
  73. ' $03a0: 02 36 00 00 02 52 00 00 02 53 00 03 00 06 00 00 
  74. ' $03b0: 11 00 00 00 ff ff 00 1c 00 01 ff ff 00 01 00 0a 
  75. ' $03c0: 00 14 00 00 00 10 00 02 11 00 00 00 00 00 00 2e 
  76. ' $03d0: 00 11 00 02 ff ff ff ff 00 1c 00 00 00 00 00 00 
  77. ' $03e0: 00 24 00 02 00 01 00 13 00 01 00 03 ff ff ff ff 
  78. ' $03f0: 00 17 00 40 00 00 00 00 03 20 00 28 00 01 00 04 
  79. ' $0400: 0e 01 00 04 ff ff ff ff 00 1c 00 00 00 00 00 00 
  80. ' $0410: 00 38 00 02 00 03 00 0d 00 01 00 05 ff ff ff ff 
  81. ' $0420: 00 1d 00 08 00 00 00 00 03 2e 00 10 00 03 00 1c 
  82. ' $0430: 00 01 00 06 ff ff ff ff 00 1c 00 00 00 00 00 00 
  83. ' $0440: 00 9d 00 02 00 05 00 09 00 01 00 07 ff ff ff ff 
  84. ' $0450: 00 1c 00 00 00 00 00 00 00 a7 00 0c 00 05 00 0a 
  85. ' $0460: 00 01 00 08 ff ff ff ff 00 1c 00 00 00 00 00 00 
  86. ' $0470: 00 b2 00 17 00 05 00 06 00 01 00 09 ff ff ff ff 
  87. ' $0480: 00 1a 00 07 00 00 00 00 00 b8 00 02 00 07 00 0d 
  88. ' $0490: 00 01 00 0a ff ff ff ff 00 1a 00 05 00 00 00 00 
  89. ' $04a0: 00 bf 00 1e 00 07 00 0e 00 01 00 00 00 0b 00 17 
  90. ' $04b0: 00 19 00 00 00 10 00 00 11 00 00 02 00 09 00 2a 
  91. ' $04c0: 00 07 00 0c ff ff ff ff 00 1c 00 00 00 00 00 00 
  92. ' $04d0: 00 c6 00 00 00 00 00 11 00 01 00 0d ff ff ff ff 
  93. ' $04e0: 00 1c 00 00 00 00 00 00 00 d8 00 00 00 02 00 0b 
  94. ' $04f0: 00 01 00 0e ff ff ff ff 00 1c 00 00 00 00 00 00 
  95. ' $0500: 00 e4 00 0f 00 02 00 0b 00 01 00 0f ff ff ff ff 
  96. ' $0510: 00 1c 00 00 00 00 00 00 00 f0 00 1e 00 02 00 0b 
  97. ' $0520: 00 01 00 10 ff ff ff ff 00 1c 00 00 00 00 00 00 
  98. ' $0530: 00 fc 00 00 00 03 00 0b 00 01 00 11 ff ff ff ff 
  99. ' $0540: 00 1c 00 00 00 00 00 00 01 08 00 0f 00 03 00 0b 
  100. ' $0550: 00 01 00 12 ff ff ff ff 00 1c 00 00 00 00 00 00 
  101. ' $0560: 01 14 00 1e 00 03 00 0b 00 01 00 13 ff ff ff ff 
  102. ' $0570: 00 1c 00 00 00 00 00 00 01 20 00 00 00 04 00 0b 
  103. ' $0580: 00 01 00 14 ff ff ff ff 00 1c 00 00 00 00 00 00 
  104. ' $0590: 01 2c 00 0f 00 04 00 0b 00 01 00 15 ff ff ff ff 
  105. ' $05a0: 00 1c 00 00 00 00 00 00 01 38 00 1e 00 04 00 0b 
  106. ' $05b0: 00 01 00 16 ff ff ff ff 00 1c 00 00 00 00 00 00 
  107. ' $05c0: 01 44 00 00 00 05 00 0b 00 01 00 17 ff ff ff ff 
  108. ' $05d0: 00 1c 00 00 00 00 00 00 01 50 00 0f 00 05 00 0b 
  109. ' $05e0: 00 01 00 0a ff ff ff ff 00 1c 00 20 00 00 00 00 
  110. ' $05f0: 01 5c 00 1e 00 05 00 0b 00 01 ff ff 00 01 00 0a 
  111. ' $0600: 00 14 00 00 00 10 00 02 11 00 00 00 00 00 00 2e 
  112. ' $0610: 00 0e 00 02 ff ff ff ff 00 1a 00 00 00 00 00 00 
  113. ' $0620: 01 68 00 01 00 01 00 11 00 01 00 03 ff ff ff ff 
  114. ' $0630: 00 1e 00 40 00 00 00 00 03 4a 00 13 00 01 00 19 
  115. ' $0640: 00 03 00 04 ff ff ff ff 00 1a 00 00 00 00 00 00 
  116. ' $0650: 01 90 00 01 00 02 00 11 00 01 00 05 ff ff ff ff 
  117. ' $0660: 00 1a 00 00 00 00 00 00 01 a1 00 01 00 03 00 11 
  118. ' $0670: 00 01 00 06 ff ff ff ff 00 1c 00 00 00 00 00 00 
  119. ' $0680: 01 b0 00 01 00 05 00 2c 00 01 00 07 ff ff ff ff 
  120. ' $0690: 00 15 00 00 00 00 00 00 03 66 00 01 00 07 00 2b 
  121. ' $06a0: 00 01 00 08 ff ff ff ff 00 15 00 00 00 00 00 00 
  122. ' $06b0: 03 82 00 01 00 08 00 28 00 01 00 09 ff ff ff ff 
  123. ' $06c0: 00 15 00 00 00 00 00 00 03 9e 00 01 00 09 00 1b 
  124. ' $06d0: 00 01 00 0a ff ff ff ff 00 1c 00 00 00 00 00 00 
  125. ' $06e0: 02 54 00 01 00 0b 00 2b 00 01 00 00 ff ff ff ff 
  126. ' $06f0: 00 1c 00 20 00 00 00 00 02 80 00 01 00 0c 00 29 
  127. ' $0700: 00 01 00 00 03 ba 00 00 05 fa 00 2b 00 01 00 00 
  128. ' $0710: ff ff ff ff 00 1c 00 20 00 00 00 00 02 8c 00 01 
  129. ' $0720: 00 0c 00 29 00 01 00 00 03 c6 00 00 06 1e 
  130. ' 1838  Bytes.
  131. INLINE rsc%,1838
  132. setze_koordinaten(0,eingabe_adr%,rsc%)
  133. rechte&=2
  134. wert&=4
  135. ergebnis&=6
  136. rechne&=8
  137. schluss&=9
  138. prozent1&=12
  139. setze_koordinaten(1,rechte_adr%,rsc%)
  140. '
  141. atomliste$=" HHeLiBe B C N O FNeNaMgAlSi P SClAr KCaScTi VCrMnFeCoNiCuZnGaGeAsSeBrKrRbSr YZrNbMoTcRuRhPdAgCdInSnSbTe IXeCsBaHfTa WReOsIrPtAuHgTlPbBiPo"
  142. OPTION BASE 1
  143. DIM atomgewicht#(69)
  144. DIM gewicht#(12)                  !Gewicht pro Atom in der Formel
  145. DIM atomsymbol$(12)
  146. FOR m&=1 TO 69
  147.   READ atomgewicht#(m&)
  148. NEXT m&
  149. DATA 1.0079,4.00260,6.941,9.01218,10.81
  150. DATA 12.011,14.0067,15.9994,18.99840,20.179
  151. DATA 22.98977,24.305,26.98154,28.086
  152. DATA 30.97376,32.06,35.453,39.948
  153. DATA 39.098,40.08,44.9559,47.90,50.9414
  154. DATA 51.996,54.9380,55.847,58.9332,58.70,63.546,65.38
  155. DATA 69.72,72.59,74.9216,78.96,79.904,83.80
  156. DATA 85.4678,87.62,88.9059,91.22,92.9064,95.94
  157. DATA 97,101.07,102.9055,106.4,107.868,112.40
  158. DATA 114.82,118.69,121.75,127.60,126.9045,131.30
  159. DATA 132.9055,137.34,178.49,180.9479,183.85
  160. DATA 186.207,190.2,192.22,195.09,196.9665,200.59
  161. DATA 204.37,207.19,208.9806,210
  162. '
  163. IF NOT programm!
  164.   ' Accessorynamen ins Deskmenü eintragen
  165.   IF MENU_REGISTER(ap_id&,"  Molmasse...")=-1
  166.     ' Kein Platz im Deskmenü
  167.     DO
  168.       ~EVNT_TIMER(-1)
  169.     LOOP
  170.   ENDIF
  171. ENDIF
  172. '
  173. DO
  174.   IF NOT programm!
  175.     ~EVNT_MESAG(0) !Auf's angeklickt werden warten
  176.   ENDIF
  177.   IF MENU(1)=40 OR programm!    !'AC_OPEN'
  178.     DEFMOUSE 0
  179.     ' Menüleiste sperren
  180.     ~WIND_UPDATE(1)
  181.     ' Dialogboxkoordinaten auf Bildschirm zentrieren
  182.     ~FORM_CENTER(eingabe_adr%,x&,y&,b&,h&)
  183.     ' Bildschirmplatz reservieren
  184.     ~FORM_DIAL(0,0,0,0,0,x&,y&,b&,h&)
  185.     ' Eingabezeile leeren
  186.     BYTE{{OB_SPEC(eingabe_adr%,wert&)}}=0
  187.     '
  188.     ' Molmasse zu Anfang 0 Gramm
  189.     CHAR{OB_SPEC(eingabe_adr%,ergebnis&)}="0"
  190.     FOR m&=prozent1& TO prozent1&+12
  191.       CHAR{OB_SPEC(eingabe_adr%,m&)}=""
  192.     NEXT m&
  193.     '
  194.     REPEAT
  195.       abbruch!=FALSE
  196.       '
  197.       ' Ausgangsknöpfe entfärben
  198.       undo(eingabe_adr%,rechne&)
  199.       undo(eingabe_adr%,schluss&)
  200.       '
  201.       ' Dialogbox zeichnen
  202.       ~OBJC_DRAW(eingabe_adr%,0,3,x&,y&,b&,h&)
  203.       '
  204.       ' Dialog durchführen
  205.       r_obj%=FORM_DO(eingabe_adr%,0)
  206.       '
  207.       SELECT r_obj%
  208.       CASE rechne&
  209.         '
  210.         ' Text aus Dialogbox holen
  211.         text$=CHAR{{OB_SPEC(eingabe_adr%,wert&)}}
  212.         '
  213.         CLR summe#
  214.         atomanzahl&=1
  215.         FOR m&=prozent1& TO prozent1&+12
  216.           CHAR{OB_SPEC(eingabe_adr%,m&)}=""
  217.         NEXT m&
  218.         IF text$<>""
  219.           FOR ort&=1 TO LEN(text$)
  220.             ' Alle eingegebenen Zeichen überprüfen
  221.             buchstabe$=MID$(text$,ort&,1)
  222.             IF buchstabe$>="A" AND buchstabe$<="Z"
  223.               '
  224.               ' Eingelesenes Zeichen ist großer Buchstabe
  225.               a$=MID$(text$,ort&+1,1)
  226.               '
  227.               IF a$>="a" AND a$<="z"
  228.                 ' Großer Buchstabe hat kleinen Buchstaben als Nachbarn
  229.                 ' Ist Kombination in Atomliste?
  230.                 stelle&=INSTR(atomliste$,buchstabe$+a$)
  231.                 IF stelle&>0
  232.                   ' Kombination gefunden
  233.                   atomsymbol$(atomanzahl&)=buchstabe$+a$
  234.                   INC ort&
  235.                   hole_haeufigkeit(stelle&,ort&,summe#)
  236.                 ELSE
  237.                   ' Kombination nicht gefunden, nach einzelnem Buchstaben suchen
  238.                   atomsymbol$(atomanzahl&)=" "+buchstabe$
  239.                   stelle&=INSTR(atomliste$," "+buchstabe$)
  240.                   hole_haeufigkeit(stelle&,ort&,summe#)
  241.                 ENDIF
  242.               ELSE
  243.                 ' Buchstabe hat Zahl oder nichts als Nachbarn
  244.                 atomsymbol$(atomanzahl&)=" "+buchstabe$
  245.                 stelle&=INSTR(atomliste$," "+buchstabe$)
  246.                 hole_haeufigkeit(stelle&,ort&,summe#)
  247.               ENDIF
  248.               '
  249.             ELSE
  250.               abbruch!=TRUE
  251.             ENDIF
  252.             EXIT IF abbruch!
  253.           NEXT ort&
  254.         ENDIF
  255.         '
  256.         IF NOT abbruch!
  257.           IF atomanzahl&>1
  258.             ' Molekülgewicht in Dialogbox schreiben
  259.             CHAR{OB_SPEC(eingabe_adr%,ergebnis&)}=STR$(summe#)
  260.             FOR atom&=1 TO MIN(atomanzahl&-1,12)
  261.               anteil#=100*gewicht#(atom&)/summe#
  262.               CHAR{OB_SPEC(eingabe_adr%,prozent1&+atom&-1)}=atomsymbol$(atom&)+": "+STR$(ROUND(anteil#,2),5,2)+" %"
  263.             NEXT atom&
  264.           ENDIF
  265.         ELSE
  266.           ' Fehlerhafte Eingabe
  267.           ~FORM_ALERT(1,"[3][Eingabe kann nicht|ausgewertet werden.][Weiter]")
  268.           CHAR{OB_SPEC(eingabe_adr%,ergebnis&)}="0"
  269.         ENDIF
  270.         '
  271.       CASE rechte&
  272.         ~FORM_CENTER(rechte_adr%,xx&,yy&,bb&,hh&)
  273.         ~OBJC_DRAW(rechte_adr%,0,3,xx&,yy&,bb&,hh&)
  274.         ~FORM_DO(rechte_adr%,0)
  275.       ENDSELECT
  276.     UNTIL r_obj%=schluss&
  277.     '
  278.     ' Botschaft an Hauptprogramm zur Bildschirmrestaurierung schicken
  279.     ~FORM_DIAL(3,0,0,0,0,x&,y&,b&,h&)
  280.     ' Menüs dürfen wieder klappen
  281.     ~WIND_UPDATE(0)
  282.   ENDIF
  283.   EXIT IF programm!
  284. LOOP
  285. '
  286. ' Programmende
  287. ~RSRC_FREE()
  288. END
  289. '
  290. PROCEDURE hole_haeufigkeit(stelle&,VAR ort&,summe#)
  291.   ' Element ist in Liste, nun zugehörigen Zahlenwert bestimmen
  292.   LOCAL menge&
  293.   '
  294.   IF stelle&>0 AND ODD(stelle&)
  295.     ' Umrechnung von Position in String
  296.     ' auf atomgewicht()-Feldindex
  297.     DIV stelle&,2
  298.     INC stelle&
  299.     '
  300.     ' ort& zeigt auf erstes Zeichen nach dem Elementsymbol
  301.     INC ort&
  302.     '
  303.     ' Zahlenwert der Zeichen nach dem Elementsymbol bestimmen
  304.     menge&=VAL(MID$(text$,ort&))
  305.     '
  306.     ' Wenn Zahl gefunden (menge&>0), Textzeiger neu stellen
  307.     IF menge&>0
  308.       ' Korrektur wegen interner Zahlendarstellung
  309.       ADD ort&,LOG10(menge&)+0.001
  310.     ELSE
  311.       menge&=1
  312.       DEC ort&  !wegen NEXT ort& in Haupschleife
  313.     ENDIF
  314.     '
  315.     ' Molekülgewicht aufaddieren
  316.     ADD summe#,atomgewicht#(stelle&)*menge&
  317.     gewicht#(atomanzahl&)=atomgewicht#(stelle&)*menge&
  318.     INC atomanzahl&
  319.   ELSE
  320.     abbruch!=TRUE
  321.   ENDIF
  322. RETURN
  323. '
  324. ' Objekt desaktivieren
  325. PROCEDURE disable(baum_adr%,objekt&)
  326.   OB_STATE(baum_adr%,objekt&)=BSET(OB_STATE(baum_adr%,objekt&),3)
  327. RETURN
  328. ' Objekt aktivieren
  329. PROCEDURE enable(baum_adr%,objekt&)
  330.   OB_STATE(baum_adr%,objekt&)=BCLR(OB_STATE(baum_adr%,objekt&),3)
  331. RETURN
  332. ' Knopf entfärben
  333. PROCEDURE undo(baum_adr%,objekt&)
  334.   OB_STATE(baum_adr%,objekt&)=BCLR(OB_STATE(baum_adr%,objekt&),0)
  335. RETURN
  336. ' *
  337. ' Koordinaten in INLINE-Ressource berechnen
  338. ' *
  339. PROCEDURE setze_koordinaten(baum&,VAR adr%,rsc%)
  340.   LOCAL nummer&,adresse%,tabelle&
  341.   '
  342.   tabelle&=CARD{rsc%+18}
  343.   adr%={tabelle&+rsc%+baum&*4}+rsc%
  344.   nummer&=0
  345.   REPEAT
  346.     ~RSRC_OBFIX(adr%,nummer&)
  347.     SELECT OB_TYPE(adr%,nummer&)
  348.     CASE 21,22,29,30,31
  349.       OB_SPEC(adr%,nummer&)=OB_SPEC(adr%,nummer&)+rsc%
  350.       adresse%=OB_SPEC(adr%,nummer&)
  351.       {adresse%}={adresse%}+rsc%
  352.       {adresse%+4}={adresse%+4}+rsc%
  353.       {adresse%+8}={adresse%+8}+rsc%
  354.     CASE 23,24     !BITBLK,USERDEF
  355.       OB_SPEC(adr%,nummer&)=OB_SPEC(adr%,nummer&)+rsc%
  356.       adresse%=OB_SPEC(adr%,nummer&)
  357.       {adresse%}={adresse%}+rsc%
  358.     CASE 26,28,32
  359.       OB_SPEC(adr%,nummer&)=OB_SPEC(adr%,nummer&)+rsc%
  360.     ENDSELECT
  361.     '
  362.     INC nummer&
  363.   UNTIL BTST(OB_FLAGS(adr%,nummer&-1),5)
  364. RETURN
  365.