' ' 2.34 Eingabe Breite Spalten 8->9 ' 2.35 Pfeilmaus zu Beginn ' 2.36 Eingabe Zahl Spalten 1-99 ' 2.37 Eingabe Sortieren von 999 bis 999 ' 2.38 Speicherfehler behoben ' 2.39 Fehler #ABS() behoben ' ' *************************** ' * GEM-CALC 2.39 ½ 1988 * ' * Dr. Gregor Englmayer * ' * A-8813 St. Lambrecht * ' * Weiženbach 30/2 * ' *************************** ' ON BREAK GOSUB ende ON ERROR GOSUB fehler GOSUB aufloesung GOSUB icon GOSUB titel DEFMOUSE 2 GOSUB init_variablen GOSUB leiste GOSUB init GOSUB grafik_init CLS ' MENU leiste$() MENU 34,1 MENU 35,1 FOR i%=79 TO 86 MENU i%,2 NEXT i% IF aufloesung%=1 MENU 88,2 ENDIF DEFMOUSE 0 ON MENU GOSUB menue ON MENU KEY GOSUB taste ON MENU IBOX 1,36,80*dvs,586-17*test%,302*dvs GOSUB cursor.inbox ON MENU IBOX 2,623,57*dvs,16,335*dvs GOSUB schieber ' GOSUB aufbau.screen(x%,y%,cx%,cy%) ' fehlerlabel: CLOSE ON ERROR GOSUB fehler DO ON MENU IF sflag!=TRUE GOSUB aufbau.screen(x%,y%,cx%,cy%) sflag!=FALSE ENDIF LOOP ' > PROCEDURE schieber SHOWM sflag!=FALSE DEFTEXT 1,0,0,6+2*test% REPEAT WHILE MOUSEK<>0 delta_x=26/breite% ym%=MOUSEY IF ym%>88*dvs AND ym%<115*dvs sflag!=TRUE x%=(ym%-88*dvs)/dvs/delta_x x%=MAX(1,x%) cx%=x% IF ox%<>x% ox%=x% GOSUB zeichne_schieber1(x%) ENDIF ENDIF IF ym%<=(168+(y%+lng%)*182/hoehe%)*dvs-test% AND ym%>=(168+y%*182/hoehe%)*dvs sflag!=TRUE oy%=y% dy=(168+y%*182/hoehe%)*dvs-ym% REPEAT yym%=MOUSEY+dy IF yym%>167*dvs AND yym%<352*dvs y%=(yym%/dvs-167)/182*hoehe% y%=MIN(y%,hoehe%-lng%) IF ((168+y%*182/hoehe%)*dvs)>166*dvs AND (168+(y%+lng%)*182/hoehe%)*dvs-test%<352*dvs AND oy%<>y% oy%=y% GOSUB zeichne_schieber3(y%) ENDIF ENDIF UNTIL MOUSEK=0 ym%=MOUSEY ENDIF IF ym%>(168+(y%+lng%)*182/hoehe%)*dvs-test% AND ym%<352*dvs sflag!=TRUE ADD y%,10 y%=MIN(y%,hoehe%) GOSUB zeichne_schieber3(y%) PAUSE 8 ENDIF IF ym%>167*dvs AND ym%<(168+y%*182/hoehe%)*dvs sflag!=TRUE SUB y%,10 y%=MAX(y%,1) GOSUB zeichne_schieber3(y%) PAUSE 8 ENDIF ' IF ym%>57*dvs AND ym%<73*dvs AND x%>1 sflag!=TRUE DEC x% cx%=x% GOSUB zeichne_schieber1(x%) PAUSE 5 ENDIF IF ym%>115*dvs AND ym%<131*dvs AND x%135*dvs AND ym%<151*dvs AND y%>1 sflag!=TRUE DEC y% GOSUB zeichne_schieber3(y%) PAUSE 5 ENDIF IF ym%>367*dvs AND ym%<383*dvs AND y%151*dvs AND ym%<167*dvs AND y%>1 sflag!=TRUE SUB y%,100 y%=MAX(y%,1) GOSUB zeichne_schieber3(y%) PAUSE 8 ENDIF IF ym%>351*dvs AND ym%<367*dvs AND y%382*dvs cy%=y% DEFTEXT 1,,,13+7*test% RETURN > PROCEDURE cursor.inbox IF MOUSEK<>0 AND grafik!=FALSE ym%=(MOUSEY-64*dvs)/(8*aufloesung%)+y%-1 IF ym%<=y%+lng% GOSUB invert(0) cy%=ym% cy%=MAX(cy%,1) xm%=(MOUSEX-28)/8 br%=0 i%=x% REPEAT ADD br%,breite%(i%) INC br% IF xm%<=br% cx%=i% i%=spalten% ENDIF INC i% UNTIL i%>=spalten%+1 GOSUB invert(1) GOSUB anz2 ENDIF ENDIF RETURN > PROCEDURE taste aa%=MENU(14)/256 ab%=MENU(14)-256*aa% bb%=MENU(13) ' IF (aa%=75 OR aa%=77 OR aa%=72 OR aa%=80) AND (bb% AND 3)<>0 AND grafik!=FALSE !SHIFT+CURSOR GOSUB invert(0) IF aa%=72 !RAUF SUB y%,20 y%=MAX(y%,1) SUB cy%,20 cy%=MAX(cy%,1) GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF IF aa%=80 !RUNTER ADD cy%,19 cy%=MIN(cy%,hoehe%-1) GOSUB runter(0) GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF IF aa%=75 !LINKS SUB x%,5 x%=MAX(x%,1) SUB cx%,5 cx%=MAX(cx%,1) GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF IF aa%=77 !RECHTS ADD cx%,4 cx%=MIN(cx%,breite%-1) GOSUB rechts(0) GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF CLR aa% ELSE ' IF ab%=0 AND grafik!=FALSE AND aa%<>3 AND aa%<>110 IF aa%=71 !CLR-HOME GOSUB invert(0) GOSUB gehe.a1 ENDIF ' IF aa%=119 !CONTROL+CLR-HOME GOSUB invert(0) x%=1 cx%=xmax%-1 GOSUB rechts(0) IF y%<>ymax% y%=1 cy%=ymax%-1 GOSUB runter(0) ENDIF GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF ' IF aa%=72 AND bb%=4 !CONTROL+RAUF GOSUB invert(0) y%=1 cy%=1 GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF IF aa%=80 AND bb%=4 !CONTROL+RUNTER GOSUB invert(0) IF y%<>ymax% y%=1 cy%=ymax%-1 GOSUB runter(0) ENDIF GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF ' IF aa%=115 AND bb%=4 !CONTROL+LINKS GOSUB invert(0) x%=1 cx%=1 GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF ' IF aa%=116 AND bb%=4 !CONTROL+RECHTS GOSUB invert(0) x%=1 cx%=xmax%-1 GOSUB rechts(0) GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF ' IF aa%=98 GOSUB help.screen ENDIF ' IF bb%<>4 GOSUB beweg.cursor ENDIF ' ' FUNKTIONSTASTE ' ON aa%-58 GOSUB edit,block.ru,laden,breite,komma,copy.abs,move.abs,gehe.zelle,drucken,loesche.zelle ' ' SHIFT-FUNKTIONSTASTE ' ON aa%-83 GOSUB recalc,block.lo,speichern,breite.all,komma.all,copy.rel,move.rel,kopf,ende,loeschen ' ELSE ' h$="#„Ž”™šž"+CHR$(126)+CHR$(124)+"^" IF ((ab%>31 AND ab%<123) OR INSTR(h$,CHR$(ab%))<>0) AND grafik!=FALSE GOSUB eingabe ELSE IF grafik!=FALSE AND aa%>11 ' IF ab%=3 AND aa%=41 GOSUB suchen ENDIF ' IF ab%=30 AND aa%=12 GOSUB help.screen ENDIF ' IF ab%=13 AND aa%=50 GOSUB merken ENDIF ' IF ab%=1 AND aa%=30 GOSUB copy.cel.abs ENDIF ' IF ab%=18 AND aa%=19 GOSUB copy.cel.rel ENDIF ' IF ab%=25 AND aa%=44 GOSUB widmung ENDIF ' IF ab%=3 AND aa%=46 GOSUB invers ENDIF ' IF ab%=23 AND aa%=17 GOSUB degas ENDIF ' IF ab%=16 AND aa%=25 !LINEFEED ALERT 2," Carr. Return mit Linefeed ?",lfeed!+2," ja | nein ",h% IF (lfeed!=TRUE AND h%=2) OR (lfeed!=FALSE AND h%=1) GOSUB line.feed ENDIF ENDIF ' IF ab%=20 AND aa%=20 !TRENNZEICHEN ALERT 2," Trennzeichen beim Ausdruck ?",trennz!+2," ja | nein ",h% IF (trennz!=TRUE AND h%=2) OR (trennz!=FALSE AND h%=1) GOSUB trennzeichen ENDIF ENDIF ' IF ab%=2 AND aa%=48 !BOGENMAž IF grd=1 ALERT 2," Bogenmaž ?",1," ja | nein ",h% IF h%=2 gespeichert!=FALSE grd=PI/180 MENU 69,0 ENDIF ELSE ALERT 2," Bogenmaž ?",2," ja | nein ",h% IF h%=1 gespeichert!=FALSE grd=1 MENU 69,1 ENDIF ENDIF ENDIF ' IF ab%=14 AND aa%=49 !NACHKOMMA-0 ALERT 2," Nachkommastellen mit '0' | auffllen ?",null!+2," ja | nein ",h% IF (null!=TRUE AND h%=2) OR (null!=FALSE AND h%=1) GOSUB nullen ENDIF ENDIF ' IF ab%=26 AND aa%=21 !AUSDRUCK ZELLINHALT GOSUB druck.zellinhalt ENDIF ' IF ab%=11 AND aa%=37 GOSUB hi.resol ENDIF ' IF ab%=21 AND aa%=22 GOSUB daten.uebernahme ENDIF ' IF ab%=24 AND aa%=45 GOSUB sortieren ENDIF ' IF ab%=12 AND aa%=38 GOSUB zahl_spalten ENDIF ' IF ab%=15 AND aa%=24 GOSUB such.fehler ENDIF ' IF ab%=22 AND aa%=47 !BLOCK-ZELLEN IN WERTE ŽNDERN GOSUB block.werte ENDIF ENDIF ' IF ugrafik!=TRUE AND aa%>11 IF ab%=4 AND spa<=14 AND offs>=0 AND aa%=32 !KUCHENGRAFIK GOSUB kuchen ENDIF ' IF ab%=5 AND aa%=18 !LINIENGRAFIK hilf$=" Linien C-E" GOSUB grafik.2d ENDIF ' IF ab%=6 AND aa%=33 AND (spa<=14 OR rei<=2) !BALKENGRAFIK hilf$=" Balken C-F" GOSUB grafik.2d ENDIF ' IF ab%=7 AND aa%=34 AND offs>=0 !STAPELGRAFIK GOSUB stapel ENDIF ' IF ab%=8 AND aa%=35 AND offs>=0 !SŽULENGRAFIK hilf$=" S„ulen C-H" GOSUB grafik.3d ENDIF ' IF ab%=9 AND aa%=23 AND spa<=14 AND offs>=0 !BLOCKGRAFIK hilf$=" Bl”cke C-I" GOSUB grafik.3d ENDIF ' IF ab%=10 AND aa%=36 AND spa<=14 AND offs>=0 !FLŽCHENGRAFIK hilf$=" Fl„chen C-J" GOSUB grafik.3d ENDIF ENDIF ' IF ab%=17 AND aa%=16 GOSUB hardcpy ENDIF ' IF ab%=19 AND aa%=31 !BILDSCHIRMAUFBAU nach Grafik oder Accessory GOSUB spreadsheet ENDIF ' IF aa%<=11 IF ab%=17 AND aa%=2 GOSUB zeile.einfugen ENDIF ' IF ab%=0 AND aa%=3 GOSUB zeile.loschen ENDIF ' IF ab%=19 AND aa%=4 GOSUB spalte.einfugen ENDIF ' IF ab%=20 AND aa%=5 GOSUB spalte.loschen ENDIF ' IF ab%=21 AND aa%=6 GOSUB save.gdaten ENDIF ' IF ab%=30 AND aa%=7 GOSUB load.gdaten ENDIF ' IF ab%=23 AND aa%=8 gespeichert!=FALSE IF schutz!=TRUE h$="ent" ELSE h$="" ENDIF ALERT 2," Blatt "+h$+"schtzen ? ",1," ja | nein ",in% IF in%=1 GOSUB blatt_schutz ENDIF ENDIF ' IF ab%=24 AND aa%=9 block_schutz ENDIF ' IF ab%=25 AND aa%=10 GOSUB anpassen_max ENDIF ' IF ab%=16 AND aa%=11 GOSUB titelzeilen ENDIF ENDIF ENDIF ENDIF ENDIF REPEAT UNTIL INKEY$="" RETURN ' ' *** UNTERPROGRAMME ' > PROCEDURE anz2 GRAPHMODE 4 TEXT 0,398*dvs," " h$=CHR$(cx%+64)+STR$(cy%) IF (schutz!=FALSE AND block_sch|(cx%,cy%)=0) OR block_sch|(cx%,cy%)=1 h$=h$+" " ELSE h$=h$+"S " ENDIF GRAPHMODE 3 TEXT 0,398*dvs,h$ a$="" GOSUB anzeige RETURN > PROCEDURE zahl_spalten LOCAL x1%,y1%,h$ GOSUB invert(0) a$="Zahl Spalten" GOSUB anzeige h$="(Esc) Zahl an Spalten (5 - 26) = " h%=breite% GOSUB ein.zahl(h$,h%,5,99,2,3) IF VAL(aus$)<>-1 br_neu%=VAL(aus$) br_neu%=MIN(26,br_neu%) br_neu%=MAX(5,br_neu%) IF br_neu%<>breite% h_neu%=MIN(5200/br_neu%,999) ! CALC_100: 5200->2600 h%=1 IF br_neu% PROCEDURE tauschen2 h$=ein$(x1%,y1%) ein$(x1%,y1%)=hlp$(x1%,y1%) hlp$(x1%,y1%)=h$ IF LEFT$(ein$(x1%,y1%),1)="=" GOSUB rechne.zelle(x1%,y1%) ENDIF GOSUB format.zelle(x1%,y1%) RETURN > PROCEDURE save.gdaten a$="Spch Grafikdaten" GOSUB select2 IF wahl$<>"" AND wahl$<>"\" OPEN "O",#1,wahl$ PRINT #1;reih% PRINT #1;ueb1$ PRINT #1;ueb2$ PRINT #1;offs PRINT #1;rei PRINT #1;beginn% PRINT #1;bezrei% PRINT #1;spa PRINT #1;beginn2% PRINT #1;bez% PRINT #1;fak PRINT #1;offs CLOSE #1 ELSE GOSUB inv_anzeige ENDIF RETURN > PROCEDURE load.gdaten a$="Laden Grafikdaten" GOSUB select2 IF wahl$<>"" AND wahl$<>"\" OPEN "I",#1,wahl$ INPUT #1,reih% INPUT #1,ueb1$ INPUT #1,ueb2$ INPUT #1,offs INPUT #1,rei INPUT #1,beginn% INPUT #1,bezrei% INPUT #1,spa INPUT #1,beginn2% INPUT #1,bez% IF EOF(#1)=FALSE INPUT #1,fak INPUT #1,offs ENDIF CLOSE #1 GOSUB daten.uebernahme ELSE GOSUB inv_anzeige ENDIF RETURN > PROCEDURE select2 GOSUB invert(0) GOSUB anzeige h$=pfad3$+"*.GFK" SGET screen$ FILESELECT h$,file3$,wahl$ IF LEN(wahl$)>4 IF RIGHT$(wahl$,4)<>".GFK" GOSUB anhang_endung(".GFK") ENDIF ELSE IF wahl$<>"" AND wahl$<>"\" GOSUB anhang_endung(".GFK") file3$=RIGHT$(wahl$,LEN(wahl$)-RINSTR(wahl$,"\")) ENDIF ENDIF IF wahl$<>"" AND wahl$<>"\" file3$=RIGHT$(wahl$,LEN(wahl$)-RINSTR(wahl$,"\")) pfad3$=LEFT$(wahl$,RINSTR(wahl$,"\")) ENDIF SPUT screen$ RETURN > PROCEDURE anhang_endung(h$) ai%=RINSTR(wahl$,".") IF ai%>0 wahl$=LEFT$(wahl$,ai%)+RIGHT$(h$,3) ELSE wahl$=wahl$+h$ ENDIF RETURN > PROCEDURE such.fehler GOSUB invert(0) CLR x1%,y1% FOR l_x%=cx% TO xmax% FOR l_y%=cy% TO ymax% IF LEFT$(aus$(l_x%,l_y%),1)=CHR$(127) x1%=l_x% y1%=l_y% ENDIF EXIT IF x1%<>0 NEXT l_y% EXIT IF x1%<>0 NEXT l_x% IF x1%=0 OUT 2,7 ALERT 0,"Keine Fehler gefunden | ",1," okay ",in% GOSUB invert(1) ELSE x%=x1% y%=y1% cx%=x1% cy%=y1% GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF RETURN > PROCEDURE block.werte IF b1x%>b2x% OR b1y%>b2y% ALERT 3,"BLOCK-Koordinaten falsch| gew„hlt !!",1,"Abbruch",h% h%=4 ELSE GOSUB invert(0) a$="Block -> Werte" GOSUB anzeige ALERT 1,"Zellinhalte im Blockbereich|in die absoluten Werte|„ndern ?",2," okay | nein ",in% IF in%=1 GOSUB test_schutz(b1x%,b2x%,b1y%,b2y%) IF geschutzt!=FALSE gespeichert!=FALSE DEFMOUSE 2 FOR l_x%=b1x% TO b2x% FOR l_y%=b1y% TO b2y% IF LEFT$(ein$(l_x%,l_y%),1)="=" OR (ASC(ein$(l_x%,l_y%))>=48 AND ASC(ein$(l_x%,l_y%))<=57) ein$(l_x%,l_y%)=STR$(erg(l_x%,l_y%)) aus$(l_x%,l_y%)=ein$(l_x%,l_y%) GOSUB format.zelle(l_x%,l_y%) ENDIF NEXT l_y% NEXT l_x% DEFMOUSE 0 GOSUB aufbau.screen(x%,y%,cx%,cy%) ELSE GOSUB inv_anzeige ENDIF ELSE GOSUB inv_anzeige ENDIF ENDIF RETURN > PROCEDURE zeile.einfugen GOSUB invert(0) a$="Zeile einfgen" GOSUB anzeige IF ymax%=hoehe% ALERT 3,"Daten in Zeile 200|gehen verloren !",2," okay |Abbruch",in% ELSE in%=1 INC ymax% ENDIF IF in%=1 DEFMOUSE 2 gespeichert!=FALSE FOR l_y%=ymax% DOWNTO cy%+1 FOR l_x%=1 TO xmax% ein$(l_x%,l_y%)=ein$(l_x%,l_y%-1) IF LEFT$(ein$(l_x%,l_y%),1)="=" CLR a% REPEAT a%=INSTR(ein$(l_x%,l_y%),CHR$(126),a%+1) IF a%<>0 GOSUB endern.koord2(1) ENDIF UNTIL a%=0 RESTORE funktion DO READ f$ EXIT IF f$="END" REPEAT a%=INSTR(ein$(l_x%,l_y%),f$,a%+1) IF a%<>0 ADD a%,4 GOSUB endern.koord2(1) a%=INSTR(ein$(l_x%,l_y%),":",a%) GOSUB endern.koord2(1) ENDIF UNTIL a%=0 LOOP ENDIF aus$(l_x%,l_y%)=aus$(l_x%,l_y%-1) erg(l_x%,l_y%)=erg(l_x%,l_y%-1) block_sch|(l_x%,l_y%)=block_sch|(l_x%,l_y%-1) NEXT l_x% NEXT l_y% FOR l_x%=1 TO xmax% GOSUB blank_zelle(l_x%,cy%) block_sch|(l_x%,cy%)=0 NEXT l_x% geandert!=TRUE GOSUB recalc DEFMOUSE 0 ELSE GOSUB inv_anzeige ENDIF RETURN > PROCEDURE zeile.loschen GOSUB invert(0) a$="Zeile l”schen" GOSUB anzeige ALERT 3,"ZEILE wirklich L™SCHEN ??",2," okay | nein ",in% IF in%=1 GOSUB test_schutz(1,xmax%,cy%,cy%) IF geschutzt!=FALSE DEFMOUSE 2 gespeichert!=FALSE IF ymax%>=cy% DEC ymax% FOR l_y%=cy% TO ymax% FOR l_x%=1 TO xmax% ein$(l_x%,l_y%)=ein$(l_x%,l_y%+1) IF LEFT$(ein$(l_x%,l_y%),1)="=" CLR a% REPEAT a%=INSTR(ein$(l_x%,l_y%),CHR$(126),a%+1) IF a%<>0 GOSUB endern.koord2(-1) ENDIF UNTIL a%=0 RESTORE funktion DO READ f$ EXIT IF f$="END" REPEAT a%=INSTR(ein$(l_x%,l_y%),f$,a%+1) IF a%<>0 ADD a%,4 GOSUB endern.koord2(-1) a%=INSTR(ein$(l_x%,l_y%),":",a%) GOSUB endern.koord2(-1) ENDIF UNTIL a%=0 LOOP ENDIF aus$(l_x%,l_y%)=aus$(l_x%,l_y%+1) erg(l_x%,l_y%)=erg(l_x%,l_y%+1) block_sch|(l_x%,l_y%)=block_sch|(l_x%,l_y%+1) NEXT l_x% NEXT l_y% FOR l_x%=1 TO xmax% GOSUB blank_zelle(l_x%,ymax%+1) block_sch|(l_x%,ymax%+1)=0 NEXT l_x% ENDIF geandert!=TRUE GOSUB recalc DEFMOUSE 0 ELSE GOSUB inv_anzeige ENDIF ELSE GOSUB inv_anzeige ENDIF RETURN > PROCEDURE spalte.einfugen GOSUB invert(0) a$="Spalte einfgen" GOSUB anzeige IF xmax%=breite% ALERT 3,"Daten in Spalte Z|gehen verloren !",2," okay |Abbruch",in% ELSE in%=1 INC xmax% ENDIF IF in%=1 gespeichert!=FALSE DEFMOUSE 2 FOR l_x%=breite% DOWNTO cx%+1 IF kopf$(l_x%-1)<>CHR$(l_x%+63) kopf$(l_x%)=kopf$(l_x%-1) ENDIF NEXT l_x% FOR l_x%=breite% DOWNTO cx%+1 breite%(l_x%)=breite%(l_x%-1) komma%(l_x%)=komma%(l_x%-1) FOR l_y%=1 TO hoehe% ein$(l_x%,l_y%)=ein$(l_x%-1,l_y%) IF LEFT$(ein$(l_x%,l_y%),1)="=" CLR a% REPEAT a%=INSTR(ein$(l_x%,l_y%),CHR$(126),a%+1) IF a%<>0 GOSUB endern.koord3(1) ENDIF UNTIL a%=0 RESTORE funktion DO READ f$ EXIT IF f$="END" REPEAT a%=INSTR(ein$(l_x%,l_y%),f$,a%+1) IF a%<>0 ADD a%,4 GOSUB endern.koord3(1) a%=INSTR(ein$(l_x%,l_y%),":",a%) GOSUB endern.koord3(1) ENDIF UNTIL a%=0 LOOP ENDIF aus$(l_x%,l_y%)=aus$(l_x%-1,l_y%) erg(l_x%,l_y%)=erg(l_x%-1,l_y%) block_sch|(l_x%,l_y%)=block_sch|(l_x%-1,l_y%) NEXT l_y% NEXT l_x% kopf$(cx%)=CHR$(cx%+64) breite%(cx%)=breite%(0) komma%(cx%)=komma%(0) FOR l_y%=1 TO hoehe% GOSUB blank_zelle(cx%,l_y%) block_sch|(cx%,l_y%)=0 NEXT l_y% geandert!=TRUE GOSUB recalc DEFMOUSE 0 ELSE GOSUB inv_anzeige ENDIF RETURN > PROCEDURE spalte.loschen GOSUB invert(0) a$="Spalte l”schen" GOSUB anzeige ALERT 3,"SPALTE wirklich L™SCHEN ??",2," okay | nein ",in% IF in%=1 GOSUB test_schutz(cx%,cx%,1,ymax%) IF geschutzt!=FALSE DEFMOUSE 2 gespeichert!=FALSE IF xmax%>=cx% DEC xmax% FOR l_x%=cx% TO breite%-1 IF kopf$(l_x%+1)<>CHR$(l_x%+65) kopf$(l_x%)=kopf$(l_x%+1) ENDIF breite%(l_x%)=breite%(l_x%+1) komma%(l_x%)=komma%(l_x%+1) FOR l_y%=1 TO hoehe% ein$(l_x%,l_y%)=ein$(l_x%+1,l_y%) IF LEFT$(ein$(l_x%,l_y%),1)="=" CLR a% REPEAT a%=INSTR(ein$(l_x%,l_y%),CHR$(126),a%+1) IF a%<>0 GOSUB endern.koord3(-1) ENDIF UNTIL a%=0 RESTORE funktion DO READ f$ EXIT IF f$="END" REPEAT a%=INSTR(ein$(l_x%,l_y%),f$,a%+1) IF a%<>0 ADD a%,4 GOSUB endern.koord3(-1) a%=INSTR(ein$(l_x%,l_y%),":",a%) GOSUB endern.koord3(-1) ENDIF UNTIL a%=0 LOOP ENDIF aus$(l_x%,l_y%)=aus$(l_x%+1,l_y%) erg(l_x%,l_y%)=erg(l_x%+1,l_y%) block_sch|(l_x%,l_y%)=block_sch|(l_x%+1,l_y%) NEXT l_y% NEXT l_x% flag!=FALSE FOR l_x%=breite% DOWNTO cx% IF kopf$(l_x%)<>CHR$(l_x%+64) flag!=TRUE kopf$(l_x%)=CHR$(l_x%+64) ENDIF EXIT IF flag!=TRUE NEXT l_x% breite%(xmax%+1)=breite%(0) komma%(xmax%+1)=komma%(0) FOR l_y%=1 TO hoehe% GOSUB blank_zelle(xmax%+1,l_y%) block_sch|(xmax%+1,l_y%)=0 NEXT l_y% ENDIF geandert!=TRUE GOSUB recalc DEFMOUSE 0 ELSE GOSUB inv_anzeige ENDIF ELSE GOSUB inv_anzeige ENDIF RETURN > PROCEDURE endern.koord2(dy%) e1$=LEFT$(ein$(l_x%,l_y%),a%+1) a1%=VAL(MID$(ein$(l_x%,l_y%),a%+2)) IF a1%>=cy% a1%=VAL?(MID$(ein$(l_x%,l_y%),a%+2)) ein$=MID$(ein$(l_x%,l_y%),a%+2) ein$=STR$(VAL(ein$)+dy%)+MID$(ein$,1+a1%) IF LEFT$(ein$,1)="0" MID$(ein$,1,1)="1" ENDIF ein$(l_x%,l_y%)=e1$+ein$ ENDIF RETURN > PROCEDURE endern.koord3(dx%) e1$=LEFT$(ein$(l_x%,l_y%),a%) a1%=ASC(MID$(ein$(l_x%,l_y%),a%+1))-64 IF a1%>=cx% ein$=MID$(ein$(l_x%,l_y%),a%+1) ein$=CHR$(ASC(LEFT$(ein$,1))+dx%)+MID$(ein$,2) IF LEFT$(ein$,1)=CHR$(64) MID$(ein$,1,1)="A" ENDIF ein$(l_x%,l_y%)=e1$+ein$ ENDIF RETURN > PROCEDURE nachkomma LOCAL x1%,y1% DEFMOUSE 2 FOR x1%=1 TO xmax% FOR y1%=1 TO ymax% GOSUB format.zelle(x1%,y1%) NEXT y1% NEXT x1% GOSUB aufbau.screen(x%,y%,cx%,cy%) DEFMOUSE 0 RETURN > PROCEDURE merken LOCAL h$ mx%=cx% my%=cy% TEXT 48,398*dvs," " h$=CHR$(mx%+64)+STR$(my%)+" " GRAPHMODE 4 TEXT 48,398*dvs,h$ GRAPHMODE 1 RETURN > PROCEDURE copy.cel.abs IF (schutz!=FALSE AND block_sch|(cx%,cy%)=0) OR block_sch|(cx%,cy%)=1 ein$(cx%,cy%)=ein$(mx%,my%) erg(cx%,cy%)=erg(mx%,my%) GOSUB format.zelle(cx%,cy%) GOSUB invert(1) GOSUB c.minimax ELSE OUT 2,7 ALERT 3," ZELLE GESCHšTZT ! ",1," ok ",in% ENDIF RETURN > PROCEDURE copy.cel.rel IF (schutz!=FALSE AND block_sch|(cx%,cy%)=0) OR block_sch|(cx%,cy%)=1 dx%=cx%-mx% dy%=cy%-my% x1%=1 y1%=1 hlp$(x1%,y1%)=ein$(mx%,my%) IF LEFT$(hlp$(x1%,y1%),1)="=" CLR a% REPEAT a%=INSTR(hlp$(x1%,y1%),CHR$(126),a%+1) IF a%<>0 GOSUB endern.koord ENDIF UNTIL a%=0 RESTORE funktion DO READ f$ EXIT IF f$="END" REPEAT a%=INSTR(hlp$(x1%,y1%),f$,a%+1) IF a%<>0 ADD a%,4 GOSUB endern.koord a%=INSTR(hlp$(x1%,y1%),":",a%) GOSUB endern.koord ENDIF UNTIL a%=0 LOOP ENDIF ein$(cx%,cy%)=hlp$(x1%,y1%) hlp$(x1%,y1%)="" IF LEFT$(ein$(cx%,cy%),1)="=" GOSUB rechne.zelle(cx%,cy%) ENDIF GOSUB format.zelle(cx%,cy%) GOSUB invert(1) GOSUB c.minimax ELSE OUT 2,7 ALERT 3," ZELLE GESCHšTZT ! ",1," ok ",in% ENDIF RETURN > PROCEDURE line.feed gespeichert!=FALSE MENU 35,lfeed!+1 lfeed!=NOT lfeed! RETURN > PROCEDURE trennzeichen gespeichert!=FALSE MENU 36,trennz!+1 trennz!=NOT trennz! RETURN > PROCEDURE bogenmass gespeichert!=FALSE IF grd<>1 grd=1 MENU 69,1 ELSE grd=PI/180 MENU 69,0 ENDIF RETURN > PROCEDURE nullen gespeichert!=FALSE MENU 34,null!+1 null!=NOT null! GOSUB nachkomma RETURN > PROCEDURE help.screen CLS PRINT AT(12,2);CHR$(27);"p F U N K T I O N E N ";CHR$(27);"q" PRINT AT(9,4);"#PI -- Wert fr Pi (3.14...)" PRINT AT(46,4);"#DAT -- Datum" PRINT AT(6,6);"#SQR() -- Wurzel" PRINT AT(6,7);"#LOG() -- Nat. Logarithmus" PRINT AT(44,7);"#CLG() -- dek. Logarithmus" PRINT AT(44,6);"#EXP() -- Exponentiation" PRINT AT(6,8);"#SIN() -- Sinus" PRINT AT(44,8);"#COS() -- Cosinus" PRINT AT(6,9);"#TAN() -- Tangens" PRINT AT(44,9);"#ATN() -- Arcustangens" PRINT AT(6,10);"#INT() -- Integer" PRINT AT(44,10);"#ABS() -- Absolutwert" PRINT AT(6,11);"#RND() -- Runden auf Ganzzahl" PRINT AT(44,11);"#FAK() -- Fakult„t" PRINT AT(12,13);"#SUM(A1:Z100) -- Summe" PRINT AT(12,14);"#MUL(A1:Z100) -- Produkt" PRINT AT(12,15);"#AVE(A1:Z100) -- Durchschnitt" PRINT AT(12,16);"#STA(A1:Z100) -- Standardabweichung (div. n-1)" PRINT AT(12,17);"#STD(A1:Z100) -- Standardabweichung (div. n)" PRINT AT(12,18);"#QWN(A1:Z100) -- Quadratischer Mittelwert (div. n)" PRINT AT(12,19);"#QMW(A1:Z100) -- Quadratischer Mittelwert (div. n-1)" PRINT AT(12,20);"#MIN(A1:Z100) -- Minimum" PRINT AT(12,21);"#MAX(A1:Z100) -- Maximum" PRINT AT(12,23);"#NUN(N:n) -- N ber n = N!/(n!*(N-n)!)" REPEAT UNTIL MOUSEK OR INKEY$<>"" GOSUB aufbau.screen(x%,y%,cx%,cy%) RETURN ' > PROCEDURE infozeile LOCAL h$,a$ h$=" frei="+STR$(FRE(0)-100000)+" " a$=SPACE$(80) IF (schutz!=FALSE AND block_sch|(cx%,cy%)=0) OR block_sch|(cx%,cy%)=1 MID$(a$,1)=CHR$(cx%+64)+STR$(cy%) ELSE MID$(a$,1)=CHR$(cx%+64)+STR$(cy%)+"S" ENDIF MID$(a$,7)=CHR$(mx%+64)+STR$(my%) MID$(a$,13)="Block lo="+CHR$(b1x%+64)+STR$(b1y%) MID$(a$,27)="ru="+CHR$(b2x%+64)+STR$(b2y%) MID$(a$,36)="Breite="+STR$(bl.breite%)+"/"+STR$(all.breite%) MID$(a$,81-LEN(h$))=h$ GRAPHMODE 4 TEXT 0,398*dvs,SPACE$(80) GRAPHMODE 3 TEXT 0,398*dvs,a$ a$="" GOSUB anzeige RETURN > PROCEDURE beweg.cursor IF (aa%=72 OR aa%=200) AND cy%>1 GOSUB hoch(1) ENDIF IF (aa%=80 OR aa%=208) AND cy%1 GOSUB links(1) ENDIF anz2 RETURN > PROCEDURE aufbau.screen(x%,sy%,cx%,cy%) COLOR 1 IF grafik!=FALSE DEFMOUSE 0 GOSUB zahl.spalten(73) IF sy%>hoehe%-lng% y%=hoehe%-lng% sy%=y% ENDIF CLS PUT 0,12-12*test%,copyright$ ENDIF DEFTEXT 1,0,0,13+7*test% h$=" "+CHR$(14)+CHR$(15)+" BLATT FORMAT BLOCK ZELLE SPEZIAL GRAFIK" TEXT 0,16+8*test%,h$ DEFLINE 1 LINE 0,18+8*test%,639,18+8*test% IF grafik!=FALSE breit%=6 FOR xs%=x% TO spalten% PRINT AT(breit%,5);LEFT$(kopf$(xs%),breite%(xs%)) DEFTEXT 1,,,6+2*test% TEXT breit%*8-8-2*test%,60+31*test%,CHR$(xs%+64) ADD breit%,(breite%(xs%)+1) NEXT xs% DEFTEXT 1,,,13+7*test% tief%=6 FOR ys%=sy% TO sy%+lng% PRINT AT(2,tief%);USING "### ",ys%; FOR xs%=x% TO spalten% PRINT aus$(xs%,ys%); NEXT xs% INC tief% NEXT ys% x1%=36 y1%=95+48*test%+lng%*16*dvs LINE x1%,63+23*test%,x1%,y1% DEFLINE &X11111111111111111010101010101011 FOR xs%=x% TO spalten% ADD x1%,breite%(xs%)*8+8 IF xs%<>spalten% LINE x1%,63+23*test%,x1%,y1% ENDIF NEXT xs% CLR zl% FOR ys%=63*dvs TO y1%-16*dvs STEP 16*dvs INC zl% IF zl%<3 DEFLINE 1 ELSE DEFLINE &X11111111111111111010101010101011 ENDIF LINE 4,ys%,x1%,ys% NEXT ys% DEFLINE 1 LINE x1%,63*dvs,x1%,y1% LINE 4,y1%,x1%,y1% LINE 3,63*dvs,3,y1% GOSUB zeichne_schieber1(x%) GOSUB zeichne_schieber2(sy%) GOSUB infozeile GOSUB invert(1) ENDIF REPEAT UNTIL INKEY$="" RETURN > PROCEDURE zeichne_schieber1(x%) DEFFILL 1,0 PBOX 622,57*dvs,638,131*dvs DEFTEXT 1,0,0,13+9*test% TEXT 626-2*test%,71*dvs+2*test%,CHR$(4) TEXT 627-2*test%,128*dvs+test%,CHR$(3) DEFTEXT 1,,,6+2*test% TEXT 626-2*test%,84*dvs+test%,CHR$(x%+64) DEFTEXT 1,,,13+7*test% LINE 623,73*dvs+test%,638,73*dvs+test% LINE 623,115*dvs-test%,638,115*dvs-test% LINE 623,88*dvs+test%,638,88*dvs+test% DEFLINE &X11111111111111111010101010101011 delta_x=26/breite% LINE 623,(88+x%*delta_x)*dvs,637,(88+x%*delta_x)*dvs DEFLINE 1 RETURN > PROCEDURE zeichne_schieber2(y%) DEFFILL 1,0 PBOX 622,135*dvs,638,383*dvs DEFTEXT 1,0,0,13+9*test% TEXT 626-2*test%,149*dvs+2*test%,CHR$(1) TEXT 626-2*test%,380*dvs+test%,CHR$(2) DEFTEXT 1,,,6+2*test% TEXT 624-2*test%,161*dvs+test%,13+3*test%,CHR$(1)+CHR$(1) TEXT 624-2*test%,361*dvs-test%,13+3*test%,CHR$(2)+CHR$(2) DEFTEXT 1,,,13+7*test% LINE 623,151*dvs+test%,638,151*dvs+test% LINE 623,367*dvs-test%,638,367*dvs-test% DEFLINE 1 GOSUB zeichne_schieber3(y%) RETURN > PROCEDURE zeichne_schieber3(y%) IF y%=1 DEFFILL 1,0 PBOX 622,167*dvs+test%,638,(167+lng%*182/hoehe%)*dvs DEFFILL 2,2,4 PBOX 622,(167+lng%*182/hoehe%)*dvs,638,351*dvs-test% ELSE IF y%=hoehe%-lng% DEFFILL 1,0 PBOX 622,(351-lng%*182/hoehe%)*dvs,638,351*dvs-test% DEFFILL 2,2,4 PBOX 622,167*dvs+test%,638,(351-lng%*182/hoehe%)*dvs ELSE DEFFILL 1,0 PBOX 622,(168+y%*182/hoehe%)*dvs,638,(168+(y%+lng%)*182/hoehe%)*dvs-test% DEFFILL 3,2,4 PBOX 622,167*dvs+test%,638,(168+y%*182/hoehe%)*dvs PBOX 622,(168+(y%+lng%)*182/hoehe%)*dvs-test%,638,351*dvs-test% ENDIF ENDIF RETURN ' > PROCEDURE hoch(dy%) GOSUB invert(0) SUB cy%,dy% IF cy% PROCEDURE runter(flag%) IF flag% GOSUB invert(0) ENDIF INC cy% IF cy%>y%+lng% WHILE cy%>y%+lng% INC y% WEND IF flag% GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF ELSE IF flag% GOSUB invert(1) ENDIF RETURN > PROCEDURE rechts(flag%) IF flag% GOSUB invert(0) ENDIF INC cx% GOSUB zahl.spalten(73) IF cx%>spalten% REPEAT INC x% GOSUB zahl.spalten(73) UNTIL spalten%>=cx% IF flag% GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF ELSE IF flag% GOSUB invert(1) ENDIF RETURN > PROCEDURE links(dx%) GOSUB invert(0) SUB cx%,dx% IF cx% PROCEDURE zahl.spalten(b%) CLR br% FOR spalten%=x% TO breite% ADD br%,breite%(spalten%)+1 EXIT IF br%>b% NEXT spalten% DEC spalten% RETURN > PROCEDURE invert(inv%) IF inv%=1 inv$=ron$ ELSE inv$=roff$ ENDIF breit%=6 IF cx%>x% FOR xs%=x% TO cx%-1 ADD breit%,(breite%(xs%)+1) NEXT xs% ENDIF tief%=6+cy%-y% h$=LEFT$(aus$(cx%,cy%),LEN(aus$(cx%,cy%))-1) PRINT AT(breit%,tief%);inv$;h$;roff$ IF LEFT$(h$,1)=CHR$(127) AND inv%=1 PRINT CHR$(7); ENDIF IF inv%=0 breit%=breit%*8-8 tief%=tief%*16/(1-(aufloesung%=1))-1 IF cy%=y%+lng% DEFLINE 1 ELSE DEFLINE &X11111111111111111010101010101011 ENDIF LINE breit%,tief%,breit%+breite%(cx%)*8,tief% DEFLINE 1 ENDIF PRINT AT(2,3);ein$(cx%,cy%);" ";CHR$(27);"K" RETURN > PROCEDURE format.zelle(x%,y%) LOCAL h%,a% h$=ein$(x%,y%) IF LEFT$(h$,5)="=#DAT" h$=" "+DATE$ erg(x%,y%)=0 ELSE IF LEFT$(h$,1)="=" IF LEFT$(aus$(x%,y%),1)<>CHR$(127) h$=STR$(erg(x%,y%)) ELSE h$=aus$(x%,y%) erg(x%,y%)=0 ENDIF ELSE a1%=INSTR(h$," !") IF a1%<>0 h$=LEFT$(h$,a1%) ENDIF ENDIF ENDIF IF VAL?(LEFT$(h$,1))>0 OR (LEFT$(h$,1)="-" AND VAL?(MID$(h$,2,1))>0) IF VAL(h$)>1.0E-10 OR VAL(h$)<-1.0E-10 h=INT(VAL(h$)*10^komma%(x%)+0.49999999+1.0E-07*SGN(VAL(h$))) h1$=STR$(h/10^komma%(x%)) ELSE h=VAL(h$) h1$=h$ ENDIF h%=INSTR(h1$,".") IF h%=0 AND komma%(x%)>0 IF null!=TRUE h1$=h1$+"." ENDIF h%=LEN(h1$) ENDIF a%=INSTR(h1$,"E") IF a%=0 IF LEN(h1$)-h%=komma%(x%) h1$=LEFT$(h1$,h%+komma%(x%))+MID$(h1$,a%) ELSE IF null!=TRUE h1$=LEFT$(h1$,a%-1)+STRING$(komma%(x%)-a%+h%+1,"0")+MID$(h1$,a%) ENDIF ENDIF ENDIF h$=SPACE$(breite%(x%)) IF LEN(h1$)>breite%(x%) h$=STRING$(breite%(x%),"*") ELSE RSET h$=h1$ ENDIF ELSE h%=LEN(h$) IF h% PROCEDURE edit IF (schutz!=FALSE AND block_sch|(cx%,cy%)=0) OR block_sch|(cx%,cy%)=1 GOSUB c.minimax a$="Žndern" GOSUB anzeige FORM INPUT 77 AS ein$(cx%,cy%) IF LEFT$(ein$(cx%,cy%),1)="=" a%=INSTR(ein$(cx%,cy%)," !") IF a%<>0 ein$(cx%,cy%)=UPPER$(LEFT$(ein$(cx%,cy%),a%))+MID$(ein$(cx%,cy%),a%+1) ELSE ein$(cx%,cy%)=UPPER$(ein$(cx%,cy%)) ENDIF GOSUB rechne.zelle(cx%,cy%) ELSE erg(cx%,cy%)=VAL(ein$(cx%,cy%)) ENDIF GOSUB format.zelle(cx%,cy%) gespeichert!=FALSE geandert!=TRUE GOSUB inv_anzeige ELSE OUT 2,7 ALERT 3," ZELLE GESCHšTZT ! ",1," ok ",in% ENDIF RETURN > PROCEDURE c.minimax IF cx%>xmax% xmax%=cx% GOSUB breite.block GOSUB infozeile ENDIF IF cy%>ymax% ymax%=cy% GOSUB breite.block GOSUB infozeile ENDIF RETURN > PROCEDURE test.zelle(x%,y%,a$,b$) LOCAL a% REPEAT a%=INSTR(ein$(x%,y%),a$) IF a%<>0 MID$(ein$(x%,y%),a%,1)=b$ ENDIF UNTIL a%=0 REPEAT a%=INSTR(aus$(x%,y%),a$) IF a%<>0 MID$(aus$(x%,y%),a%,1)=b$ ENDIF UNTIL a%=0 RETURN > PROCEDURE recalc LOCAL x1%,y1% IF geandert!=FALSE ALERT 2,"Das Blatt ist seit der letzten|Berechnung nicht ver„ndert|worden. Trotzdem rechnen ?",2," ja | nein ",in% ELSE in%=1 ENDIF IF in%=1 geandert!=FALSE GOSUB invert(0) DEFMOUSE 2 a$="Berechnung" GOSUB anzeige FOR y1%=1 TO ymax% FOR x1%=1 TO xmax% IF LEFT$(ein$(x1%,y1%),1)="=" GOSUB rechne.zelle(x1%,y1%) GOSUB format.zelle(x1%,y1%) ENDIF NEXT x1% NEXT y1% GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF RETURN ' > PROCEDURE block.ru b2x%=cx% b2y%=cy% GOSUB test.block RETURN > PROCEDURE block.lo b1x%=cx% b1y%=cy% GOSUB test.block RETURN > PROCEDURE test.block GOSUB breite.block GOSUB infozeile IF b1x%>b2x% OR b1y%>b2y% PRINT CHR$(7) ENDIF RETURN ' > PROCEDURE laden GOSUB invert(0) LOCAL x1%,y1% h$="Laden von" GOSUB select(1) IF h%<>3 AND wahl$<>"" DEFMOUSE 2 OPEN "I",#1,wahl$ IF h%=1 INPUT #1,in$ INPUT #1,ein$ IF ein$="C" PRINT AT(2,3);"Bitte CODE eingeben (6 Zeichen) : ";CHR$(7); ein$="" FOR i%=1 TO 6 in$=INPUT$(1) ein$=ein$+in$ PRINT "."; NEXT i% PRINT AT(2,3);CHR$(27);"K" code!=TRUE cd%=3 GOSUB decode(ein$) code$=in$ IF ein$<>code$ code!=FALSE cd%=2 ENDIF ELSE code$="" cd%=2 code!=TRUE ENDIF IF code!=TRUE INPUT #1,breite% INPUT #1,tit_zl% IF tit_zl% MENU 68,1 ELSE MENU 68,0 ENDIF INPUT #1,tit_fl! hoehe%=MIN(5200/breite%,999) ! CALC_100: 5200->2600 ERASE hlp$() GOSUB array_loeschen IF code$<>"" cd%=3 ENDIF DIM hlp$(breite%,hoehe%) BGET #1,VARPTR(block_sch|(0,0)),5200 ! CALC_100: 5200->2600 INPUT #1,schutz! MENU 17,-schutz! INPUT #1,null! MENU 34,-null! INPUT #1,lfeed! MENU 35,-lfeed! INPUT #1,trennz! MENU 36,-trennz! INPUT #1,grd IF grd=1 MENU 69,1 ELSE MENU 69,0 ENDIF ELSE PRINT AT(2,3);"CODE FALSCH !";CHR$(7); CLOSE #1 PAUSE 50 ENDIF ELSE code!=TRUE ENDIF IF code!=TRUE INPUT #1,s1x% INPUT #1,s1y% INPUT #1,s2x% INPUT #1,s2y% IF h%=1 xmax%=s2x% ymax%=s2y% FOR x1%=1 TO breite% INPUT #1,breite%(x1%) INPUT #1,komma%(x1%) INPUT #1,kopf$(x1%) h$=SPACE$(breite%(x1%)+1) FOR y1%=1 TO hoehe% aus$(x1%,y1%)=h$ ein$(x1%,y1%)="" NEXT y1% NEXT x1% gespeichert!=TRUE geandert!=FALSE GOSUB breite.block ENDIF IF h%=2 s1x%=s1x%+cx%-1 s1y%=s1y%+cy%-1 s2x%=s2x%+cx%-1 s2y%=s2y%+cy%-1 gespeichert!=FALSE ENDIF IF s2x%>breite% OR s2y%>hoehe% ALERT 3," Block zu breit ! ",1," ok ",h% ELSE IF h%=2 GOSUB test_schutz(s1x%,s2x%,s1y%,s2y%) ELSE geschutzt!=FALSE ENDIF IF geschutzt!=FALSE FOR x1%=s1x% TO s2x% FOR y1%=s1y% TO s2y% IF cd%=1 OR cd%=3 GOSUB decode(code$) ein$(x1%,y1%)=in$ GOSUB decode(code$) aus$(x1%,y1%)=in$ ELSE INPUT #1;ein$(x1%,y1%) INPUT #1;aus$(x1%,y1%) ENDIF GOSUB test.zelle(x1%,y1%,CHR$(255),",") erg(x1%,y1%)=VAL(ein$(x1%,y1%)) IF LEFT$(ein$(x1%,y1%),1)="=" INPUT #1;erg(x1%,y1%) ENDIF IF h%=2 GOSUB format.zelle(x1%,y1%) ENDIF NEXT y1% NEXT x1% xmax%=MAX(x1%-1,xmax%) ymax%=MAX(y1%-1,ymax%) ENDIF ENDIF ENDIF CLOSE #1 GOSUB breite.block ENDIF GOSUB aufbau.screen(x%,y%,cx%,cy%) GOSUB inv_anzeige DEFMOUSE 0 RETURN > PROCEDURE speichern GOSUB invert(0) LOCAL x1%,y1% GOSUB select(0) IF h%<>3 AND e_flag!=FALSE AND wahl$<>"" DEFMOUSE 2 OPEN "O",#1,wahl$ IF h%=1 REPEAT in$=CHR$(RANDOM(93)+33) UNTIL in$<>CHR$(44) PRINT #1;in$ IF cd%=1 ein$="" PRINT AT(2,3);CHR$(7);"Bitte CODE eingeben (6 Zeichen) : "; FORM INPUT 6 AS ein$ ein$=ein$+" " code$=LEFT$(ein$,6) PRINT #1;"C" GOSUB code(code$) ELSE IF cd%=3 PRINT #1;"C" GOSUB code(code$) ELSE PRINT #1;"N" ENDIF PRINT #1;breite% PRINT #1;tit_zl% PRINT #1;tit_fl! BPUT #1,VARPTR(block_sch|(0,0)),5200 ! CALC_100: 5200->2600 PRINT #1;schutz! PRINT #1;null! PRINT #1;lfeed! PRINT #1;trennz! PRINT #1;grd PRINT #1;s1x% PRINT #1;s1y% PRINT #1;s2x% PRINT #1;s2y% ELSE PRINT #1;1 PRINT #1;1 PRINT #1;s2x%-s1x%+1 PRINT #1;s2y%-s1y%+1 ENDIF IF h%=1 FOR x1%=1 TO breite% PRINT #1;breite%(x1%) PRINT #1;komma%(x1%) PRINT #1;kopf$(x1%) NEXT x1% gespeichert!=TRUE ENDIF FOR x1%=s1x% TO s2x% FOR y1%=s1y% TO s2y% IF cd%=1 OR cd%=3 GOSUB code(ein$(x1%,y1%)) GOSUB code(aus$(x1%,y1%)) ELSE GOSUB test.zelle(x1%,y1%,",",CHR$(255)) PRINT #1;ein$(x1%,y1%) PRINT #1;aus$(x1%,y1%) GOSUB test.zelle(x1%,y1%,CHR$(255),",") ENDIF IF LEFT$(ein$(x1%,y1%),1)="=" PRINT #1;erg(x1%,y1%) ENDIF NEXT y1% NEXT x1% ENDIF CLOSE #1 GOSUB inv_anzeige DEFMOUSE 0 RETURN > PROCEDURE code(in$) LOCAL i%,a% FOR i%=0 TO LEN(in$)-1 MID$(in$,i%+1,1)=CHR$(ASC(MID$(in$,i%+1,1))+(ASC(MID$(code$,i% MOD 5+1,1)) MOD 50)) NEXT i% REPEAT a%=INSTR(in$,",") IF a%<>0 MID$(in$,a%,1)=CHR$(255) ENDIF UNTIL a%=0 PRINT #1;in$ RETURN > PROCEDURE decode(code$) LOCAL i%,a% INPUT #1,in$ REPEAT a%=INSTR(in$,CHR$(255)) IF a%<>0 MID$(in$,a%,1)="," ENDIF UNTIL a%=0 FOR i%=0 TO LEN(in$)-1 MID$(in$,i%+1,1)=CHR$(ASC(MID$(in$,i%+1,1))-(ASC(MID$(code$,i% MOD 5+1,1)) MOD 50)) NEXT i% RETURN ' > PROCEDURE breite LOCAL y1% GOSUB invert(0) a$="Breite stellen" GOSUB anzeige h$="(Esc) Breite Spalte (1 - 72) "+CHR$(cx%+64)+" = " GOSUB ein.zahl(h$,breite%(cx%),1,99,2,3) IF VAL(aus$)<>-1 DEFMOUSE 2 breite%(cx%)=MIN(VAL(aus$),72) FOR y1%=1 TO hoehe% GOSUB format.zelle(cx%,y1%) NEXT y1% GOSUB adjust.screen DEFMOUSE 0 ELSE GOSUB inv_anzeige ENDIF RETURN > PROCEDURE breite.all LOCAL y1% GOSUB invert(0) a$="Breite stellen" GOSUB anzeige h$="(Esc) Breite aller Spalten (1 - 72) = " GOSUB ein.zahl(h$,breite%(0),1,99,2,3) IF VAL(aus$)<>-1 DEFMOUSE 2 ARRAYFILL breite%(),MIN(VAL(aus$),72) FOR sx%=1 TO breite% FOR y1%=1 TO hoehe% GOSUB format.zelle(sx%,y1%) NEXT y1% NEXT sx% GOSUB adjust.screen DEFMOUSE 0 ELSE GOSUB inv_anzeige ENDIF RETURN > PROCEDURE adjust.screen GOSUB breite.block gespeichert!=FALSE DEC x% REPEAT INC x% GOSUB zahl.spalten(73) UNTIL spalten%>=cx% GOSUB aufbau.screen(x%,y%,cx%,cy%) RETURN > PROCEDURE komma LOCAL y1% GOSUB invert(0) a$="Komma stellen" GOSUB anzeige h$="(Esc) Nachkommastellen Spalte "+CHR$(cx%+64)+" = " GOSUB ein.zahl(h$,komma%(cx%),0,9,2,3) IF VAL(aus$)<>-1 DEFMOUSE 2 komma%(cx%)=VAL(aus$) gespeichert!=FALSE FOR y1%=1 TO ymax% GOSUB format.zelle(cx%,y1%) NEXT y1% GOSUB aufbau.screen(x%,y%,cx%,cy%) ELSE GOSUB inv_anzeige ENDIF RETURN > PROCEDURE komma.all LOCAL y1% GOSUB invert(0) a$="Komma stellen" GOSUB anzeige h$="(Esc) Nachkommastellen fr alle Spalten = " GOSUB ein.zahl(h$,komma%(0),0,9,2,3) IF VAL(aus$)<>-1 DEFMOUSE 2 ARRAYFILL komma%(),VAL(aus$) FOR sx%=1 TO xmax% FOR y1%=1 TO ymax% GOSUB format.zelle(sx%,y1%) NEXT y1% NEXT sx% gespeichert!=FALSE GOSUB aufbau.screen(x%,y%,cx%,cy%) ELSE GOSUB inv_anzeige ENDIF RETURN > PROCEDURE inv_anzeige GOSUB invert(1) a$="" GOSUB anzeige RETURN > PROCEDURE copy.abs h2$="Kopieren" GOSUB block.abs(0) RETURN > PROCEDURE copy.rel h2$="Kopieren rel." GOSUB block.rel(0) RETURN > PROCEDURE move.abs h2$="Verschieben" GOSUB block.abs(1) RETURN > PROCEDURE move.rel h2$="Verschieben rel." GOSUB block.rel(1) RETURN > PROCEDURE gehe.zelle GOSUB invert(0) PRINT AT(2,3);CHR$(27);"l" PRINT AT(2,3);"Gehe Zelle ";CHR$(27);"p ";CHR$(27);"q"; REPEAT k$=INKEY$ UNTIL (k$>="A" AND k$<="Z") OR (k$>="a" AND k$<="z") OR (k$=CHR$(13)) IF k$<>CHR$(13) x%=ASC(k$)+32*(k$>"Z")-64 cx%=x% h$="Gehe Zelle "+CHR$(x%+64) GOSUB ein.zahl(h$,1,1,hoehe%,2,3) y%=VAL(aus$) cy%=y% GOSUB aufbau.screen(x%,y%,cx%,cy%) ELSE PRINT AT(2,3);CHR$(27);"l ";ein$(cx%,cy%) GOSUB invert(1) ENDIF RETURN > PROCEDURE gehe.a1 cx%=1 cy%=1 IF x%=1 AND y%=1 GOSUB invert(0) anz2 GOSUB invert(1) ELSE x%=1 y%=1 GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF RETURN ' > PROCEDURE drucken GOSUB invert(0) a$="Ausdruck" GOSUB anzeige SGET screen$ GOSUB draw.ausdruck GOSUB control.ausdruck SPUT screen$ IF h%<>3 GOSUB koordinaten(h%) IF e_flag!=FALSE DEFMOUSE 2 IF a1%=1 OPEN "O",#2,"PRN:" PRINT #2;CHR$(27);"R";CHR$(2);CHR$(27);"l";CHR$(0); ELSE SGET screen$ FILESELECT "\*.TXT","",dfile$ SPUT screen$ IF dfile$<>"" OPEN "O",#2,dfile$ ENDIF ENDIF IF a1%=1 OR dfile$<>"" IF h%=1 a%=all.breite% ELSE a%=bl.breite% ENDIF IF a1%=1 links$=SPACE$(6) PRINT #2;CHR$(18);CHR$(27);"P"; IF a%>74+4*(z!=TRUE) IF a%>88+4*(z!=TRUE) IF a%>122+4*(z!=TRUE) PRINT #2;CHR$(27);"M";CHR$(15); links$=SPACE$(12) ELSE PRINT #2;CHR$(15); links$=SPACE$(10) ENDIF ELSE PRINT #2;CHR$(27);"M"; links$=SPACE$(8) ENDIF ENDIF ENDIF CLR zeilen% IF t!=TRUE GOSUB dr_kopf ENDIF IF ymax%>tit_zl% FOR d_y%=s1y%+tit_zl% TO s2y% GOSUB dr_zeile IF zeilen%>64 AND a1%=1 PRINT #2;CHR$(12); CLR zeilen% IF t!=TRUE GOSUB dr_kopf ENDIF ENDIF NEXT d_y% ENDIF IF a1%=1 PRINT #2;CHR$(12); ENDIF CLOSE #2 ENDIF ENDIF ENDIF GOSUB inv_anzeige DEFMOUSE 0 RETURN > PROCEDURE dr_kopf LOCAL x%,d_y% PRINT #2;links$; IF z!=TRUE PRINT #2;" "; ENDIF FOR x%=s1x% TO s2x% h$=kopf$(x%) IF LEN(h$)>=breite%(x%) h$=LEFT$(h$,breite%(x%)) ELSE h$=h$+SPACE$(breite%(x%)-LEN(h$)) ENDIF GOSUB test.umlaut IF trennz!=FALSE PRINT #2;h$;" "; ELSE PRINT #2;h$;"!"; ENDIF NEXT x% zeilen%=2 IF lfeed!=TRUE PRINT #2 ELSE PRINT #2;CHR$(13); ENDIF IF tit_zl%>0 AND ymax%>=tit_zl% IF tit_fl!=FALSE FOR d_y%=1 TO tit_zl% GOSUB dr_zeile NEXT d_y% ELSE FOR d_y%=1 TO tit_zl% h$=LEFT$(ein$(1,d_y%),75) GOSUB test.umlaut PRINT #2;links$;h$; INC zeilen% IF lfeed!=TRUE PRINT #2 ELSE PRINT #2;CHR$(13); ENDIF NEXT d_y% ENDIF ENDIF IF lfeed!=TRUE PRINT #2 ELSE PRINT #2;CHR$(13); ENDIF RETURN > PROCEDURE dr_zeile LOCAL x% PRINT #2;links$; IF z!=TRUE PRINT #2;USING "###_ ",d_y%; ENDIF FOR x%=s1x% TO s2x% h$=aus$(x%,d_y%) GOSUB test.umlaut IF trennz!=FALSE PRINT #2;h$; ELSE PRINT #2;LEFT$(h$,LEN(h$)-1);"!"; ENDIF NEXT x% INC zeilen% IF lfeed!=TRUE PRINT #2 ELSE PRINT #2;CHR$(13); ENDIF RETURN > PROCEDURE draw.ausdruck GRAPHMODE 1 GOSUB shadow.box(170,60*dvs,480,305*dvs,2,4) GRAPHMODE 4 DEFFILL ,2,8 PBOX 120,70*dvs,120,70*dvs PBOX 120,70*dvs,520,90*dvs GRAPHMODE 1 DEFFILL ,2,2 PBOX 190,70*dvs,460,110*dvs GRAPHMODE 2 DEFTEXT ,0-test%,,13+7*test% TEXT 260,95*dvs," A U S D R U C K " DEFTEXT ,0 GRAPHMODE 1 DEFFILL ,2,8 PBOX 190,120*dvs,310,150*dvs PBOX 190,200*dvs,310,230*dvs DEFFILL ,0,0 PBOX 340,120*dvs,460,150*dvs PBOX 190,160*dvs,310,190*dvs PBOX 340,160*dvs,460,190*dvs PBOX 340,200*dvs,460,230*dvs TEXT 380,140*dvs,"BLOCK" TEXT 215,180*dvs,"mit TITEL" TEXT 365,180*dvs,"mit ZEILE" TEXT 370,220*dvs,"DISKETTE" GRAPHMODE 3 TEXT 230,140*dvs,"BLATT" TEXT 220,220*dvs,"DRUCKER" GRAPHMODE 1 GOSUB frame.box(190,250*dvs,315,290*dvs,0,0) GOSUB frame.box(340,250*dvs,460,290*dvs,0,0) TEXT 245,275*dvs-test%,"OK" TEXT 375,275*dvs-test%,"ABBRUCH" RETURN > PROCEDURE control.ausdruck SHOWM ex!=FALSE h%=1 a1%=1 t!=FALSE z!=FALSE DO MOUSE x,y,k y=y/dvs IF k=1 IF x>191 AND x<309 AND y>120 AND y<150 h%=1 DEFFILL ,2,8 PBOX 190,120*dvs,310,150*dvs DEFFILL ,0,0 PBOX 340,120*dvs,460,150*dvs TEXT 380,140*dvs,"BLOCK" GRAPHMODE 3 TEXT 230,140*dvs,"BLATT" GRAPHMODE 1 ENDIF IF x>340 AND x<460 AND y>120 AND y<150 h%=2 DEFFILL ,2,8 PBOX 340,120*dvs,460,150*dvs DEFFILL ,0,0 PBOX 190,120*dvs,310,150*dvs TEXT 230,140*dvs,"BLATT" GRAPHMODE 3 TEXT 380,140*dvs,"BLOCK" GRAPHMODE 1 ENDIF IF x>190 AND x<310 AND y>160 AND y<190 IF t!=FALSE t!=TRUE DEFFILL ,2,8 PBOX 190,160*dvs,310,190*dvs GRAPHMODE 3 TEXT 215,180*dvs,"mit TITEL" GRAPHMODE 1 ELSE t!=FALSE DEFFILL ,0,0 PBOX 190,160*dvs,310,190*dvs TEXT 215,180*dvs,"mit TITEL" ENDIF PAUSE 10 ENDIF IF x>340 AND x<460 AND y>160 AND y<190 IF z!=FALSE z!=TRUE DEFFILL ,2,8 PBOX 340,160*dvs,460,190*dvs GRAPHMODE 3 TEXT 365,180*dvs,"mit ZEILE" GRAPHMODE 1 ELSE z!=FALSE DEFFILL ,0,0 PBOX 340,160*dvs,460,190*dvs TEXT 365,180*dvs,"mit ZEILE" ENDIF PAUSE 10 ENDIF IF x>190 AND x<310 AND y>200 AND y<230 a1%=1 DEFFILL ,2,8 PBOX 190,200*dvs,310,230*dvs DEFFILL ,0,0 PBOX 340,200*dvs,460,230*dvs GRAPHMODE 3 TEXT 220,220*dvs,"DRUCKER" GRAPHMODE 1 TEXT 370,220*dvs,"DISKETTE" ENDIF IF x>340 AND x<460 AND y>200 AND y<230 a1%=2 DEFFILL ,2,8 PBOX 340,200*dvs,460,230*dvs DEFFILL ,0,0 PBOX 190,200*dvs,310,230*dvs TEXT 220,220*dvs,"DRUCKER" GRAPHMODE 3 TEXT 370,220*dvs,"DISKETTE" GRAPHMODE 1 ENDIF IF x>195 AND x<310 AND y>255 AND y<285 ex!=TRUE ENDIF IF x>345 AND x<455 AND y>255 AND y<285 h%=3 ex!=TRUE ENDIF ENDIF EXIT IF ex!=TRUE LOOP REPEAT UNTIL MOUSEK=0 RETURN > PROCEDURE test.umlaut IF h$<>"" AND a1%=1 RESTORE umlaute DO READ h1$ EXIT IF h1$="*" READ h% DO a%=INSTR(h$,h1$) EXIT IF a%=0 MID$(h$,a%,1)=CHR$(h%) LOOP LOOP ENDIF umlaute: DATA „,123,”,124,,125,Ž,91,™,92,š,93,ž,126,* RETURN > PROCEDURE kopf LOCAL x1% FOR x1%=1 TO breite% PRINT AT(2,3);"Kopf Spalte ";CHR$(x1%+64);" : ";CHR$(27);"K"; FORM INPUT 77 AS kopf$(x1%) PRINT AT(2,3);CHR$(27);"K" NEXT x1% gespeichert!=FALSE GOSUB aufbau.screen(x%,y%,cx%,cy%) RETURN ' > PROCEDURE ende GOSUB test.gesp ALERT 2,"Willst Du wirklich das|Programm verlassen ?",2," ja | nein ",h% IF h%=1 MENU KILL IF aufloesung%=1 FOR i%=0 TO 15 VOID XBIOS(7,i%,farben%(i%)) NEXT i% ENDIF EDIT ENDIF RETURN ' > PROCEDURE loesche.zelle IF (schutz!=FALSE AND block_sch|(cx%,cy%)=0) OR block_sch|(cx%,cy%)=1 gespeichert!=FALSE geandert!=TRUE GOSUB blank_zelle(cx%,cy%) GOSUB invert(1) ELSE OUT 2,7 ALERT 3," ZELLE GESCHšTZT ! ",1," ok ",in% ENDIF RETURN > PROCEDURE blank_zelle(x%,y%) ein$(x%,y%)="" erg(x%,y%)=0 aus$(x%,y%)=SPACE$(breite%(x%)+1) RETURN > PROCEDURE loeschen ALERT 1," L™SCHEN von ",3," allem | Block | nichts ",h% IF h%<>3 IF h%=1 GOSUB loesche.all ELSE GOSUB loesche.block ENDIF ENDIF RETURN > PROCEDURE loesche.all ALERT 1,"L™SCHEN des ARBEITSBLATTES",2," ja | nein ",h% IF h%=1 GOSUB test_schutz(1,xmax%,1,ymax%) IF geschutzt!=FALSE DEFMOUSE 2 GOSUB test.gesp ERASE hlp$() GOSUB array_loeschen CLR tit_zl% tit_fl!=FALSE GOSUB grafik_init DIM hlp$(breite%,hoehe%) DEFMOUSE 1 GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF ENDIF RETURN > PROCEDURE loesche.block IF b1x%>b2x% OR b1y%>b2y% ALERT 3,"BLOCK-Koordinaten falsch| gew„hlt !!",1,"Abbruch",h% ELSE ALERT 1,"L™SCHEN des BLOCKES",2," ja | nein ",h% IF h%=1 GOSUB test_schutz(b1x%,b2x%,b1y%,b2y%) IF geschutzt!=FALSE FOR x1%=b1x% TO b2x% FOR y1%=b1y% TO b2y% GOSUB blank_zelle(x1%,y1%) NEXT y1% NEXT x1% gespeichert!=FALSE GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF ENDIF ENDIF RETURN > PROCEDURE test_schutz(x1%,x2%,y1%,y2%) LOCAL x%,y% geschutzt!=FALSE FOR x%=x1% TO x2% FOR y%=y1% TO y2% IF NOT ((schutz!=FALSE AND block_sch|(x%,y%)=0) OR block_sch|(x%,y%)=1) geschutzt!=TRUE ENDIF NEXT y% NEXT x% IF geschutzt!=TRUE OUT 2,7 ALERT 3," ZELLE(N) im betroffenen | Bereich GESCHšTZT ! ",1," ok ",in% ENDIF RETURN ' > PROCEDURE ein.zahl(h$,k%,min%,max%,x%,y%) LOCAL lng% h$=h$+" " lng%=LEN(STR$(max%)) ein$=STR$(k%) PRINT CHR$(27);"e"; REPEAT aus$="" IF y%=3 PRINT AT(x%,y%);CHR$(27);"l" ENDIF PRINT AT(x%,y%);h$;ein$ PRINT AT(x%-1+LEN(h$),y%);" "; REPEAT UNTIL INKEY$="" REPEAT in$=CHR$(INP(2)) IF in$=CHR$(8) AND LEN(aus$)>=1 aus$=LEFT$(aus$,LEN(aus$)-1) ENDIF IF in$>="0" AND in$<="9" AND LEN(aus$)max%) AND k%<>-1 PRINT CHR$(7) PRINT AT(x%+LEN(h$),y%);ein$;SPC(lng%-LEN(ein$)) ENDIF UNTIL (k%>=min% AND k%<=max%) OR k%=-1 PRINT CHR$(27);"f" RETURN > PROCEDURE select(flag%) IF flag%=0 a$="Speichern" GOSUB anzeige SGET screen$ GOSUB draw.speicher GOSUB control.speicher ELSE a$="Laden" GOSUB anzeige SGET screen$ ALERT 2," Laden von ",3," allem | Block | nichts ",h% ENDIF IF h%<>3 IF h%=1 IF flag%=1 GOSUB test.gesp a$="Laden" GOSUB anzeige ENDIF h$=pfad1$+"*.CLC" f$=file1$ ELSE h$=pfad2$+"*.BLK" f$=file2$ ENDIF GOSUB koordinaten(h%) IF e_flag!=FALSE FILESELECT h$,f$,wahl$ IF LEN(wahl$)>4 IF RIGHT$(wahl$,4)<>RIGHT$(h$,4) GOSUB anhang_endung(RIGHT$(h$,4)) ENDIF ELSE IF wahl$<>"" AND wahl$<>"\" GOSUB anhang_endung(RIGHT$(h$,4)) ENDIF ENDIF IF wahl$<>"" AND wahl$<>"\" f$=RIGHT$(wahl$,LEN(wahl$)-RINSTR(wahl$,"\")) h$=LEFT$(wahl$,RINSTR(wahl$,"\")) ENDIF IF RIGHT$(wahl$,3)="CLC" pfad1$=h$ file1$=f$ ELSE IF RIGHT$(wahl$,3)="BLK" pfad2$=h$ file2$=f$ ENDIF GOSUB koordinaten(h%) ENDIF ENDIF SPUT screen$ RETURN > PROCEDURE draw.speicher GRAPHMODE 1 GOSUB shadow.box(160,64*dvs,480,296*dvs,2,4) DEFFILL ,2,2 PBOX 180,74*dvs,460,115*dvs DEFFILL ,0,0 PBOX 325,130*dvs,460,166*dvs DEFFILL ,2,8 PBOX 180,130*dvs,315,166*dvs GRAPHMODE 2 DEFTEXT ,0-test%,,13+7*test% TEXT 246,100*dvs," S P E I C H E R N " DEFTEXT ,0 GRAPHMODE 1 TEXT 370,152*dvs,"BLOCK" GRAPHMODE 3 TEXT 225,152*dvs,"BLATT" GOSUB draw.codebox GOSUB frame.box(180,240*dvs,315,286*dvs,0,0) GOSUB frame.box(325,240*dvs,460,285*dvs,0,0) TEXT 240,268*dvs,"OK" TEXT 365,268*dvs,"ABBRUCH" RETURN > PROCEDURE control.speicher SHOWM ex!=FALSE h%=1 DO MOUSE x,y,k y=y/dvs IF k=1 IF x>180 AND x<315 AND y>130 AND y<165 h%=1 DEFFILL ,2,8 PBOX 180,130*dvs,315,166*dvs DEFFILL ,0,0 PBOX 325,130*dvs,460,166*dvs GRAPHMODE 3 TEXT 225,152*dvs,"BLATT" GRAPHMODE 1 TEXT 370,152*dvs,"BLOCK" GOSUB draw.codebox ENDIF IF x>325 AND x<459 AND y>130 AND y<165 h%=2 DEFFILL ,0,0 PBOX 180,130*dvs,315,166*dvs PBOX 325,180*dvs,460,216*dvs DEFFILL ,2,8 PBOX 325,130*dvs,460,166*dvs PBOX 180,180*dvs,315,216*dvs TEXT 225,152*dvs,"BLATT" TEXT 360,202*dvs,"mit CODE" GRAPHMODE 3 TEXT 370,152*dvs,"BLOCK" TEXT 210,202*dvs,"ohne CODE" GRAPHMODE 1 ENDIF IF x>180 AND x<315 AND y>180 AND y<215 ! AND cd%<3 cd%=2 DEFFILL ,2,8 PBOX 180,180*dvs,315,216*dvs DEFFILL ,0,0 PBOX 325,180*dvs,460,216*dvs TEXT 360,202*dvs,"mit CODE" GRAPHMODE 3 TEXT 210,202*dvs,"ohne CODE" GRAPHMODE 1 ENDIF IF x>325 AND x<459 AND y>180 AND y<215 AND cd%<3 AND h%=1 cd%=1 DEFFILL ,0,0 PBOX 180,180*dvs,315,216*dvs DEFFILL ,2,8 PBOX 325,180*dvs,460,216*dvs GRAPHMODE 3 TEXT 360,202*dvs,"mit CODE" GRAPHMODE 1 TEXT 210,202*dvs,"ohne CODE" ENDIF IF x>185 AND x<310 AND y>245 AND y<280 ex!=TRUE ENDIF IF x>330 AND x<455 AND y>245 AND y<280 h%=3 ex!=TRUE ENDIF ENDIF EXIT IF ex!=TRUE LOOP REPEAT UNTIL MOUSEK=0 RETURN > PROCEDURE draw.codebox GRAPHMODE 1 IF cd%<>1 AND cd%<>3 DEFFILL ,2,8 PBOX 180,180*dvs,315,216*dvs DEFFILL ,0,0 PBOX 325,180*dvs,460,216*dvs GRAPHMODE 1 TEXT 360,202*dvs,"mit CODE" GRAPHMODE 3 TEXT 210,202*dvs,"ohne CODE" ELSE DEFFILL ,0,0 PBOX 180,180*dvs,315,216*dvs DEFFILL ,2,8 PBOX 325,180*dvs,460,216*dvs GRAPHMODE 3 TEXT 360,202*dvs,"mit CODE" GRAPHMODE 1 TEXT 210,202*dvs,"ohne CODE" ENDIF GRAPHMODE 1 RETURN > PROCEDURE shadow.box(x%,y%,w%,h%,fstyle%,findex%) IF x%>w% SWAP x%,w% ENDIF IF y%>h% SWAP y%,h% ENDIF DEFFILL 1,1 PBOX x%+2,h%,w%+2,h%+2 PBOX w%,y%+2,w%+2,h% IF fstyle%=4 BOX x%,y%,w%,h% ELSE DEFFILL 2,fstyle%,findex% PBOX x%,y%,w%,h% ENDIF DEFFILL 1 RETURN > PROCEDURE frame.box(x%,y%,w%,h%,fstyle%,findex%) IF x%>w% SWAP x%,w% ENDIF IF y%>h% SWAP y%,h% ENDIF IF fstyle%=4 BOX x%,y%,w%,h% BOX x%+5,y%+5,w%-5,h%-5 LINE x%,y%,x%+5,y%+5 LINE w%,y%,w%-5,y%+5 LINE w%,h%,w%-5,h%-5 LINE x%,h%,x%+5,h%-5 ELSE DEFFILL 1,0 PBOX x%,y%,w%,h% LINE x%,y%,x%+5,y%+5 LINE w%,y%,w%-5,y%+5 LINE w%,h%,w%-5,h%-5 LINE x%,h%,x%+5,h%-5 DEFFILL 1,fstyle%,findex% PBOX x%+5,y%+5,w%-5,h%-5 ENDIF RETURN > PROCEDURE koordinaten(h%) e_flag!=FALSE IF h%=1 s1x%=1 s1y%=1 s2x%=xmax% s2y%=ymax% ELSE IF b1x%>b2x% OR b1y%>b2y% AND LEFT$(a$,17)<>" Laden" ALERT 3,"BLOCK-Koordinaten falsch| gew„hlt !!",1,"Abbruch",h% e_flag!=TRUE ELSE s1x%=b1x% IF LEFT$(a$,18)=" Ausdruck" s1y%=b1y%-tit_zl% ELSE s1y%=b1y% ENDIF s2x%=b2x% s2y%=b2y% ENDIF ENDIF RETURN ' > PROCEDURE block.abs(flag%) IF b1x%>b2x% OR b1y%>b2y% ALERT 3,"BLOCK-Koordinaten falsch| gew„hlt !!",1,"Abbruch",h% h%=4 ELSE GOSUB hol.block IF ac%<>27 GOSUB schreib.block(flag%,0) GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF ENDIF RETURN > PROCEDURE block.rel(flag%) IF b1x%>b2x% OR b1y%>b2y% ALERT 3,"BLOCK-Koordinaten falsch| gew„hlt !!",1,"Abbruch",h% h%=4 ELSE GOSUB hol.block IF ac%<>27 dx%=cx%-b1x% dy%=cy%-b1y% FOR y1%=b1y% TO b2y% FOR x1%=b1x% TO b2x% IF LEFT$(hlp$(x1%,y1%),1)="=" CLR a% REPEAT a%=INSTR(hlp$(x1%,y1%),CHR$(126),a%+1) IF a%<>0 GOSUB endern.koord ENDIF UNTIL a%=0 RESTORE funktion funktion: DATA #SUM,#AVE,#STA,#STD,#MUL,#MIN,#MAX,#QMN,#QMW,END DO READ f$ EXIT IF f$="END" REPEAT a%=INSTR(hlp$(x1%,y1%),f$,a%+1) IF a%<>0 ADD a%,4 GOSUB endern.koord a%=INSTR(hlp$(x1%,y1%),":",a%) GOSUB endern.koord ENDIF UNTIL a%=0 LOOP ENDIF NEXT x1% NEXT y1% GOSUB schreib.block(flag%,1) ENDIF ENDIF RETURN > PROCEDURE endern.koord e1$=LEFT$(hlp$(x1%,y1%),a%) a1%=VAL?(MID$(hlp$(x1%,y1%),a%+2)) ein$=MID$(hlp$(x1%,y1%),a%+1) ein$=CHR$(ASC(LEFT$(ein$,1))+dx%)+MID$(ein$,2) IF LEFT$(ein$,1)<"A" MID$(ein$,1,1)="A" ENDIF IF LEFT$(ein$,1)>CHR$(breite%+64) MID$(ein$,1,1)=CHR$(breite%+64) ENDIF h%=VAL(MID$(ein$,2))+dy% h%=MIN(h%,hoehe%) h%=MAX(h%,1) ein$=LEFT$(ein$,1)+STR$(h%)+MID$(ein$,2+a1%) hlp$(x1%,y1%)=e1$+ein$ RETURN > PROCEDURE hol.block a$=h2$ GOSUB anzeige PRINT AT(2,3);CHR$(7);CHR$(27);"l" PRINT AT(2,3);"(Esc) Bewege Cursor an die linke obere Ecke, dann 'Return' oder Mausklick re"; REPEAT CLR mo_k%,ac% REPEAT UNTIL INKEY$="" REPEAT mo_k%=MOUSEK UNTIL INP?(2) OR mo_k%=2 IF mo_k%=2 ac%=13 ELSE ac%=INP(2) ENDIF IF ac%<>13 AND ac%<>27 SWAP aa%,ac% GOSUB beweg.cursor SWAP aa%,ac% ENDIF UNTIL ac%=13 OR ac%=27 IF ac%=13 IF (cx%+(b2x%-b1x%)<=breite%) AND (cy%+(b2y%-b1y%)<=hoehe%) DEFMOUSE 2 FOR x1%=b1x% TO b2x% FOR y1%=b1y% TO b2y% hlp$(x1%,y1%)=ein$(x1%,y1%) NEXT y1% NEXT x1% gespeichert!=FALSE geandert!=TRUE ENDIF ELSE PRINT CHR$(7) GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF RETURN > PROCEDURE schreib.block(flag%,rel%) GOSUB test_schutz(cx%,cx%+(b2x%-b1x%),cy%,cy%+(b2x%-b1x%)) IF geschutzt!=FALSE IF (cx%+(b2x%-b1x%)<=breite%) AND (cy%+(b2y%-b1y%)<=hoehe%) IF flag%=1 FOR x1%=b1x% TO b2x% FOR y1%=b1y% TO b2y% GOSUB blank_zelle(x1%,y1%) NEXT y1% NEXT x1% ENDIF FOR x1%=cx% TO cx%+(b2x%-b1x%) FOR y1%=cy% TO cy%+(b2y%-b1y%) ein$(x1%,y1%)=hlp$(x1%-cx%+b1x%,y1%-cy%+b1y%) hlp$(x1%-cx%+b1x%,y1%-cy%+b1y%)="" IF LEFT$(ein$(x1%,y1%),1)="=" AND rel%=0 GOSUB rechne.zelle(x1%,y1%) ELSE erg(x1%,y1%)=VAL(ein$(x1%,y1%)) ENDIF GOSUB format.zelle(x1%,y1%) NEXT y1% NEXT x1% xmax%=MAX(x1%-1,xmax%) ymax%=MAX(y1%-1,ymax%) GOSUB breite.block IF rel%=1 geandert!=TRUE GOSUB recalc ENDIF ELSE ALERT 3," Block zu breit ! ",1," ok ",h% GOSUB aufbau.screen(x%,y%,cx%,cy%) ENDIF ENDIF RETURN ' > PROCEDURE rechne.zelle(x%,y%) eflag%=FALSE IF LEFT$(ein$(x%,y%),5)<>"=#DAT" GOSUB berechnung(MID$(ein$(x%,y%),2)+" ") IF eflag%=FALSE aus$(x%,y%)="" erg(x%,y%)=stack(1) ELSE aus$(x%,y%)=CHR$(127)+" FEHLER" erg(x%,y%)=0 a$=" | "+fehler$(eflag%)+" | in Zelle "+CHR$(x%+64)+STR$(y%) ALERT 3,a$,1," weiter ",h% ENDIF ENDIF RETURN > PROCEDURE berechnung(ein$) LOCAL a%,a1%,a2%,i%,j%,j1%,j2%,h%,h1%,h2%,h$ CLR zexp%,zstack%,klammer% a%=INSTR(ein$," !") IF a%<>0 ein$=LEFT$(ein$,a%) ENDIF DO flag!=FALSE a%=INSTR(ein$,"#") EXIT IF a%=0 OR eflag%<>0 ' ' SUM ' a%=INSTR(ein$,"#SUM") IF a%<>0 GOSUB summe(a%,0) ENDIF ' ' STA ' a%=INSTR(ein$,"#STA") IF a%<>0 GOSUB summe(a%,2) ENDIF ' ' STD ' a%=INSTR(ein$,"#STD") IF a%<>0 GOSUB summe(a%,3) ENDIF ' ' AVE ' a%=INSTR(ein$,"#AVE") IF a%<>0 GOSUB summe(a%,1) ENDIF ' ' MUL ' a%=INSTR(ein$,"#MUL") IF a%<>0 GOSUB multipl ENDIF ' ' MIN ' a%=INSTR(ein$,"#MIN") IF a%<>0 GOSUB minimax(a%,0) ENDIF ' ' MAX ' a%=INSTR(ein$,"#MAX") IF a%<>0 GOSUB minimax(a%,1) ENDIF ' ' QMN ' a%=INSTR(ein$,"#QMN") IF a%<>0 GOSUB summe(a%,4) ENDIF ' ' QMW ' a%=INSTR(ein$,"#QMW") IF a%<>0 GOSUB summe(a%,5) ENDIF ' ' PI ' a%=INSTR(ein$,"#PI") IF a%<>0 flag!=TRUE ein$=LEFT$(ein$,a%-1)+STR$(PI)+MID$(ein$,a%+3) ENDIF ' EXIT IF flag!=FALSE LOOP ' ' ZELLEN ' DO a%=MAX(INSTR(ein$,CHR$(126)),INSTR(ein$,CHR$(64))) IF a%>1 a1%=INSTR("+-*/^(:",MID$(ein$,a%-1,1)) IF a1%=0 eflag%=1 ENDIF ENDIF EXIT IF a%=0 OR eflag%<>0 j1%=ASC(MID$(ein$,a%+1,1))-64 h1%=VAL(MID$(ein$,a%+2)) h2%=VAL?(MID$(ein$,a%+2)) IF j1%>0 AND j1%<=breite% AND h1%>0 AND h1%<=hoehe% IF LEFT$(ein$(j1%,h1%),1)="=" h=erg(j1%,h1%) ELSE h=VAL(ein$(j1%,h1%)) ENDIF ELSE CLR h eflag%=9 ENDIF IF h<0 AND a%>2 IF MID$(ein$,a%-1,1)="+" ein$=LEFT$(ein$,a%-2)+STR$(h)+MID$(ein$,a%+2+h2%)+" " ELSE IF MID$(ein$,a%-1,1)="-" ein$=LEFT$(ein$,a%-2)+"+"+STR$(-h)+MID$(ein$,a%+2+h2%)+" " ELSE IF MID$(ein$,a%-1,1)="*" OR MID$(ein$,a%-1,1)="/" IF LEFT$(ein$,1)<>"-" ein$="-"+LEFT$(ein$,a%-1)+STR$(-h)+MID$(ein$,a%+2+h2%)+" " ELSE ein$=LEFT$(ein$,a%-1)+STR$(-h)+MID$(ein$,a%+2+h2%)+" " ein$=MID$(ein$,2) ENDIF ELSE ein$=LEFT$(ein$,a%-1)+STR$(h)+MID$(ein$,a%+2+h2%)+" " ENDIF ENDIF ENDIF ELSE ein$=LEFT$(ein$,a%-1)+STR$(h)+MID$(ein$,a%+2+h2%) ENDIF LOOP ' IF LEFT$(ein$,1)="-" a%=VAL?(ein$) ein$="(0"+LEFT$(ein$,a%)+")"+MID$(ein$,a%+1) ENDIF ' DO a%=INSTR(ein$,"(-") EXIT IF a%=0 ein$=LEFT$(ein$,a%)+"0"+MID$(ein$,a%+1) LOOP ' ' NUN ' DO a%=INSTR(ein$,"#NUN") EXIT IF a%=0 OR eflag%<>0 IF a%<>0 flag!=TRUE GOSUB n_uber_n ENDIF LOOP ' ' DO a%=INSTR(ein$,"#") EXIT IF a%=0 OR eflag%>0 h$=MID$(ein$,a%+1,3) token=(INSTR("SQRSINCOSTANATNLOGCLGEXPRNDABSINTFAKASNACS",h$)+2)/3 IF token=0 OR INT(token)<>token eflag%=1 ELSE ein$=LEFT$(ein$,a%-1)+CHR$(token+5)+MID$(ein$,a%+4) ENDIF LOOP ' DO a%=INSTR(ein$,"+") EXIT IF a%=0 MID$(ein$,a%,1)=CHR$(1) LOOP ' a$="E"+CHR$(1) DO a%=INSTR(ein$,a$) EXIT IF a%=0 MID$(ein$,a%+1,1)="+" LOOP ' DO a%=INSTR(ein$,"-") EXIT IF a%=0 MID$(ein$,a%,1)=CHR$(2) LOOP ' a$="E"+CHR$(2) DO a%=INSTR(ein$,a$) EXIT IF a%=0 MID$(ein$,a%+1,1)="-" LOOP ' DO a%=INSTR(ein$,"*") EXIT IF a%=0 MID$(ein$,a%,1)=CHR$(3) LOOP ' DO a%=INSTR(ein$,"/") EXIT IF a%=0 MID$(ein$,a%,1)=CHR$(4) LOOP ' DO a%=INSTR(ein$,"^") EXIT IF a%=0 MID$(ein$,a%,1)=CHR$(5) LOOP ' WHILE LEN(ein$)>1 AND eflag%=0 AND LEFT$(ein$,1)<>" " IF VAL?(ein$)>0 INC zexp% exp$(zexp%)=STR$(VAL(ein$)) ein$=MID$(ein$,VAL?(ein$)+1) ELSE IF LEFT$(ein$,1)="(" INC klammer% INC zstack% stack$(zstack%)=LEFT$(ein$,1) ELSE IF LEFT$(ein$,1)=")" IF klammer%>0 DEC klammer% WHILE stack$(zstack%)<>"(" AND zstack%>1 INC zexp% exp$(zexp%)=stack$(zstack%) DEC zstack% WEND DEC zstack% ELSE eflag%=2 ENDIF ELSE IF LEFT$(ein$,1)0 INC zexp% exp$(zexp%)=stack$(zstack%) DEC zstack% WEND INC zstack% stack$(zstack%)=LEFT$(ein$,1) ELSE eflag%=3 ENDIF ENDIF ENDIF ein$=MID$(ein$,2) ENDIF WEND WHILE zstack%>0 INC zexp% exp$(zexp%)=stack$(zstack%) DEC zstack% WEND IF klammer%>0 eflag%=6 ENDIF ' ' AUSWERTUNG ' CLR zstack%,i% REPEAT INC i% IF VAL?(exp$(i%))>0 INC zstack% stack(zstack%)=VAL(exp$(i%)) ELSE ON ASC(exp$(i%)) GOSUB plus,minus,mal,durch,h.och,sqr,sin,cos,tan,atn,log,clg,exp,rnd,abs,int,fak,asn,acs ENDIF UNTIL i%>=zexp% OR eflag%>0 RETURN > PROCEDURE summe(a%,flag%) flag!=TRUE CLR sum,qsum,zeler% GOSUB decode.zellen IF MID$(ein$,a2%,1)=")" IF j1%>0 AND j1%<=breite% AND h1%>0 AND h1%<=hoehe% AND j2%>0 AND j2%<=breite% AND h2%>0 AND h2%<=hoehe% AND j1%<=j2% AND h1%<=h2% j%=j1% REPEAT h%=h1% REPEAT IF LEFT$(ein$(j%,h%),1)="=" OR VAL?(LEFT$(ein$(j%,h%),1))>0 OR (VAL?(MID$(ein$(j%,h%),2,1))>0 AND LEFT$(ein$(j%,h%),1)="-") ADD sum,erg(j%,h%) ADD qsum,erg(j%,h%)^2 INC zeler% ENDIF INC h% UNTIL h%>h2% INC j% UNTIL j%>j2% IF flag%=1 AND zeler% DIV sum,zeler% ENDIF IF flag%=2 AND zeler% IF zeler%>1 DIV sum,zeler% sum=SQR(ABS((qsum-sum*sum*zeler%)/(zeler%-1))) ELSE eflag%=5 ENDIF ENDIF IF flag%=3 AND zeler% IF zeler%>1 DIV sum,zeler% sum=SQR(ABS((qsum-sum*sum*zeler%)/zeler%)) ELSE eflag%=5 ENDIF ENDIF IF flag%=4 AND zeler% IF zeler%>1 sum=SQR(qsum/zeler%) ELSE eflag%=15 ENDIF ENDIF IF flag%=5 AND zeler% IF zeler%>1 sum=SQR(qsum/(zeler%-1)) ELSE eflag%=15 ENDIF ENDIF h%=LEN(STR$(sum)) ein$=LEFT$(ein$,a%-1)+STR$(sum)+RIGHT$(ein$,LEN(ein$)-a2%) ELSE eflag%=13 ENDIF ELSE eflag%=6 ENDIF RETURN > PROCEDURE multipl ON ERROR GOSUB ueberlauf flag!=TRUE sum=1 GOSUB decode.zellen IF MID$(ein$,a2%,1)=")" IF j1%>0 AND j1%<=breite% AND h1%>0 AND h1%<=hoehe% AND j2%>0 AND j2%<=breite% AND h2%>0 AND h2%<=hoehe% AND j1%<=j2% AND h1%<=h2% j%=j1% REPEAT h%=h1% REPEAT IF LEFT$(ein$(j%,h%),1)="=" OR VAL?(LEFT$(ein$(j%,h%),1))>0 OR (VAL?(MID$(ein$(j%,h%),2,1))>0 AND LEFT$(ein$(j%,h%),1)="-") MUL sum,erg(j%,h%) ENDIF INC h% UNTIL h%>h2% INC j% UNTIL j%>j2% h%=LEN(STR$(sum)) ein$=LEFT$(ein$,a%-1)+STR$(sum)+RIGHT$(ein$,LEN(ein$)-a2%) ELSE eflag%=11 ENDIF ELSE eflag%=6 ENDIF ON ERROR GOSUB fehler RETURN > PROCEDURE ueberlauf IF ERR=1 ALERT 3," šBERLAUF !!! ",1," weiter ",h% ENDIF CLR sum eflag%=11 ON ERROR GOSUB fehler RESUME NEXT RETURN > PROCEDURE minimax(a%,flag%) flag!=TRUE CLR zeler% min=1.0E+99 max=-1.0E+99 GOSUB decode.zellen IF MID$(ein$,a2%,1)=")" IF j1%>0 AND j1%<=breite% AND h1%>0 AND h1%<=hoehe% AND j2%>0 AND j2%<=breite% AND h2%>0 AND h2%<=hoehe% AND j1%<=j2% AND h1%<=h2% j%=j1% REPEAT h%=h1% REPEAT IF LEFT$(ein$(j%,h%),1)="=" OR VAL?(LEFT$(ein$(j%,h%),1))>0 OR (VAL?(MID$(ein$(j%,h%),2,1))>0 AND LEFT$(ein$(j%,h%),1)="-") INC zeler% min=MIN(erg(j%,h%),min) max=MAX(erg(j%,h%),max) ENDIF INC h% UNTIL h%>h2% INC j% UNTIL j%>j2% IF flag%=1 min=max ENDIF h%=LEN(STR$(min)) ein$=LEFT$(ein$,a%-1)+STR$(min)+RIGHT$(ein$,LEN(ein$)-a2%) ELSE eflag%=10 ENDIF IF zeler%=0 AND eflag%=0 eflag%=12 ENDIF ELSE eflag%=6 ENDIF RETURN > PROCEDURE n_uber_n ON ERROR GOSUB ueberlauf LOCAL i% n1%=VAL(MID$(ein$,a%+5)) a1%=INSTR(ein$,":",a%)+1 n2%=VAL(MID$(ein$,a1%)) nun=1 IF n1%>=n2% IF n2%>0 FOR i%=n1% DOWNTO n1%-n2%+1 MUL nun,i% IF n2%>0 DIV nun,n2% DEC n2% ENDIF NEXT i% IF n2%>1 FOR i%=2 TO n2% DIV nun,i% NEXT i% ENDIF ELSE nun=1 ENDIF a1%=INSTR(ein$,")",a%)+1 ein$=LEFT$(ein$,a%-1)+STR$(nun)+MID$(ein$,a1%) ELSE nun=0 eflag%=14 ENDIF ON ERROR GOSUB fehler RETURN ' > PROCEDURE plus IF zstack%>1 ADD stack(zstack%-1),stack(zstack%) DEC zstack% ELSE eflag%=4 ENDIF RETURN > PROCEDURE minus IF zstack%>1 SUB stack(zstack%-1),stack(zstack%) DEC zstack% ELSE eflag%=4 ENDIF RETURN > PROCEDURE mal IF zstack%>1 MUL stack(zstack%-1),stack(zstack%) DEC zstack% ELSE eflag%=4 ENDIF RETURN > PROCEDURE durch IF zstack%>1 IF stack(zstack%)<>0 DIV stack(zstack%-1),stack(zstack%) DEC zstack% ELSE eflag%=5 ENDIF ELSE eflag%=4 ENDIF RETURN > PROCEDURE h.och IF zstack%>1 stack(zstack%-1)=stack(zstack%-1)^stack(zstack%) DEC zstack% ELSE eflag%=4 ENDIF RETURN > PROCEDURE int IF zstack%>0 stack(zstack%)=INT(stack(zstack%)) ELSE eflag%=4 ENDIF RETURN > PROCEDURE abs IF zstack%>0 stack(zstack%)=ABS(stack(zstack%)) ELSE eflag%=4 ENDIF RETURN > PROCEDURE rnd IF zstack%>0 stack(zstack%)=TRUNC(stack(zstack%)+0.5*SGN(stack(zstack%))) ELSE eflag%=4 ENDIF RETURN > PROCEDURE log IF zstack%>0 IF stack(zstack%)>0 stack(zstack%)=LOG(stack(zstack%)) ELSE stack(zstack%)=0 eflag%=7 ENDIF ELSE eflag%=4 ENDIF RETURN > PROCEDURE exp IF zstack%>0 stack(zstack%)=EXP(stack(zstack%)) ELSE eflag%=4 ENDIF RETURN > PROCEDURE sqr IF zstack%>0 IF stack(zstack%)>=0 stack(zstack%)=SQR(stack(zstack%)) ELSE stack(zstack%)=0 eflag%=8 ENDIF ELSE eflag%=4 ENDIF RETURN > PROCEDURE clg IF zstack%>0 IF stack(zstack%)>0 stack(zstack%)=LOG10(stack(zstack%)) ELSE stack(zstack%)=0 eflag%=7 ENDIF ELSE eflag%=4 ENDIF RETURN > PROCEDURE sin IF zstack%>0 stack(zstack%)=SIN(stack(zstack%)*grd) ELSE eflag%=4 ENDIF RETURN > PROCEDURE asn IF zstack%>0 stack(zstack%)=ASIN(stack(zstack%))/grd ELSE eflag%=4 ENDIF RETURN > PROCEDURE cos IF zstack%>0 stack(zstack%)=COS(stack(zstack%)*grd) ELSE eflag%=4 ENDIF RETURN > PROCEDURE acs IF zstack%>0 stack(zstack%)=ACOS(stack(zstack%))/grd ELSE eflag%=4 ENDIF RETURN > PROCEDURE tan IF zstack%>0 stack(zstack%)=TAN(stack(zstack%)*grd) ELSE eflag%=4 ENDIF RETURN > PROCEDURE atn IF zstack%>0 stack(zstack%)=ATN(stack(zstack%))/grd ELSE eflag%=4 ENDIF RETURN > PROCEDURE fak IF zstack%>0 GOSUB fakultet(stack(zstack%)) stack(zstack%)=fak ELSE eflag%=4 ENDIF RETURN > PROCEDURE fakultet(n%) LOCAL i% fak=1 IF n%>=0 AND n%<94 FOR i%=1 TO n% MUL fak,i% NEXT i% ELSE eflag%=14 fak=0 ENDIF RETURN ' > PROCEDURE widmung IF wid!=FALSE ALERT 1,"Dieses Programm ist meiner|Gattin IRIS gewidmet, die|immer viel Verst„ndnis fr|mein Hobby aufbringt !",1,"Klick...",h% ALERT 3,h$,1," aha ",h% wid!=TRUE ELSE ALERT 2," Ich grže Dich herzlich !|Sieh' bitte gn„dig ber meine|und die Fehler im Programm|hinweg. Danke",2," gern | na gut | nie ",h% SGET screen$ DEFFILL 1,0 PRBOX 10,10*dvs,630,390*dvs RBOX 11,11*dvs,629,389*dvs RBOX 14,14*dvs,626,386*dvs DEFTEXT 1,17,,32-19*test% OUT 2,7 IF h%=1 PUT 50,25*dvs,icon$(0) PUT 425,25*dvs,icon$(0) GRAPHMODE 1 DEFTEXT ,16,,27+14*test% TEXT 225-45*test%,185*dvs,"Vielen Dank" DEFTEXT ,0,,13+7*test% TEXT 240,205*dvs,"und ein dickes Bussi!" TEXT 194,245*dvs,"Der zweite Teil gilt natrlich" TEXT 194,265*dvs,"nur fr einen weiblichen User!" PAUSE 60 ELSE IF h%=2 TEXT 120,190*dvs,400,"Sehr nett von Dir !" DEFTEXT ,0,,13+7*test% TEXT 120,220*dvs,400,"(Du kennst das Programm wohl noch nicht so genau?)" ELSE DEFTEXT ,0,,13+7*test% TEXT 120,190*dvs,400,"Da ist doch irgendwo der Mistkbel ?" TEXT 120,220*dvs,400,"(da kannst Du zumindest das Programm hineinwerfen)" ENDIF ENDIF wid!=FALSE PAUSE 120 PRBOX 16,16*dvs,624,394*dvs FOR h%=18 TO 198 STEP 4 RBOX h%,h%*dvs,640-h%,(400-h%)*dvs NEXT h% SPUT screen$ ENDIF RETURN ' > PROCEDURE decode.zellen j1%=ASC(MID$(ein$,a%+5,1))-64 h1%=VAL(MID$(ein$,a%+6)) a1%=INSTR(ein$,":",a%) j2%=ASC(MID$(ein$,a1%+1,1))-64 h2%=VAL(MID$(ein$,a1%+2)) a2%=a1%+2+VAL?(MID$(ein$,a1%+2)) RETURN > PROCEDURE breite.block LOCAL x1% CLR bl.breite% FOR x1%=b1x% TO b2x% ADD bl.breite%,breite%(x1%)+1 NEXT x1% CLR all.breite% FOR x1%=1 TO xmax% ADD all.breite%,breite%(x1%)+1 NEXT x1% RETURN > PROCEDURE test.gesp LOCAL h% IF gespeichert!=FALSE ALERT 3," Arbeitsblatt ist| |NICHT GESPEICHERT!",2," OK |Sichern",h% IF h%=2 GOSUB speichern ENDIF ENDIF RETURN > PROCEDURE eingabe IF (schutz!=FALSE AND block_sch|(cx%,cy%)=0) OR block_sch|(cx%,cy%)=1 ein$=CHR$(ab%) a$="Eingabe" GOSUB anzeige zeler%=1 h1$=CHR$(200)+CHR$(203)+CHR$(205)+CHR$(208)+CHR$(27)+CHR$(225) REPEAT PRINT AT(2,3);ein$;ron$;" ";roff$;CHR$(27);"K"; a%=INP(2) h$="„Ž”™šž^"+CHR$(126)+CHR$(124)+CHR$(95)+CHR$(200)+CHR$(203)+CHR$(205)+CHR$(208)+CHR$(27)+CHR$(8)+CHR$(225) IF (a%>31 AND a%<123) OR INSTR(h$,CHR$(a%)) IF a%=8 AND zeler%>0 DEC zeler% ein$=LEFT$(ein$,zeler%) ELSE IF a%<>27 AND a%<200 AND a%<>8 ein$=ein$+CHR$(a%) INC zeler% ENDIF ENDIF ENDIF UNTIL a%=13 OR INSTR(h1$,CHR$(a%)) OR zeler%>76 IF zeler%>76 a%=13 PRINT CHR$(27);"D";CHR$(7); PAUSE 30 REPEAT UNTIL INKEY$="" ENDIF IF a%<>27 AND a%<>225 GOSUB c.minimax GOSUB breite.block ein$(cx%,cy%)=ein$ IF LEFT$(ein$(cx%,cy%),1)="=" a1%=INSTR(ein$(cx%,cy%)," !") IF a1%<>0 ein$(cx%,cy%)=UPPER$(LEFT$(ein$(cx%,cy%),a1%))+MID$(ein$(cx%,cy%),a1%+1) ELSE ein$(cx%,cy%)=UPPER$(ein$(cx%,cy%)) ENDIF GOSUB rechne.zelle(cx%,cy%) ELSE erg(cx%,cy%)=VAL(ein$(cx%,cy%)) ENDIF GOSUB format.zelle(cx%,cy%) gespeichert!=FALSE geandert!=TRUE ENDIF h$=CHR$(200)+CHR$(203)+CHR$(205)+CHR$(208) IF INSTR(h$,CHR$(a%)) aa%=a% GOSUB beweg.cursor ENDIF GOSUB inv_anzeige ELSE OUT 2,7 ALERT 3," ZELLE GESCHšTZT ! ",1," ok ",in% ENDIF RETURN > PROCEDURE anzeige IF a$="" a$=STR$(breite%)+"*"+STR$(hoehe%) IF schutz!=TRUE a$=a$+"S " ELSE a$=a$+" " ENDIF ENDIF a$=SPACE$(18-LEN(a$))+a$ GRAPHMODE 4 TEXT 392,398*dvs,SPACE$(18) GRAPHMODE 3 TEXT 392,398*dvs,a$ GRAPHMODE 1 PRINT AT(2,3); RETURN > PROCEDURE aufloesung aufloesung%=XBIOS(4) test%=(aufloesung%=1) IF test%=TRUE dvs=0.5 ELSE dvs=1 ENDIF IF aufloesung%=0 ALERT 3,"Dieses Programm l„uft|nicht in niedriger|Bildschirmaufl”sung",1," OK ",a% QUIT ENDIF copyright$=SPACE$(1526) IF aufloesung%=1 DIM farben%(15) FOR i%=0 TO 15 farben%(i%)=XBIOS(7,i%,-1) NEXT i% col%=275 col1%=1635 col2%=85 col3%=1280 SETCOLOR 0,col1% SETCOLOR 1,col2% SETCOLOR 2,col3% SETCOLOR 3,col% COLOR 2 ELSE CLR col% GOSUB no.copyr ENDIF RETURN > PROCEDURE icon DIM icon$(1) IF EXIST("GEM_CALC.DAT") OPEN "I",#1,"GEM_CALC.DAT" INPUT #1,no% INPUT #1,count% INPUT #1,len icon$(count%)=SPACE$(len) BGET #1,VARPTR(icon$(count%)),len CLOSE #1 ELSE icon$(0)="" ENDIF RETURN > PROCEDURE init_variablen ron$=CHR$(27)+"p" roff$=CHR$(27)+"q" breite%=26 hoehe%=200 ! CALC_100: 200->100 grd=PI/180 lng%=18 fak=1 rei=1 spa=12 wid!=FALSE trennz!=FALSE lfeed!=TRUE null!=TRUE CLR tit_zl% tit_fl!=FALSE DIM kopf$(breite%),breite%(breite%),komma%(breite%),stack$(100),exp$(100),stack(100),prior%(100),fehler$(16) DIM w(5,50),nsa$(50),x(50),y(50),n$(5) DIM hlp$(breite%,hoehe%) ARRAYFILL prior%(),0 RESTORE prior FOR i%=1 TO 19 READ prior%(i%) NEXT i% prior: DATA 1,1,2,2,3,3,4,4,4,4,4,4,4,4,4,4,4,4,4 ' FOR i%=1 TO 14 READ fehler$(i%) NEXT i% fehler$(9)=fehler$(9)+CHR$(126) DATA unbekannte Funktion,'(' fehlt,unbekannter Operator,zu wenig Argumente DATA Division durch Null,')' fehlt,negative Zahl bei LOG,negative Zahl bei SQR DATA falsche Koordinaten bei ,Fehler bei #MIN/MAX,Fehler bei #MUL DATA keine numerischen Daten| bei #MIN/MAX,Fehler bei #SUM/AVE/STA/QMW DATA Fehler bei #FAK/NUN RETURN > PROCEDURE leiste DIM leiste$(100) FOR i%=0 TO 100 READ leiste$(i%) EXIT IF leiste$(i%)="***" NEXT i% leiste$(i%)="" leiste$(i%+1)="" DATA , ½ GEM-CALC,--------------------, , , , , , ,"" DATA , Laden F3, Speichern ^F3,---------------------, Drucken F9, Zellinhalt C-Z,---------------------, Schutz aus/ein C-7, Blatt l”schen ^F10, Ende ^F9,"" DATA , Zahl der Spalten C-L, Breite Spalte F4, Breite Alle ^F4,-----------------------, Komma Spalte F5, Komma Alle ^F5,-----------------------, Zeile einfgen C-1, Zeile l”schen C-2, Spalte einfgen C-3 DATA Spalte l”schen C-4,-----------------------, Nachkomma-0 C-N, Return mit LF C-P, Trennzeichen C-T,"" DATA , links oben ^F2, rechts unten F2,---------------------, Move absolut F7, Move relativ ^F7, Copy absolut F6, Copy relativ ^F6,---------------------, Schutz ein/aus C-8, --> Werte C-V, L”schen ^F10,"" DATA , Žndern F1,-------------------, Merken C-M, Copy absolut C-A, Copy relativ C-R,-------------------, L”schen F10,"" DATA , Berechnung ^F1, Fehler suchen C-O, Sortieren C-X, Gehe Zelle F8, Invert C-C, Hi Resolution C-K, Kopf ^F8, Titelzeilen C-0, Bogenmaž C-B, max. Bereich C-9, Suchen C-# DATA --------------------, Hilfe Help/C-ž,"" DATA , Datentransfer C-U, Daten laden C-6, Daten speichern C-5,----------------------, Kuchen C-D, Linien C-E, Balken C-F, Stapel C-G, S„ulen C-H, Bl”cke C-I DATA Fl„chen C-J,----------------------, Hardcopy C-Q, Degas C-W,----------------------, Spreadsheet C-S,"" DATA *** RETURN ' > PROCEDURE init gespeichert!=TRUE DIM ein$(breite%,hoehe%),aus$(breite%,hoehe%),erg(breite%,hoehe%) DIM block_sch|(breite%,hoehe%) ARRAYFILL komma%(),2 ARRAYFILL breite%(),9 ARRAYFILL erg(),0 ARRAYFILL block_sch|(),0 ' h$=SPACE$(10) FOR i%=1 TO breite% kopf$(i%)=CHR$(i%+64) FOR j%=1 TO hoehe% aus$(i%,j%)=h$ NEXT j% NEXT i% FOR i%=80 TO 86 MENU i%,2 NEXT i% r%=GEMDOS(25) pfad1$=CHR$(r%+65)+":" pfad2$=CHR$(r%+65)+":" pfad3$=CHR$(r%+65)+":" GOSUB variablen.init IF tit_zl% MENU 68,1 ELSE MENU 68,0 ENDIF xmax%=1 ymax%=1 cd%=2 ugrafik!=FALSE grafik!=FALSE schutz!=FALSE GOSUB breite.block SGET screen$ RETURN > PROCEDURE variablen.init x%=1 y%=1 cx%=1 cy%=1 b1x%=1 b1y%=1 b2x%=1 b2y%=1 mx%=1 my%=1 RETURN > PROCEDURE grafik_init ueb1$="" ueb2$="" CLR offs fak=1 rei=1 spa=12 reih%=1 beginn%=1 beginn2%=1 bez%=1 bezrei%=1 RETURN > PROCEDURE hi.resolution(x%,y%,z%) CLS DEFTEXT 1,0,,4 GOSUB zahl.spalten(103) y%=MIN(y%,hoehe%-55) breit%=23 DEFFILL 1,1 PBOX 0,0,639,9 GRAPHMODE 3 FOR xs%=x% TO spalten% TEXT breit%,8,LEFT$(kopf$(xs%),breite%(xs%)) ADD breit%,breite%(xs%)*6+6 NEXT xs% GRAPHMODE 1 tief%=18 FOR ys%=y% TO y%+z% a$=" " RSET a$=STR$(ys%) a$=a$+" " FOR xs%=x% TO spalten% a$=a$+aus$(xs%,ys%) NEXT xs% TEXT 0,tief%,a$ ADD tief%,7 NEXT ys% DEFTEXT 1,,,13+7*test% REPEAT UNTIL INKEY$<>"" OR MOUSEK RETURN > PROCEDURE fehler CLOSE h$="Es ist Fehler "+STR$(ERR)+" aufgetreten:|"+MID$(ERR$(ERR),5,LEN(ERR$(ERR))-11) ALERT 3,h$,1," Mist ",h% DEFMOUSE 0 DEFTEXT 1,0,0,13+7*test% RESUME fehlerlabel RETURN > PROCEDURE no.copyr LOCAL i%,h$ CLS DEFTEXT 1,16,,6 TEXT 24,40,"GEM_CALC ** ** Version 2.39 - 02.04.1990 ** ** GEM_CALC" DEFTEXT 1,0,,6 GET 0,24,639,42,copyright$ RETURN ' > PROCEDURE menue aa%=MENU(0) MENU OFF IF aa%=1 GOSUB titel GOSUB aufbau.screen(x%,y%,cx%,cy%) ELSE SUB aa%,10 ON aa% GOSUB laden,speichern,a,drucken,druck.zellinhalt,a,blatt_schutz,loesche.all,ende SUB aa%,11 ON aa% GOSUB zahl_spalten,breite,breite.all,a,komma,komma.all,a,zeile.einfugen,zeile.loschen,spalte.einfugen,spalte.loschen,a,nullen,line.feed,trennzeichen SUB aa%,17 ON aa% GOSUB block.lo,block.ru,a,move.abs,move.rel,copy.abs,copy.rel,a,block_schutz,block.werte,loesche.block SUB aa%,13 ON aa% GOSUB edit,a,merken,copy.cel.abs,copy.cel.rel,a,loesche.zelle SUB aa%,9 ON aa% GOSUB recalc,such.fehler,sortieren,gehe.zelle,invers,hi.resol,kopf,titelzeilen,bogenmass,anpassen_max,suchen,a,help.screen SUB aa%,15 hilf$=leiste$(MENU(0)) ON aa% GOSUB daten.uebernahme,load.gdaten,save.gdaten,a,kuchen,grafik.2d,grafik.2d,stapel,grafik.3d,grafik.3d,grafik.3d,a,hardcpy,degas,a,spreadsheet ENDIF RETURN > PROCEDURE hi.resol IF aufloesung%=2 z%=54 ELSE z%=25 ENDIF GOSUB hi.resolution(x%,y%,z%) GOSUB aufbau.screen(x%,y%,cx%,cy%) RETURN > PROCEDURE invers SETCOLOR 0,col% IF aufloesung%=2 col%=1911-col% SETCOLOR 1,col% ELSE SWAP col%,col1% SETCOLOR 0,col1% SETCOLOR 3,col% ENDIF RETURN > PROCEDURE titel LOCAL x%,y% CLS PUT 0,24-12*test%,copyright$ DEFFILL 3,4,1 PBOX 0,62*dvs,639,399 DEFFILL 1,0 PRBOX 160,80*dvs,479,150*dvs PRBOX 160,144*dvs,479,318*dvs BOX 170,200*dvs,282,248*dvs FOR i%=208 TO 240 STEP 8 LINE 170,i%*dvs,282,i%*dvs NEXT i% FOR i%=184 TO 268 STEP 14 LINE i%,200*dvs,i%,248*dvs NEXT i% DEFTEXT 1,0,,32+19*test% TEXT 190,126*dvs,"G" TEXT 250,126*dvs,"E" TEXT 292+6*test%,126*dvs,"M" TEXT 360,126*dvs,90,"-CALC" DEFTEXT ,2,,13+7*test% TEXT 206+6*test%,126*dvs,"regor" TEXT 266+6*test%,126*dvs,"ngl" TEXT 308+12*test%,126*dvs,"mayer" DEFTEXT ,17 TEXT 175,170*dvs,"GEM-CALC" DEFTEXT ,0 TEXT 278,170*dvs,"ist ein PD-Programm von" TEXT 302,212*dvs,"Gregor Englmayer" TEXT 302,228*dvs,"Weiženbach 30/2" TEXT 302,244*dvs,"A-8813 St. Lambrecht" DEFTEXT ,-2*(test%=0) TEXT 170,286*dvs,"Gef„llt Dir das Programm, dann schicke" TEXT 170,302*dvs,"mir bitte DM 20.- oder ”S 100.-- DANKE" DEFTEXT 1,0,,6+2*test% TEXT 175,188*dvs,"½ 1988/1989" TEXT 210,266*dvs,"Vielen Dank an GFA-BASIC 3.07" PRBOX 530,370*dvs,620,386*dvs TEXT 544,382*dvs,"Klick..." DEFMOUSE 0 REPEAT UNTIL MOUSEK OR INKEY$<>"" RETURN > PROCEDURE druck.zellinhalt LOCAL a%,x%,y% ALERT 2," Ausdruck der Zellinhalte ? ",3," alle | Block | nein ",h% IF h%<>3 GOSUB koordinaten(h%) IF e_flag!=FALSE DEFMOUSE 2 OPEN "O",#2,"PRN:" PRINT #2;CHR$(27);"R";CHR$(2);CHR$(27);"l";CHR$(8);CHR$(27);"M"; CLR zeilen% FOR x%=s1x% TO s2x% FOR y%=s1y% TO s2y% IF ein$(x%,y%)<>"" h$=ein$(x%,y%) a1%=1 REPEAT a%=INSTR(h$,CHR$(126)) IF a%<>0 h$=LEFT$(h$,a%-1)+MID$(h$,a%+1) ENDIF UNTIL a%=0 GOSUB test.umlaut PRINT #2;CHR$(x%+64); PRINT #2;STR$(y%);": "; PRINT #2;h$; IF lfeed!=TRUE PRINT #2 ELSE PRINT #2;CHR$(13); ENDIF INC zeilen% IF zeilen%>64 PRINT #2;CHR$(12); CLR zeilen% ENDIF ENDIF NEXT y% NEXT x% PRINT #2;CHR$(12); CLOSE #2 DEFMOUSE 0 ENDIF ENDIF RETURN > PROCEDURE hardcpy IF aufloesung%<>1 HIDEM h%=1 IF grafik!=FALSE GOSUB invert(0) ALERT 3,"Eine Hardcopy des Arbeits-|blattes bewirkt einen|PROGRAMMABSTURZ !!",2,"weiter|oh nein",h% ENDIF IF h%=1 WHILE OUT?(0)=FALSE AND h%=1 ALERT 1,"Drucker einschalten",1," okay |Abbruch",h% WEND IF h%=1 a$=SPACE$(380) g$=" "+CHR$(27)+"*"+CHR$(5)+CHR$(380)+CHR$(380/256) OPEN "",#99,"LST:" PRINT #99;CHR$(27);"3";CHR$(24) FOR s%=XBIOS(3) TO s%+79 dx%=VARPTR(a$) FOR q%=s%+399*80 TO s% STEP -80 POKE dx%,PEEK(q%) INC dx% NEXT q% PRINT #99,g$;a$;CHR$(13); IF lfeed!=TRUE PRINT #99 ENDIF NEXT s% PRINT #99;CHR$(27);"2" PRINT #99;CHR$(12); CLOSE #99 ENDIF ENDIF IF grafik!=FALSE GOSUB invert(1) ENDIF SHOWM ENDIF RETURN > PROCEDURE spreadsheet grafik!=FALSE FOR i%=1 TO 78 MENU i%,3 NEXT i% RESTORE linien DO READ i% EXIT IF i%=-1 MENU i%,2 LOOP GOSUB aufbau.screen(x%,y%,cx%,cy%) RETURN linien: DATA 2,13,16,25,28,33,41,46,53,57,72,79,87,90,-1 ' > PROCEDURE sortieren IF ymax%>1 GOSUB invert(0) a$="Sortieren" GOSUB anzeige SGET screen$ GOSUB draw.sortiere GOSUB control.sortiere SPUT screen$ IF auf%<>3 gespeichert!=FALSE DEFMOUSE 2 IF auf%=1 FOR i%=von% TO bis%-1 FOR j%=i%+1 TO bis% IF alph%=2 IF erg(spa%,i%)>erg(spa%,j%) GOSUB tauschen ENDIF ELSE IF ein$(spa%,i%)>ein$(spa%,j%) GOSUB tauschen ENDIF ENDIF NEXT j% NEXT i% ELSE FOR i%=von% TO bis%-1 FOR j%=i%+1 TO bis% IF alph%=2 IF erg(spa%,i%) PROCEDURE draw.sortiere GRAPHMODE 1 GOSUB shadow.box(77,62*dvs,555,370*dvs,2,4) DEFFILL ,2,2 PBOX 115,74*dvs,520,110*dvs DEFFILL ,0,0 PBOX 325,124*dvs,520,160*dvs PBOX 325,170*dvs,520,206*dvs PBOX 115,214*dvs,305,250*dvs PBOX 115,260*dvs,305,296*dvs PBOX 325,260*dvs,520,296*dvs DEFFILL ,2,8 PBOX 115,124*dvs,305,160*dvs PBOX 115,170*dvs,305,206*dvs GOSUB frame.box(115,314*dvs,305,360*dvs,0,0) GOSUB frame.box(330,314*dvs,520,360*dvs,0,0) GRAPHMODE 2 DEFTEXT ,0-test%,,13+7*test% TEXT 244,98*dvs," S O R T I E R E N" DEFTEXT ,0 GRAPHMODE 1 TEXT 380,146*dvs,"absteigend" TEXT 385,190*dvs,"numerisch" TEXT 200,344*dvs,"OK" TEXT 390,344*dvs,"ABBRUCH" h1$="SPALTE (A-"+CHR$(xmax%+64)+") : " PRINT AT(19,15);h1$+CHR$(cx%+64) h2$="von ZEILE (1-"+STR$(ymax%-1)+"): " PRINT AT(16,18);h2$+"1" h3$="bis ZEILE (2-"+STR$(ymax%)+"): " PRINT AT(43,18);h3$+STR$(ymax%) GRAPHMODE 3 TEXT 165,146*dvs,"aufsteigend" TEXT 160,190*dvs,"alphabetisch" GRAPHMODE 1 RETURN > PROCEDURE control.sortiere SHOWM ex!=FALSE auf%=1 alph%=1 spa%=cx% von%=1 bis%=ymax% DO MOUSE x,y,k y=y/dvs IF k=1 IF x>114 AND x<305 AND y>125 AND y<160 auf%=1 DEFFILL ,2,8 PBOX 115,124*dvs,305,160*dvs DEFFILL ,0,0 PBOX 325,124*dvs,520,160*dvs GRAPHMODE 3 TEXT 165,146*dvs,"aufsteigend" GRAPHMODE 1 TEXT 380,146*dvs,"absteigend" ENDIF IF x>325 AND x<520 AND y>125 AND y<160 auf%=2 DEFFILL ,2,8 PBOX 325,124*dvs,520,160*dvs DEFFILL ,0,0 PBOX 115,124*dvs,305,160*dvs GRAPHMODE 3 TEXT 380,146*dvs,"absteigend" GRAPHMODE 1 TEXT 165,146*dvs,"aufsteigend" ENDIF IF x>114 AND x<305 AND y>170 AND y<206 alph%=1 DEFFILL ,2,8 PBOX 115,170*dvs,305,206*dvs DEFFILL ,0,0 PBOX 325,170*dvs,520,206*dvs GRAPHMODE 3 TEXT 160,190*dvs,"alphabetisch" GRAPHMODE 1 TEXT 385,190*dvs,"numerisch" ENDIF IF x>325 AND x<520 AND y>170 AND y<206 alph%=2 DEFFILL ,2,8 PBOX 325,170*dvs,520,206*dvs DEFFILL ,0,0 PBOX 115,170*dvs,305,206*dvs GRAPHMODE 3 TEXT 385,190*dvs,"numerisch" GRAPHMODE 1 TEXT 160,190*dvs,"alphabetisch" ENDIF IF x>115 AND x<305 AND y>215 AND y<250 REPEAT ein$=CHR$(spa%+64) PRINT AT(19,15);h1$; FORM INPUT 1 AS ein$ spa%=ASC(UPPER$(ein$))-64 IF spa%<1 OR spa%>xmax% OUT 2,7 ENDIF UNTIL spa%>0 AND spa%<=xmax% PRINT AT(19,15);h1$+CHR$(spa%+64) ENDIF IF x>115 AND x<304 AND y>260 AND y<295 GOSUB ein.zahl(LEFT$(h2$,LEN(h2$)-1),von%,1,998,16,18) IF VAL(aus$)<>-1 von%=MIN(VAL(aus$),ymax%-1) ENDIF PRINT AT(16,18);h2$;von% ENDIF IF x>330 AND x<520 AND y>260 AND y<295 GOSUB ein.zahl(LEFT$(h3$,LEN(h3$)-1),bis%,2,999,43,18) IF VAL(aus$)<>-1 bis%=MIN(VAL(aus$),ymax%) ENDIF PRINT AT(43,18);h3$;bis% ENDIF IF x>120 AND x<300 AND y>320 AND y<355 ex!=TRUE ENDIF IF x>335 AND x<515 AND y>320 AND y<355 auf%=3 ex!=TRUE ENDIF ENDIF EXIT IF ex!=TRUE LOOP REPEAT UNTIL MOUSEK=0 RETURN > PROCEDURE tauschen LOCAL h$ FOR k%=1 TO xmax% SWAP erg(k%,i%),erg(k%,j%) h$=ein$(k%,i%) ein$(k%,i%)=ein$(k%,j%) ein$(k%,j%)=h$ h$=aus$(k%,i%) aus$(k%,i%)=aus$(k%,j%) aus$(k%,j%)=h$ NEXT k% RETURN > PROCEDURE titelzeilen gespeichert!=FALSE INC tit_zl% ALERT 2," Wieviele Zeilen sollen als | Titelzeilen gedruckt werden ? ",tit_zl%," 0 | 1 | 2 ",tit_zl% DEC tit_zl% IF tit_zl% MENU 68,1 IF tit_fl!=TRUE h%=2 ELSE h%=1 ENDIF ALERT 2,"1. alle Spalten|2. linke Spalten (75 Zeichen) | | werden gedruckt.",h%," 1 | 2 ",h% IF h%=1 tit_fl!=FALSE ELSE tit_fl!=TRUE ENDIF ELSE MENU 68,0 ENDIF RETURN > PROCEDURE anpassen_max LOCAL x%,y%,m% a$="Bereich max" GOSUB anzeige DEFMOUSE 2 m%=1 IF xmax%>1 FOR x%=1 TO xmax% FOR y%=1 TO ymax% IF ein$(x%,y%)<>"" m%=x% ENDIF EXIT IF m%=x% NEXT y% NEXT x% ENDIF xmax%=m% m%=1 IF ymax%>1 FOR y%=1 TO ymax% FOR x%=1 TO xmax% IF ein$(x%,y%)<>"" m%=y% ENDIF EXIT IF m%=y% NEXT x% NEXT y% ENDIF ymax%=m% a$="" GOSUB breite.block GOSUB infozeile DEFMOUSE 0 RETURN > PROCEDURE degas a$="Degas speichern" GOSUB anzeige IF aufloesung%=1 file$="\*.PI2" ELSE file$="\*.PI3" ENDIF SGET screen$ FILESELECT file$,"",wahl$ SPUT screen$ HIDEM IF LEN(wahl$)>4 GOSUB anhang_endung(RIGHT$(file$,4)) OPEN "O",#1,wahl$ IF aufloesung%=1 OUT #1,0 OUT #1,1 OUT #1,INT(col%/256) OUT #1,col% MOD 256 OUT #1,INT(col2%/256) OUT #1,col2% MOD 256 OUT #1,INT(col3%/256) OUT #1,col3% MOD 256 OUT #1,INT(col1%/256) OUT #1,col1% MOD 256 FOR i%=1 TO 24 OUT #1,0 NEXT i% ELSE OUT #1,0 OUT #1,2 OUT #1,INT(1911/256) OUT #1,1911 MOD 256 OUT #1,0 OUT #1,0 FOR i%=1 TO 28 OUT #1,0 NEXT i% ENDIF BPUT #1,XBIOS(2),32000 CLOSE #1 SHOWM ENDIF a$="" GOSUB anzeige RETURN > PROCEDURE array_loeschen ERASE ein$() ERASE aus$() ERASE erg() ERASE block_sch|() GOSUB init RETURN > PROCEDURE blatt_schutz gespeichert!=FALSE MENU 17,schutz!+1 schutz!=NOT schutz! anz2 RETURN > PROCEDURE block_schutz IF b1x%>b2x% OR b1y%>b2y% ALERT 3,"BLOCK-Koordinaten falsch| gew„hlt !!",1,"Abbruch",h% ELSE gespeichert!=FALSE ALERT 2," BLOCK SCHUTZ| 1 indifferent | 2 entschtzen| 3 schtzen",1," 1 | 2 | 3 ",in% DEC in% FOR i%=b1x% TO b2x% FOR j%=b1y% TO b2y% block_sch|(i%,j%)=in% NEXT j% NEXT i% anz2 ENDIF RETURN ' ' *** GRAFIKROUTINEN *** Dank an Johannes Fiedler, D-7920 Heidenheim *** ' > PROCEDURE daten.uebernahme GOSUB invert(0) a$="Datentransfer" GOSUB anzeige ALERT 2," Darstellung von | | ",reih%,"Reihen|Spalten",reih% HIDEM DEFFILL 0,0 PBOX 0,240*dvs,639,399*dvs PRINT AT(3,17);"šberschrift :";SPACE$(49);"Datentransfer" PRINT AT(3,18); FORM INPUT 35 AS ueb1$ PRINT AT(3,20);"Untertitel :" PRINT AT(3,21); FORM INPUT 70 AS ueb2$ ein$=STR$(offs) PRINT AT(3,23);"Y-Offset "; FORM INPUT 6 AS ein$ offs=VAL(ein$) ein$=STR$(fak) PRINT AT(3,24);"Y-Faktor "; FORM INPUT 7 AS ein$ fak=VAL(ein$) fak=MAX(0.1,fak) PBOX 0,240*dvs,639,399*dvs LINE 0,380*dvs,639,380*dvs ' PRINT AT(65,17);"Datentransfer" IF reih%=1 a$="Reihen" ELSE a$="Spalten" ENDIF ein$=STR$(rei) PRINT AT(7,17);"Wieviele "+a$+" hintereinander (1-4) ? "; FORM INPUT 1 AS ein$ rei=VAL(ein$) rei=MIN(4,rei) rei=MAX(1,rei) a$=LEFT$(a$,LEN(a$)-1) IF reih%=1 ein$=STR$(beginn%) hilfs$="Eingabe der obersten darzustellenden Zeile: 1 - "+STR$(hoehe%-rei+1) ELSE ein$=CHR$(beginn%+64) hilfs$="Eingabe der „užerst linken darzustellenden Spalte: A - Z" ENDIF PRINT AT(3,25);hilfs$; PRINT AT(7,18);"Beginnend mit ";a$;" "; FORM INPUT 3 AS ein$ IF reih%=1 beginn%=VAL(ein$) beginn%=MIN(beginn%,hoehe%+1-rei) ELSE beginn%=ASC(ein$)-64 IF beginn%>breite%+1-rei SUB beginn%,32 ENDIF ENDIF beginn%=MAX(1,beginn%) PRINT AT(2,25);SPACE$(78); ' IF reih%<>1 a$="Spalte(n)" ein$=STR$(bezrei%) hilfs$="Zeile: 1 - "+STR$(hoehe%-1)+" | Kopfzeile: 0 | nichts: -1" ELSE a$="Reihe(n)" hilfs$="Spalte: A - Z | nichts: -1" IF bezrei%<=0 ein$=STR$(bezrei%) ELSE ein$=CHR$(bezrei%+64) ENDIF ENDIF PRINT AT(3,25);hilfs$; PRINT AT(7,19);"Bezeichnung der ";a$;" "; FORM INPUT 3 AS ein$ IF reih%=1 IF VAL?(ein$)>0 bezrei%=-1 bezrei%=MIN(bezrei%,breite%+1-rei) ELSE bezrei%=ASC(ein$)-64 IF bezrei%>breite%+1-rei SUB bezrei%,32 ENDIF ENDIF ELSE bezrei%=VAL(ein$) bezrei%=MIN(bezrei%,hoehe%+1-rei) ENDIF PRINT AT(2,25);SPACE$(78); ' ein$=STR$(spa) IF reih%=1 hilf$="26" ELSE hilf$="28" ENDIF PRINT AT(7,21);"Wieviele Werte nebeneinander (2-";hilf$;") ? "; FORM INPUT 2 AS ein$ spa=VAL(ein$) spa=MIN(VAL(hilf$),spa) spa=MAX(2,spa) IF reih%=1 ein$=CHR$(beginn2%+64) a$="Spalte" hilfs$="Eingabe der „užerst linken darzustellenden Spalte: A - Z" ELSE ein$=STR$(beginn2%) a$="Reihe" hilfs$="Eingabe der obersten darzustellenden Zeile: 1 - "+STR$(hoehe%-spa+1) ENDIF PRINT AT(3,25);hilfs$; PRINT AT(7,22);"Beginnend mit ";a$;" "; FORM INPUT 3 AS ein$ IF reih%=1 beginn2%=ASC(ein$)-64 IF beginn2%>breite%+1-spa SUB beginn2%,32 ENDIF ELSE beginn2%=MIN(hoehe%+1-spa,VAL(ein$)) ENDIF beginn2%=MAX(1,beginn2%) PRINT AT(2,25);SPACE$(78); ' IF reih%<>1 a$="Reihe(n)" hilfs$="Spalte: A - Z | nichts: -1" IF bez%<=0 ein$=STR$(bez%) ELSE ein$=CHR$(bez%+64) ENDIF ELSE a$="Spalte(n)" ein$=STR$(bez%) hilfs$="Zeile: 1 - "+STR$(hoehe%-1)+" | Kopfzeile: 0 | nichts: -1" ENDIF PRINT AT(3,25);hilfs$; PRINT AT(7,23);"Bezeichnung der ";a$;" "; FORM INPUT 3 AS ein$ IF reih%=1 bez%=MIN(hoehe%+1-rei,VAL(ein$)) ELSE IF VAL?(ein$)>0 bez%=-1 bez%=MIN(bez%,breite%+1-rei%) ELSE bez%=ASC(ein$)-64 IF bez%>breite%+1-rei SUB bez%,32 ENDIF ENDIF ENDIF PRINT AT(2,25);SPACE$(78); IF reih%=1 IF spa+beginn2%+1>breite% spa=breite%-beginn2%+1 ENDIF ELSE IF spa+beginn%+1>hoehe% spa=hoehe%-beginn%+1 ENDIF ENDIF ' FOR i%=1 TO 5 n$(i%)="" NEXT i% FOR i%=1 TO 50 nsa$(i%)="" w(0,i%)=0 NEXT i% CLR maks,maks2 FOR i%=1 TO rei FOR j%=1 TO spa IF reih%=1 w(i%,j%)=erg(beginn2%+j%-1,beginn%+i%-1) IF bezrei%=0 n$(i%)=kopf$(beginn%+i%-1) ELSE IF bezrei%>0 n$(i%)=ein$(bezrei%,beginn%+i%-1) ENDIF ENDIF IF bez%=0 nsa$(j%)=kopf$(beginn2%+j%-1) ELSE IF bez%>0 nsa$(j%)=ein$(beginn2%+j%-1,bez%) ENDIF ENDIF ELSE w(i%,j%)=erg(beginn%+i%-1,beginn2%+j%-1) IF bezrei%=0 n$(i%)=kopf$(beginn%+i%-1) ELSE IF bezrei%>0 n$(i%)=ein$(beginn%+i%-1,bezrei%) ENDIF ENDIF IF bez%>0 nsa$(j%)=ein$(bez%,beginn2%+j%-1) ENDIF ENDIF WHILE LEFT$(n$(i%),1)=" " n$(i%)=MID$(n$(i%),2) WEND n$(i%)=LEFT$(n$(i%),8) WHILE LEFT$(nsa$(j%),1)=" " nsa$(j%)=MID$(nsa$(j%),2) WEND IF spa<7 nsa$(j%)=LEFT$(nsa$(j%),8) ENDIF IF spa=7 nsa$(j%)=LEFT$(nsa$(j%),7) ENDIF IF spa=8 nsa$(j%)=LEFT$(nsa$(j%),6) ENDIF IF spa=9 nsa$(j%)=LEFT$(nsa$(j%),5) ENDIF IF spa>9 nsa$(j%)=LEFT$(nsa$(j%),4) ENDIF IF spa>11 nsa$(j%)=LEFT$(nsa$(j%),3) ENDIF IF spa>14 nsa$(j%)=LEFT$(nsa$(j%),2) ENDIF IF spa>24 nsa$(j%)=LEFT$(nsa$(j%),1) ENDIF ' IF w(i%,j%)=maks offs=0 ENDIF GOSUB bestimme.maks SWAP maks,maks2 GOSUB bestimme.maks SWAP maks,maks2 ' FOR i%=1 TO rei FOR j%=1 TO spa SUB w(i%,j%),offs w(i%,j%)=MAX(0,w(i%,j%)) NEXT j% NEXT i% ' ugrafik!=TRUE FOR i%=80 TO 86 MENU i%,3 NEXT i% IF spa>14 MENU 80,2 MENU 85,2 MENU 86,2 IF rei>2 MENU 82,2 ENDIF ENDIF IF offs<0 FOR i%=80 TO 86 MENU i%,2 NEXT i% MENU 81,3 MENU 82,3 ENDIF SHOWM GOSUB aufbau.screen(x%,y%,cx%,cy%) RETURN > PROCEDURE bestimme.maks SUB maks,offs flag!=FALSE i=0.1 REPEAT IF maks<=i maks=i flag!=TRUE ELSE MUL i,2 IF maks<=i maks=i flag!=TRUE ELSE MUL i,2.5 IF maks<=i maks=i flag!=TRUE ENDIF ENDIF ENDIF MUL i,2 UNTIL i>100000000 OR flag!=TRUE RETURN > PROCEDURE grafik.3d GOSUB ein.grafik CLS COLOR 3 DEFTEXT 1,0,,32+19*test% TEXT 20,52*dvs,ueb1$ DEFTEXT 1,,,6 TEXT 20,66*dvs-2*test%,ueb2$ x1=30 y1=380 vx=25 vy=50 laenge=470 hoehe=250 ho=hoehe la=laenge x2=x1+vx y2=y1-vy GOSUB um x3=x2+la y3=y2-ho x4=x1+la y4=y1-ho b=0 c=b d=(x2-x1)/rei e=(y2-y1)/rei FOR a=0 TO rei DRAW x1+b,(y1+c)*dvs TO x4+b,(y1+c)*dvs b=b+d c=c+e NEXT a b=0 d=(x4-x1)/spa FOR a=0 TO spa DRAW x1+b,y1*dvs TO x2+b,y2*dvs DRAW x2+b,y2*dvs TO x2+b,y3*dvs b=b+d NEXT a b=0 c=b d=(y4-y1)/az FOR a=0 TO az DRAW x1,(y1+b)*dvs TO x2,(y2+b)*dvs DRAW x2,(y2+b)*dvs TO x3,(y2+b)*dvs b=b+d st1=x3+6 st2=y2+a*d IF maks<1 i%=100 ELSE i%=10 ENDIF o=(a*j/az+offs)/fak IF o<10 o=INT(o*i%+0.5)/i% ELSE o=INT(o) ENDIF te$=STR$(o) IF a=az AND fak<>1 te$=te$+" *"+STR$(fak) ENDIF z=4-2*test% DEFTEXT 1,0,,z TEXT st1,st2*dvs-4*test%,te$ NEXT a DRAW x1,y1*dvs TO x1,y4*dvs d=(x4-x1)/spa e=(y1-y2)/rei g=(x2-x1)/rei o=d/4 c=0 h=c COLOR 2 IF hilf$=" S„ulen C-H" GOSUB saeulen ELSE GOSUB bloecke ENDIF GOSUB aufbau.screen(x%,y%,cx%,cy%) RETURN > PROCEDURE saeulen FOR fm=rei DOWNTO 1 b=0 ft=1 DEFFILL 2,2,8-fm*2 te$=n$(fm) FOR a=1 TO spa a1=x2+b+1+o*0.5-h-3*g/4 a2=a1+d-o b2=y2+c+3*e/4 b1=b2-w(fm,a)*u BOX a1,b1*dvs,a2,b2*dvs PBOX a1+1,(b1+1)*dvs,a2-1,(b2-1)*dvs GOSUB seiten GOSUB oben b=b+d NEXT a z=6+2*test% st1=a1+d+4 st2=b2+4 DEFTEXT 1,0,,z TEXT st1-25*test%,st2*dvs,n$(fm) h=h+g c=c+e NEXT fm FOR a=1 TO spa st1=x1+d*a-(d/4)*3.5 st2=y1+10+k te$=STR$(a) DEFTEXT 1,0,,6 TEXT st1,st2*dvs-4*test%,nsa$(a) NEXT a RETURN > PROCEDURE seiten x(1)=a2 x(2)=a2+2*g/4 x(3)=a2+2*g/4 x(0)=a2 y(1)=b2*dvs y(2)=(b2-2*e/4)*dvs y(3)=(b1-2*e/4)*dvs y(0)=b1*dvs POLYFILL 4,x(),y() RETURN > PROCEDURE oben x(1)=a1 x(2)=a2 x(3)=a2+2*g/4 x(0)=a1+2*g/4 y(1)=b1*dvs y(2)=b1*dvs y(3)=(b1-2*e/4)*dvs y(0)=(b1-2*e/4)*dvs POLYFILL 4,x(),y() RETURN > PROCEDURE bloecke FOR fm=rei DOWNTO 1 DEFFILL 2,2,8-fm*2 GOSUB poly te$=n$(fm) st1=x2+laenge+5-fm1*g st2=y2+e+fm1*e DEFTEXT 1,0,,6+2*test% TEXT st1-25*test%,st2*dvs,n$(fm) NEXT fm FOR i=0 TO spa-1 st1=x1+i*d-20 st2=y1+12 DEFTEXT 1,,,6 TEXT st1,st2*dvs-2*test%,nsa$(i+1) NEXT i RETURN > PROCEDURE poly spa1=spa-1 fm1=rei-fm FOR s=0 TO spa1 p=spa1-s x(s)=x2+s*d-fm1*g-g x(spa+p)=x(s)+g y(s)=(y2-u*w(fm,s+1)+4.2*e/4+fm1*e)*dvs y(spa+p)=y(s)-e*dvs NEXT s POLYFILL spa*2,x(),y() FOR s=0 TO spa1 DRAW x(s),y(s) TO x(s)+g,y(s)-e*dvs NEXT s IF hilf$=" Bl”cke C-I" x(spa)=x(spa1) y(spa)=(y2+e+fm1*e)*dvs x(spa+1)=x2-fm1*g-g y(spa+1)=y(spa) POLYFILL spa+2,x(),y() x(1)=x(spa1) y(1)=y(spa1) x(2)=x(1)+g y(2)=y(1)-e*dvs x(3)=x(2) y(3)=(y2+fm1*e)*dvs x(0)=x(1) y(0)=(y2+e+fm1*e)*dvs POLYFILL 4,x(),y() ENDIF RETURN > PROCEDURE grafik.2d GOSUB raster.2d COLOR 2 FOR r=1 TO rei x=40 y=350 IF ba=1 IF r=1 GOSUB balken ENDIF ELSE y=y-(w(r,1)*wy) PLOT x,y*dvs DEFLINE 1,1,0,0 IF r=2 DEFLINE &X11111111111111111010101010101011 ENDIF IF r=3 DEFLINE &X11111111111111111001001001001010 ENDIF IF r=4 DEFLINE 6,1,0,0 ENDIF FOR i=2 TO spa ox=x oy=y+1 x=x+wx y=350-(w(r,i)*wy) DRAW TO x,y*dvs DRAW ox,oy*dvs TO x,y*dvs+1 TO x,y*dvs NEXT i LINE x+52,(125+r*20)*dvs,x+80,(125+r*20)*dvs LINE x+52,(126+r*20)*dvs,x+80,(126+r*20)*dvs DEFTEXT 1,0,,6 TEXT x+84,(130+r*20)*dvs,n$(r) ENDIF NEXT r DEFLINE 1,1,0,0 GOSUB text GOSUB aufbau.screen(x%,y%,cx%,cy%) RETURN > PROCEDURE balken wx=450/spa wwx=wx/(rei+1) FOR i=1 TO rei fill%=MIN(8,14-i*4) IF fill%<0 fill%=15 ENDIF DEFFILL 1-test%,2,fill% FOR p=1 TO spa xx=40+(p-1)*wx+(i-1)*wwx xx2=xx+wwx IF offs>=0 yy2=350-w(i,p)*wy PBOX xx,350*dvs,xx2,yy2*dvs ELSE yy2=350+offs*wy-(w(i,p)+offs)*wy PBOX xx,(350+offs*wy)*dvs,xx2,yy2*dvs ENDIF NEXT p NEXT i GOSUB muster.2d RETURN > PROCEDURE text DEFTEXT 1,0,,32+19*test% TEXT 20,52*dvs,ueb1$ DEFTEXT 1,,,6 TEXT 20,66*dvs-4*test%,ueb2$ FOR i=0 TO az DEFTEXT 1,,,4-2*test% o=(i*awy+offs)/fak IF maks<1 i%=100 ELSE i%=10 ENDIF IF o<10 o=INT(o*i%+0.5)/i% ELSE o=INT(o) ENDIF te$=STR$(o) IF i=az AND fak<>1 te$=te$+" *"+STR$(fak) ENDIF TEXT 496,(350-(i*aby))*dvs-2*test%,te$ NEXT i xxx=500-(ba=1) j=0 FOR i=25 TO xxx STEP wx ii=i+12 IF ba=1 ADD ii,4 ENDIF INC j DEFTEXT 1,0,,6 TEXT ii,360*dvs-4*test%,nsa$(j) NEXT i RETURN > PROCEDURE um j=0 FOR x=1 TO rei FOR b=1 TO spa j=MAX(j,w(x,b)) NEXT b NEXT x j=MAX(j,maks) j=MAX(j,0.1) u=ho/j az=10 RETURN > PROCEDURE kuchen GOSUB ein.grafik CLS var=1 IF aufloesung%<>1 ALERT 2,"Beschriftung der Kuchenteile :",1,"keine|Zahlwert|% -wert",var ENDIF FOR p=1 TO rei su=0 FOR i=1 TO spa su=su+w(p,i)+offs NEXT i IF su<=0 su=1 ENDIF w1=3600/su we=0 IF rei=1 e1=240 e2=215 e3=135 e4=115 ENDIF IF rei=2 e3=90 e4=77 e2=215 IF p=1 e1=130 ELSE e1=380 ENDIF ENDIF IF rei=3 e3=75 e4=68 e1=105 e2=160 IF p=2 e1=400 e2=160 ENDIF IF p=3 e1=250 e2=285 ENDIF ENDIF IF rei=4 e3=65 e4=59 e1=95 e2=144 IF p=2 e1=320 ENDIF IF p=3 e1=200 e2=300 ENDIF IF p=4 e1=430 e2=300 ENDIF ENDIF ELLIPSE e1,e2*dvs,e3,e4*dvs FOR i=1 TO spa DEFTEXT 1,0,,4 wa=we we=we+(w(p,i)+offs)*w1 DEFFILL i>1,2,i PELLIPSE e1,e2*dvs,e3,e4*dvs,wa,we ELLIPSE e1,e2*dvs,e3,e4*dvs,wa,we IF var>1 wx=((wa+we)/2)*PI/1800 w2=0 IF wx>PI/2 IF wx<5.3 w2=8 ENDIF ENDIF wk=w(p,i)+offs IF var=3 wk=INT(1000*wk/su)/10 ENDIF TEXT e1-4-w2+e3*(1.15-(rei=4)/20)*SIN(wx+0.5*PI),(e2+e4*(1.15-(rei=4)/20)*COS(wx+0.5*PI))*dvs,wk ENDIF NEXT i DEFTEXT 1,0,,6+2*test% su$="Summe="+STR$(su) TEXT e1-e3/2,(e2+5*e4/4+18)*dvs-2*test%,su$ DEFTEXT 1,1,,6+2*test% TEXT e1-e3/2,(e2+5*e4/4+9)*dvs,n$(p) NEXT p spp=(12-spa)*10+56 CIRCLE 550,(spp+24)*dvs-10*test%,12 FOR a=2 TO spa DEFFILL a>1,2,a PCIRCLE 550,(spp+a*25)*dvs-10*test%,12 NEXT a FOR a=1 TO spa DEFTEXT 1,0,,6+2*test% TEXT 570,(spp+2+a*25)*dvs-10*test%,nsa$(a) NEXT a DEFTEXT 1,,,32+19*test% TEXT 20,48*dvs,LEFT$(ueb1$,32) DEFTEXT 1,,,6 TEXT 20,60*dvs-4*test%,LEFT$(ueb2$,64) DEFTEXT 1,,,13+7*test% GOSUB aufbau.screen(x%,y%,cx%,cy%) RETURN > PROCEDURE ein.grafik grafik!=TRUE FOR i%=1 TO 78 MENU i%,2 NEXT i% RETURN > PROCEDURE stapel SWAP maks,maks2 GOSUB raster.2d wx=450/spa FOR p=1 TO spa xx=40+(p-1)*wx xx2=xx+wx*0.75 yy2=350-((w(0,p)-offs)*wy) DEFFILL 2,0 oy=350*dvs PBOX xx,oy,xx2,yy2*dvs FOR i=1 TO rei CLR w FOR k%=1 TO i w=w+w(k%,p)+offs NEXT k% SUB w,offs yy2=(350-(w*wy))*dvs IF oy>yy2+2 fill%=MIN(8,14-i*4) IF fill%<0 fill%=15 ENDIF DEFFILL 2,2,fill% PBOX xx,yy2,xx2,oy ELSE LINE xx,yy2,xx2,yy2 ENDIF oy=yy2 NEXT i NEXT p ba=1 GOSUB muster.2d DEFLINE 1,1,0,0 GOSUB text SWAP maks,maks2 GOSUB aufbau.screen(x%,y%,cx%,cy%) RETURN > PROCEDURE muster.2d spp=(12-spa)*10 DEFTEXT 1,0,,6 FOR a=1 TO rei fill%=MIN(8,14-a*4) IF fill%<0 fill%=15 ENDIF DEFFILL 2,2,fill% PCIRCLE 555,(120+a*25)*dvs,12 TEXT 571,(122+a*25)*dvs,n$(a) NEXT a RETURN > PROCEDURE raster.2d GOSUB ein.grafik CLS GOSUB um aby=260/az abx=450/(spa-1) wx=450/(spa-1) spb=spa-1 ba=0 IF hilf$=" Balken C-F" ba=1 spb=spa abx=450/spa wx=abx ENDIF awy=j/az wy=260/j x=40 y=350 COLOR 3 DRAW x,y*dvs TO x+450,y*dvs FOR i=1 TO az y=350-i*aby DRAW x,y*dvs TO 490,y*dvs NEXT i y=350 FOR i=0 TO spb IF hilf$=" Linien C-E" OR i=0 OR i=spb OR offs<0 x=40+i*abx DRAW x,y*dvs TO x,(y-260)*dvs ENDIF NEXT i RETURN ' > PROCEDURE suchen GOSUB invert(0) a$="SUCHEN" GOSUB anzeige ALERT 2," | Suchen nach : ",1," TEXT | LEER | NUM ",in% IF in%=1 PRINT AT(2,3);CHR$(7);CHR$(27);"l" PRINT AT(2,3);"Suchtext eingeben : "; such$="" FORM INPUT 50 AS such$ h$="(Esc) Gefundene Zeilen schreiben ab Zeile : " GOSUB ein.zahl(h$,ymax%+1,1,hoehe%,2,3) IF VAL(aus$)<>-1 zeile%=VAL(aus$) FOR y1%=cy% TO ymax% IF LEFT$(ein$(cx%,y1%),(LEN(such$)))=such$ kop.num ENDIF IF zeile%>hoehe% ALERT 2," Kein Platz mehr | Funktion abgebrochen ",1," ok ",in% y1%=ymax% ENDIF NEXT y1% GOSUB aufbau.screen(x%,y%,cx%,cy%) ELSE GOSUB invert(1) ENDIF ELSE IF in%=2 such$="" h$="(Esc) Gefundene Zeilen schreiben ab Zeile : " GOSUB ein.zahl(h$,ymax%+1,1,hoehe%,2,3) IF VAL(aus$)<>-1 zeile%=VAL(aus$) FOR y1%=cy% TO ymax% IF ein$(cx%,y1%)=such$ kop.num ENDIF IF zeile%>hoehe% ALERT 2," Kein Platz mehr | Funktion abgebrochen ",1," ok ",in% y1%=ymax% ENDIF NEXT y1% GOSUB aufbau.screen(x%,y%,cx%,cy%) ELSE GOSUB invert(1) ENDIF ELSE IF in%=3 ALERT 2," Suchen nach :",1," = 0 | > 0 | < 0 ",in% h$="(Esc) Gefundene Zeilen schreiben ab Zeile : " GOSUB ein.zahl(h$,ymax%+1,1,hoehe%,2,3) IF VAL(aus$)<>-1 zeile%=VAL(aus$) FOR y1%=cy% TO ymax% SELECT in% CASE 1 IF erg(cx%,y1%)==0 AND (VAL?(ein$(cx%,y1%)) OR LEFT$(ein$(cx%,y1%),1)="=") kop.num ENDIF CASE 2 IF erg(cx%,y1%)>0 kop.num ENDIF CASE 3 IF erg(cx%,y1%)<0 kop.num ENDIF ENDSELECT IF zeile%>hoehe% ALERT 2," Kein Platz mehr | Funktion abgebrochen ",1," ok ",in% y1%=ymax% ENDIF NEXT y1% GOSUB aufbau.screen(x%,y%,cx%,cy%) ELSE GOSUB invert(1) ENDIF ELSE GOSUB invert(1) ENDIF a$="" GOSUB anzeige RETURN > PROCEDURE kop.num FOR x1%=1 TO xmax% ein$(x1%,zeile%)=ein$(x1%,y1%) aus$(x1%,zeile%)=aus$(x1%,y1%) erg(x1%,zeile%)=erg(x1%,y1%) NEXT x1% ymax%=zeile% INC zeile% RETURN