Gerade wiederentdeckt. Mein erstes selbstentwickeltes Programm in GfA-Basic aus 1991. FIHA 2.0 – Finanzhaushalt. Echt grass, wenn man das so im Rückblick sieht!
' ------------------------------------------------------------------------------
'
' FINANZHAUSHALT VERSION 2.0 VON THILO BRANDT
'
' GESCHRIEBEN MIT GFA-BASIC (1991-1993)
'
' ------------------------------------------------------------------------------
maus=3
a%=BIOS(11,16) ! GROSCHRIFT
ON ERROR GOSUB fehler
ON BREAK GOSUB stoppen ! ABBRUCH DURCH DIE 3 STOPP-TASTEN
driv%=GEMDOS(&H19)
@drive_pruef ! AKTUELLEN DRIVE PRFEN
parameter$=drive$+":\*.*"
'
' BERPRFEN NACH AUFLSUNG :
' ---------------------------
IF XBIOS(4)<>2
ALERT 3," FIHA LUFT NUR | AUF HOHER AUFLSUNG ! ",1," TJA ",k
END
ENDIF
'
' DRUCKER :
' ---------
PRINT " DRUCKERTREIBER FR NEC PINWRITER P20 UND P30 INSTALLIERT."
PAUSE 20
' PRFEN OB DATEIEN VORHANDTEN :
' ------------------------------
IF EXIST(drive$+":\TITEL.ART")=0
ALERT 3,"DAS TITELBILD IST NICHT | VORHANDEN ! ",1," ENDE ",kk
END
ENDIF
' -------------------------- LADEN VON DATEIEN -------------------------------
'
' BILDER :
' --------
tit$=SPACE$(32000)
BLOAD drive$+":\TITEL.ART",VARPTR(tit$)
SPUT tit$
REPEAT
UNTIL MOUSEK OR INKEY$<>""
CLS
DEFTEXT 1,0,0,13
DEFFILL 1,0,0
HIDEM ! MAUS UNSICHTBAR MACHEN
'
' DATUM EINGEBEN :
' ----------------
CLS
PRINT AT(27,5);"DATUM EINGEBEN : "
PRINT AT(27,7);"TT.MM.JJJJ"
PRINT AT(27,9);
FORM INPUT 10,datum$
SETTIME "",datum$
PRINT AT(27,9);LEFT$(DATE$,10)
PAUSE 20
CLS
asd:
'
' MAUS DEFINIEREN :
' -----------------
DEFMOUSE maus
'
' WINDOW-KOORDINATEN :
' -------------------
attr=WINDTAB+2
xpos=WINDTAB+4
ypos=WINDTAB+6
breite=WINDTAB+8
hoehe=WINDTAB+10
'
DPOKE attr,&HFFF
DPOKE xpos,0
DPOKE ypos,20
DPOKE breite,640
DPOKE hoehe,377
' ------------------------------------------------------------------------------
' MENUELEISTE :
' ------------------------------------------------------------------------------
@rollo_titel
MENU rollo$()
ON MENU GOSUB menue
DO
ON MENU
LOOP
PROCEDURE rollo_titel
DEFFILL 1,2,4
DIM rollo$(75)
RESTORE rollodat
FOR i%=0 TO 75
READ rollo$(i%)
EXIT IF rollo$(i%)="***"
NEXT i%
rollo$(i%)=""
rollo$(i%+1)=""
i%=0
rollodat:
DATA DESKTOP, Ende
DATA --------------
DATA -1,-2,-3,-4,-5,-6,""
DATA FENSTER , schlieen , ffnen
DATA
DATA DISK , freier Diskspeicher , neues Laufwerk
DATA
DATA SONSTIGES , Datum stellen , Info ,
DATA
DATA ***
DEFFILL 1,2,4
DEFTEXT 1,0,0,13
CLS
FILL 0,0
@menue
RETURN
PROCEDURE menue
wahl%=MENU(0)
ON wahl% GOSUB ende
ON wahl%-10 GOSUB schl
ON wahl%-11 GOSUB haupt
ON wahl%-14 GOSUB frei
ON wahl%-15 GOSUB la
ON wahl%-18 GOSUB dat
ON wahl%-19 GOSUB h
'
MENU OFF
RETURN
' ------------------------------------------------------------------------------
' H A U P T P R O G R A M M :
' ------------------------------------------------------------------------------
PROCEDURE haupt ! PRFT, OB FENSTER SCHON OFFEN
IF abc=1
ALERT 1," FENSTER SCHON | OFFEN ! ",1," AHA ",m
ENDIF
@hauptmenue
RETURN
GOSUB hauptmenue
PROCEDURE hauptmenue
DEFMOUSE maus
abc=1
DEFTEXT 1,0,0,13
aa=0
b=0
thilo=1
qq:
attr=WINDTAB+2
xpos=WINDTAB+4
ypos=WINDTAB+6
breite=WINDTAB+8
hoehe=WINDTAB+10
'
DPOKE attr,&HFFF
DPOKE xpos,0
DPOKE ypos,20
DPOKE breite,640
DPOKE hoehe,377
TITLEW 1," H A U P T M E N U E : "
'
ON MENU MESSAGE GOSUB mess
DEFTEXT 1,0,0
OPENW 1
CLEARW 1
text$=""
IF yx=0
y_ende=377
x_ende=640
i_ende=640
j_ende=650
ENDIF
x=MOUSEX
y=MOUSEY
ddd$=" DATUM : "+DATE$
TEXT 330,15,ddd$
TEXT 115,45,"( 1 ) ENDE ( 9 ) DATEI LSCHEN"
TEXT 115,75,"( 2 ) GELDBETRGE (E) ( 10 ) GELDBETRGE ADDIEREN"
TEXT 115,105,"( 3 ) GELDBETRGE (LD)"
TEXT 115,135,"( 4 ) GELDBETRGE (D)"
TEXT 115,165,"( 5 ) ABHEBEN"
TEXT 115,195,"( 6 ) EINBEZAHLEN"
TEXT 115,225,"( 7 ) ZINSBERECHNUNG BEI ANLAGEN"
TEXT 115,255,"( 8 ) BER FIHA 2.0 "
TEXT 115,295,"(E) = ERSTELLEN (LD) = LADEN (D) = DRUCKEN"
a:
ON MENU
i=0
j=0
x=MOUSEX
y=MOUSEY
IF y>y_ende AND MOUSEK
y=0
ENDIF
IF x>x_ende AND MOUSEK
x=0
ENDIF
IF x>115 AND x<145 AND y>35 AND y<45 AND MOUSEK
ALERT 3," WIRKLICH ENDE ? ",1," JA | NEIN ",k
IF k=1
CLOSEW 1
END
ENDIF
GOSUB hauptmenue
ENDIF
IF x>115 AND x<145 AND y>65 AND y<75 AND MOUSEK
@speichern
ENDIF
IF x>115 AND x<145 AND y>95 AND y<105 AND MOUSEK
@laden
ENDIF
IF x>115 AND x<145 AND y>120 AND y<135 AND MOUSEK
@druck
ENDIF
IF x>115 AND x<145 AND y>155 AND y<165 AND MOUSEK
@ab
ENDIF
IF x>115 AND x<145 AND y>185 AND y<195 AND MOUSEK
@hin
ENDIF
IF x>115 AND x<145 AND y>215 AND y<225 AND MOUSEK
@zins
ENDIF
IF x>115 AND x<145 AND y>245 AND y<255 AND MOUSEK
@info
ENDIF
IF x>390 AND x<420 AND y>35 AND y<45 AND MOUSEK
@loeschen
ENDIF
IF x>390 AND x<420 AND y>65 AND y<75 AND MOUSEK
@kapz
ENDIF
GOTO a
RETURN
' ------------------------------------------------------------------------------
' UNTERPROGRAMME :
' ------------------------------------------------------------------------------
PROCEDURE ds
CLS
FILESELECT "\FIHA\*.FIH","",a$
IF a$<>""
OPEN "O",#1,a$
PRINT #1,betrag
PRINT #1,datum$
PRINT #1,bemerke$
CLOSE #1
ELSE
@hauptmenue
ENDIF
RETURN
PROCEDURE dl
CLS
FILESELECT "\FIHA\*.FIH","",a$
IF a$<>""
OPEN "I",#1,a$
INPUT #1,betrag
INPUT #1,datum$
INPUT #1,bemerke$
CLOSE #1
ELSE
@hauptmenue
ENDIF
RETURN
PROCEDURE speichern
CLS
TITLEW 1," GELDBETRGE (E) "
OPENW 1
CLEARW 1
PRINT AT(10,3);"BETRAG IN DM : ";
INPUT "",betrag
IF betrag=0 THEN
GOTO next
ENDIF
ALERT 2," AKTUELLES DATUM | ZUM SPEICHERN ? ",1," JA | NEIN ",l
IF l=1
datum$=DATE$
GOTO uberspr
ENDIF
PRINT AT(10,5);"NEUES DATUM : ";
INPUT "",datum$
uberspr:
PRINT AT(10,7);"BEMERKUNG (MAXIMAL 40 ZEICHEN) :"
PRINT AT(10,8);"---> : ";
FORM INPUT 40,bemerke$
CLS
@ds
next:
@hauptmenue
RETURN
' --------------------------------------------------------------------------------------------
PROCEDURE laden
tx$=""
CLS
TITLEW 1," GELDBETRGE (LD) "
OPENW 1
CLEARW 1
@dl
tx$=RIGHT$(a$,12)
CLS
PRINT AT(10,3);"DATEI : ...";tx$
PRINT AT(10,6);"BETRAG : ";betrag
PRINT AT(10,5);"LETZTER EINTRAG AM ";datum$
PRINT AT(10,7);"BEMERKUNG : ";bemerke$
PRINT AT(10,20);"MAUSKNOPF ODER BELIEBIGE TASTE !"
REPEAT
UNTIL MOUSEK OR INKEY$<>""
@hauptmenue
RETURN
' -------------------------------------------------------------------------------------------------
PROCEDURE loeschen
CLS
TITLEW 1," DATEIEN LSCHEN "
OPENW 1
CLEARW 1
FILESELECT "\*.*","",a$
IF a$<>""
PRINT AT(10,10);"DIE DATEI ";a$;" WIRD GELSCHT. "
KILL a$
ENDIF
@hauptmenue
RETURN
' ------------------------------------------------------------------------------
PROCEDURE hin
tx$=""
CLS
TITLEW 1," EINBEZAHLEN "
OPENW 1
CLEARW 1
@dl
tx$=RIGHT$(a$,12)
CLS
PRINT AT(10,5);"DATEI : ...";tx$
PRINT AT(10,7);"BETRAG VON DATEI : ";betrag;" DM"
PRINT AT(10,9);
INPUT "BETRAG ZUM EINBEZAHLEN IN DM : ",dm1
IF dm1=0 THEN
GOTO uber
ENDIF
betrag=betrag+dm1
OPEN "O",#1,a$
PRINT #1,betrag
PRINT #1,DATE$
PRINT #1,bemerke$
CLOSE #1
CLS
PRINT AT(10,5);"DATEI : ...";tx$
PRINT AT(10,7);"BETRAG VON DATEI : ";betrag-dm1;" DM"
PRINT AT(10,8);"EINBEZAHLTER BETRAG : ";dm1;" DM"
PRINT AT(10,9);"--------------------------------------"
PRINT AT(10,10);"NEUER BETRAG : ";betrag;" DM"
PRINT AT(10,20);"MAUSKNOPF ODER BELIEBIGE TASTE !"
REPEAT
UNTIL MOUSEK OR INKEY$<>""
uber:
@hauptmenue
RETURN
' ------------------------------------------------------------------------------
PROCEDURE ab
CLS
TITLEW 1," ABHEBEN "
OPENW 1
CLEARW 1
@dl
tx$=RIGHT$(a$,12)
CLS
PRINT AT(10,5);"DATEI : ...";tx$
PRINT AT(10,7);"BETRAG VON DATEI : ";betrag;" DM"
PRINT AT(10,9);
INPUT "BETRAG ZUM ABHEBEN IN DM : ",dma
IF dma=0 THEN
GOTO ub
ENDIF
betrag=betrag-dma
OPEN "O",#1,a$
PRINT #1,betrag
PRINT #1,DATE$
PRINT #1,bemerke$
CLOSE #1
CLS
PRINT AT(10,5);"DATEI : ...";tx$
PRINT AT(10,7);"BETRAG VON DATEI : ";betrag+dma;" DM"
PRINT AT(10,8);"ABGEHOBENER BETRAG : ";dma;" DM"
PRINT AT(10,9);"-------------------------------------------"
PRINT AT(10,10);"NEUER BETRAG : ";betrag;" DM"
PRINT AT(10,20);"MAUSKNOPF ODER BELIEBIGE TASTE !"
REPEAT
UNTIL MOUSEK OR INKEY$<>""
ub:
@hauptmenue
RETURN
' ---------------------------------------------------------------------------------------------
PROCEDURE zins
CLS
TITLEW 1," ZINSBERECHNUNG BEI ANLAGEN "
OPENW 1
CLEARW 1
PRINT AT(10,3);"BERECHNUNG DES ENDKAPITALS DURCH DEN ZINSSATZ P NACH N JAHREN :"
z1:
PRINT AT(10,5);
INPUT "ZINSSATZ IN % : ---> ",pro
IF pro<=0 OR pro>200 THEN
IF pro>200
ALERT 1,"SOVIEL PROZENT ? ",1," NAJA ",kl
GOTO z1
ENDIF
GOTO unten
ENDIF
ALERT 2," BETRAG LADEN ODER | NEU EINGEGEBEN ? ",1," NEU | LADEN ",wer
IF wer=1
PRINT AT(10,7);
INPUT "GRUNDKAPITAL IN DM : ",betrag
IF betrag=0
GOTO unten
ENDIF
ELSE
@dl
ENDIF
z2:
PRINT AT(10,9);
INPUT "ZEITRAUM DES ANGELEGTEN GRUNDKAPITALS IN JAHRE : ",aj
IF aj>25 OR aj<=0
ALERT 2,"UNMGLICH : "+STR$(aj)+" JAHREN",1," OK ",l
GOTO z2
ENDIF
z=1+pro/100
k=betrag*z^aj
st$=STR$(FRAC(k)) ! IN $ UMWANDELN
er$=LEFT$(st$,4) ! NUR 2 KOMMASTELLEN
zu=VAL(er$) ! IN ZAHLEN-VARIABLE UMWANDELN
k=k-FRAC(k)+zu ! NACHKOMMABETRAG DAZUZHLEN
zin=k-betrag
' -------
zin$=STR$(FRAC(zin))
z1$=LEFT$(zin$,4)
z2=VAL(z1$)
zin=zin-FRAC(zin)+z2
' -------
CLS
PRINT AT(10,4);"ZINSSATZ : ";pro;" %"
PRINT AT(10,5);"ZEITRAUM : ";aj;" JAHR(E)"
PRINT AT(10,6);
PRINT AT(10,7);"GRUNDKAPITAL : ";betrag;" DM"
PRINT AT(10,8);"ZINSEN : ";zin;" DM (NACH ";aj;" JAHR(EN))"
PRINT AT(10,9);"---------------------------------------------------------------"
PRINT AT(10,10);"ENDKAPITAL : ";k;" DM"
PRINT AT(10,20);"MAUSKNOPF ODER BELIEBIGE TASTE !"
REPEAT
UNTIL MOUSEK OR INKEY$<>""
ALERT 2," DRUCKEN ? ",1," JA | NEIN ",o
IF o=1
dck:
ero=0
ero=GEMDOS(17)
IF ero=1 OR ero=-1
LPRINT CHR$(27);"R";CHR$(2)
LPRINT CHR$(27);"l";CHR$(5)
LPRINT CHR$(27);"G";
LPRINT CHR$(27);"-";CHR$(1)
LPRINT "---------- ZINSBERECHNUNG BEI ANLAGEN ----------"
LPRINT CHR$(27);"H";
LPRINT CHR$(27);"-";CHR$(0)
LPRINT
LPRINT "ZINSSATZ : ";pro;" %"
LPRINT "ZEITRAUM : ";aj;" JAHR(E)"
LPRINT
LPRINT "GRUNDKAPITAL : ";betrag;" DM"
LPRINT "ZINSEN : ";zin;" DM (NACH ";aj;" JAHR(EN))"
LPRINT "-----------------------------------------------------------------"
LPRINT "ENDKAPITAL : ";betrag+zin;" DM"
LPRINT
LPRINT "AUSDRUCKSDATUM : ";DATE$
LPRINT CHR$(27);"l";CHR$(2)
GOTO unten
ENDIF
ALERT 1," DRUCKER NICHT BEREIT ! ",1," BEREIT |ABBRUCH",kk
IF kk=1
GOTO dck
ENDIF
ENDIF
unten:
@hauptmenue
RETURN
' ------------------------------------------------------------------------------------
PROCEDURE druck
tx$=""
CLS
TITLEW 1," GELDBETRGE (D) "
OPENW 1
CLEARW 1
@dl
CLS
drck:
ero=0
ero=GEMDOS(17)
IF ero=1 OR ero=-1
tx$=RIGHT$(a$,12)
LPRINT CHR$(27);"R";CHR$(2)
LPRINT CHR$(27);"l";CHR$(5)
LPRINT CHR$(27);"G";
LPRINT CHR$(27);"-";CHR$(1)
LPRINT "---------- ..."+tx$+" ----------"
LPRINT CHR$(27);"H";
LPRINT CHR$(27);"-";CHR$(0)
LPRINT
LPRINT "GELDBETRAG : ";betrag;" DM"
LPRINT "DATUM : ";datum$
LPRINT "BEMERKUNG : ";bemerke$
LPRINT "AUSDRUCKSDATUM : ";DATE$
LPRINT CHR$(27);"l";CHR$(2)
GOTO 987
ENDIF
ALERT 1," DRUCKER NICHT BEREIT ! ",1," BEREIT |ABBRUCH",kk
IF kk=1
GOTO drck
ENDIF
987:
@hauptmenue
RETURN
' ------------------------------------------------------------------------------
PROCEDURE kapz
bemerke$=""
CLS
TITLEW 1," GELDBETRGE ADDIEREN "
OPENW 1
CLEARW 1
a=0
CLS
ALERT 2," BETRAG LADEN ODER | NEU EINGEBEN ",1," LADEN | NEU ",kl
IF kl=1
betrag_laden:
CLS
PRINT AT(1,3);" EINE DATEI"
PRINT AT(1,4);" AUSWHLEN :"
FILESELECT "\FIHA\*.FIH","",a$
IF a$<>""
OPEN "I",#1,a$
INPUT #1,betrag
INPUT #1,datum$
INPUT #1,bemerke$
CLOSE #1
a=a+betrag
ENDIF
ELSE
CLS
PRINT AT(10,5);"BETRAG IN DM : ";
INPUT "",betrag
IF betrag=0
GOTO beenden
ENDIF
a=a+betrag
GOTO fragen_ob_neuer_betrag
ENDIF
' --------------------
fragen_ob_neuer_betrag:
CLS
ALERT 2," WEITERE BETRAGE | ADDIEREN ? ",1,"JA|NEIN",k
IF k=1 THEN
ALERT 2," BETRAG LADEN ODER | NEU EINGEBEN ? ",1," LADEN | NEU ",k
IF k=1
GOTO betrag_laden
ELSE
CLS
PRINT AT(10,5);"BETRAG ZUM ADDIEREN IN DM : ";
INPUT "",betrag
a=a+betrag
GOTO fragen_ob_neuer_betrag
ENDIF
ELSE
GOTO ergebnis_zeigen
ENDIF
' --------------------
ergebnis_zeigen:
CLS
PRINT AT(10,10);"INSGESAMT : ";a;" DM"
PRINT AT(10,15);"MAUSKNOPF ODER BELIEBIGE TASTE !"
REPEAT
UNTIL MOUSEK OR INKEY$<>""
PAUSE 20
' --------------------
@dr
' --------------------
@sp
GOTO beenden
' --------------------
beenden:
a=0
@hauptmenue
RETURN
PROCEDURE dr
ALERT 2,"| DRUCKEN ? ",1," JA | NEIN ",k
ers=GEMDOS(17)
IF k=1
druckene:
ers=GEMDOS(17)
IF ers=1 OR ers=-1
PRINT AT(10,5);"FR EINE BEMERKUNG (MAX. 25 ZEICHEN) : ";
PRINT AT(10,6);
FORM INPUT 25,text$
CLS
LPRINT CHR$(27);"R";CHR$(2)
LPRINT CHR$(27);"l";CHR$(5)
LPRINT CHR$(27);"G";
LPRINT CHR$(27);"-";CHR$(1)
LPRINT "------- SUMME -------"
LPRINT CHR$(27);"H";
LPRINT CHR$(27);"-";CHR$(0)
LPRINT
LPRINT text$
LPRINT "SUMME DER BETRGE : ";a;" DM"
LPRINT "AUSDRUCKSDATUM : ";DATE$
LPRINT CHR$(27);"l";CHR$(2)
GOTO nch
ENDIF
ALERT 1," DRUCKER NICHT BEREIT ! ",1," FERTIG | ENDE ",hj
IF hj=1
GOTO druckene
ENDIF
nch:
ENDIF
RETURN
PROCEDURE sp
ALERT 2," ABSPEICHERN ? ",1," JA | NEIN ",ww
IF ww=1
betrag=a
datum$=DATE$
CLS
PRINT AT(10,5);"AKTUELLE BEMERKUNG : ";bemerke$
PRINT AT(10,7);"FR EINE BEMERKUNG (MAXIMAL 40 ZEICHEN) :"
PRINT AT(10,8);
FORM INPUT 40,bem$
IF bem$<>""
bemerke$=bem$
ENDIF
@ds
ENDIF
RETURN
' ------------------------------------------------------------------------------
PROCEDURE info
ALERT 0," | PROGRAMM VON THILO BRANDT | | IN GFA-BASIC (1991-1993) ",1," Ok ",kl
@hauptmenue
RETURN
' ------------------------------------------------------------------------------
' FR WINDOW ANWEISUNGEN
' ------------------------------------------------------------------------------
PROCEDURE mess
IF MENU(1)=22
ALERT 2," WIRKLICH SCHLIEEN ?",1," JA | NEIN ",k
IF k=1 THEN
abc=0
CLOSEW 1
sdd:
x=MOUSEX
y=MOUSEY
IF x>x_ende
x=0
ENDIF
IF y>y_ende
y=0
ENDIF
IF i>i_ende
i=0
ENDIF
IF j>j_ende
j=0
ENDIF
ON MENU
GOTO sdd
ELSE
GOSUB hauptmenue
ENDIF
ENDIF
IF MENU(1)=23
@setxybh(0,19,639,380)
ENDIF
IF MENU(1)=27
@setxybh(MENU(5),MENU(6),MENU(7),MENU(8))
ENDIF
RETURN
PROCEDURE setxybh(x,y,b,h)
DPOKE GINTIN,DPEEK(WINDTAB)
DPOKE GINTIN+2,4
GEMSYS 104 !Windget
xa=DPEEK(GINTOUT+2)
ya=DPEEK(GINTOUT+4)
ba=DPEEK(GINTOUT+6)
ha=DPEEK(GINTOUT+8)
GET xa,ya,MIN(ba,b-21),MIN(ha,h-1),temp$
CLOSEW 1
x_ende=b-21
y_ende=h-30
i_ende=b-21
j_ende=h-30
DPOKE xpos,x
DPOKE ypos,y
DPOKE breite,b
DPOKE hoehe,h
OPENW 1
CLEARW 1
DPOKE GINTIN,DPEEK(WINDTAB)
DPOKE GINTIN+2,4
GEMSYS 104
PUT DPEEK(GINTOUT+2),DPEEK(GINTOUT+4),temp$
CLOSEW 0
@hauptmenue
RETURN
' ------------------------------------------------------------------------------
' MENPUNKTE :
' ------------------------------------------------------------------------------
PROCEDURE frei ! DEFINITIONEN SICHERN
bytes=0
laufwerke$=drive$+":\FIHA\*.FIH"
bytes=DFREE(0)
ALERT 0," FREIER DISKSPEICHER : | | "+STR$(bytes)+" BYTES | "+laufwerke$+"",1," Ok ",l
RETURN
' ------------------------------------------------------------------------------
PROCEDURE la ! LAUFWERKBEZEICHNUNG NDERN
TITLEW 1," NEUES LAUFWERK "
OPENW 1
CLEARW 1
alle:
drive$=""
CLS
PRINT AT(10,5);" BITTE NEUES LAUFWERK EINGEBEN ( A - P ): ";
INPUT "",drive$
IF drive$="" OR LEN(drive$)>1
GOTO alle
ENDIF
IF drive$=>"A" AND drive$<="P"
@check
ELSE
GOTO alle
ENDIF
RETURN
PROCEDURE check ! LAUFWERK MIT PFAD
IF drive$="A"
CHDRIVE 1
ENDIF
IF drive$="B"
CHDRIVE 2
ENDIF
IF drive$="C"
CHDRIVE 3
ENDIF
IF drive$="D"
CHDRIVE 4
ENDIF
IF drive$="E"
CHDRIVE 5
ENDIF
IF drive$="F"
CHDRIVE 6
ENDIF
IF drive$="G"
CHDRIVE 7
ENDIF
IF drive$="H"
CHDRIVE 8
ENDIF
IF drive$="I"
CHDRIVE 9
ENDIF
IF drive$="J"
CHDRIVE 10
ENDIF
IF drive$="K"
CHDRIVE 11
ENDIF
IF drive$="L"
CHDRIVE 12
ENDIF
IF drive$="M"
CHDRIVE 13
ENDIF
IF drive$="N"
CHDRIVE 14
ENDIF
IF drive$="O"
CHDRIVE 15
ENDIF
IF drive$="P"
CHDRIVE 16
ENDIF
driv%=GEMDOS(&H19)
@drive_pruef ! AKTUELLEN DRIVE PRFEN
' -----
IF abc=1
@hauptmenue
ENDIF
abc=0
CLOSEW 1
RETURN
PROCEDURE drive_pruef ! AKTUELLES LAUFWERK
IF driv%=0
drive$="A"
ENDIF
IF driv%=1
drive$="B"
ENDIF
IF driv%=2
drive$="C"
ENDIF
IF driv%=3
drive$="D"
ENDIF
IF driv%=4
drive$="E"
ENDIF
IF driv%=5
drive$="F"
ENDIF
IF driv%=6
drive$="G"
ENDIF
IF driv%=7
drive$="H"
ENDIF
IF driv%=8
drive$="I"
ENDIF
IF driv%=9
drive$="J"
ENDIF
IF driv%=10
drive$="K"
ENDIF
IF driv%=11
drive$="L"
ENDIF
IF driv%=12
drive$="M"
ENDIF
IF driv%=13
drive$="N"
ENDIF
IF driv%=14
drive$="O"
ENDIF
IF driv%=15
drive$="P"
ENDIF
RETURN
' ------------------------------------------------------------------------------
PROCEDURE h ! HILFE
DEFTEXT 1,0,0,13
DEFLINE 1,3,0,0
TITLEW 1," INFO FR FIHA "
OPENW 1
CLEARW 1
PRINT AT(10,6);"WENN SIE INFORMATIONEN BER FIHA BRAUCHEN, LESEN SIE BITTE"
PRINT AT(10,7);"'FIHA.TXT' ODER SCHICKEN SIE EINEN FRANKIERTEN RCKUMSCHLAG"
PRINT AT(10,8);"ZUR FOLGENDER ADRESSE :"
PRINT AT(10,9);
PRINT AT(10,10);"THILO BRANDT"
PRINT AT(10,11);"LINDENWEG 12"
PRINT AT(10,12);"6929 ANGELBACHTAL/MICHELFELD"
PRINT AT(10,18);"MAUSKNOPF ODER BELIEBIGE TASTE !"
REPEAT
UNTIL MOUSEK OR INKEY$<>""
IF abc=1
@hauptmenue
ENDIF
abc=0
CLOSEW 1
RETURN
' ------------------------------------------------------------------------------
PROCEDURE dat ! DATUM EINGEBEN UND STELLEN
DEFTEXT 1,0,0,13
DEFFILL 1,0,0
TITLEW 1," DATUM STELLEN "
OPENW 1
CLEARW 1
CLS
PRINT AT(10,7);"DATUM NEU EINGEBEN :"
PRINT AT(10,9);"TT.MM.JJJJ"
PRINT AT(10,10);
FORM INPUT 10,dat$
SETTIME "",dat$
d$=DATE$
PRINT AT(10,10);DATE$
PRINT AT(10,15);"MAUSKNOPF ODER BELIEBIGE TASTE !"
REPEAT
UNTIL MOUSEK OR INKEY$<>""
IF abc=1
@hauptmenue
ENDIF
abc=0
CLOSEW 1
RETURN
' ------------------------------------------------------------------------------
PROCEDURE ende ! PROGRAMM BEENDEN
ALERT 2," WIRKLICH ENDE ? ",1," JA | NEIN ",k
IF k=1 THEN
CLOSEW 1
END
ENDIF
IF abc=1
@hauptmenue
thilo=0
ENDIF
abc=0
CLOSEW 1
RETURN
PROCEDURE stoppen ! PROGRAMM STOPPEN
ALERT 3," SIE HABEN DIE DREI | STOP-TASTEN BETTIGT .| MCHTEN SIE DAS PROGRAMM | VERLASSEN ? ",1," NEIN | JA ",asdf
IF asdf=2
END
ENDIF
stop=stop+1
IF stop>=5
ALERT 3," SIE HABEN SCHON DAS "+STR$(stop)+". MAL | DIE DREI STOP TASTEN BETTIGT . | ENDE ODER WEITER ? ",1," WEITER | ENDE ",kl
IF kl=1
ELSE
END
ENDIF
ENDIF
RETURN
PROCEDURE fehler ! FEHLERSUCHE
CLS
ALERT 3," EIN FEHLER IST AUFGETRETEN ! | FEHLERNR.: "+STR$(ERR),1," MEN |ABBRUCH",d
IF d=2 THEN
PRINT AT(10,0);"YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY"
PAUSE 500
END
ENDIF
IF ERR=-33
ALERT 1," FILE NICHT GEFUNDEN ! ",1," MIST ",kl
ENDIF
IF ERR=-13
ALERT 1," DISKETTE SCHREIBGESCHTZT ! ",1," MIST ",l
ENDIF
CLOSE
CLOSEW 1
zuhz:
IF abc=1
@hauptmenue
ENDIF
abc=0
RETURN
' ------------------------------------------------------------------------------
PROCEDURE schl ! FENSTER SCHLIEEN
x=0
y=0
i=0
j=0
ppi=1
abc=0
CLOSEW 1
zu:
x=MOUSEX
y=MOUSEY
IF x>x_ende
x=0
ENDIF
IF y>y_ende
y=0
ENDIF
IF i>i_ende
i=0
ENDIF
IF j>j_ende
j=0
ENDIF
ON MENU
GOTO zu
RETURN
' ------------------------------------------------------------------------------
'
' E N D E
'
Ein Kommentar
Schreibe einen Kommentar →