Thilo Brandt

Willkommen auf meinem Blog

Mein erstes selbstentwickeltes Software-Programm in GfA-Basic (1991)

19. Dezember 2015 von Thilo Brandt | 1 Kommentar

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) ! GROžSCHRIFT
ON ERROR GOSUB fehler
ON BREAK GOSUB stoppen ! ABBRUCH DURCH DIE 3 STOPP-TASTEN
driv%=GEMDOS(&H19)
@drive_pruef ! AKTUELLEN DRIVE PRšFEN
parameter$=drive$+":\*.*"
'
' šBERPRšFEN NACH AUFL™SUNG :
' ---------------------------
IF XBIOS(4)<>2
ALERT 3," FIHA LŽUFT NUR | AUF HOHER AUFL™SUNG ! ",1," TJA ",k
END
ENDIF
'
' DRUCKER :
' ---------
PRINT " DRUCKERTREIBER FšR NEC PINWRITER P20 UND P30 INSTALLIERT."
PAUSE 20
' PRšFEN 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 , schliežen , ”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 ! PRšFT, 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 L™SCHEN"
TEXT 115,75,"( 2 ) GELDBETRŽGE (E) ( 10 ) GELDBETRŽGE ADDIEREN"
TEXT 115,105,"( 3 ) GELDBETRŽGE (LD)"
TEXT 115,135,"( 4 ) GELDBETRŽGE (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," GELDBETRŽGE (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," GELDBETRŽGE (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 L™SCHEN "
OPENW 1
CLEARW 1
FILESELECT "\*.*","",a$
IF a$<>""
PRINT AT(10,10);"DIE DATEI ";a$;" WIRD GEL™SCHT. "
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,"UNM™GLICH : "+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 DAZUZŽHLEN 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," GELDBETRŽGE (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," GELDBETRŽGE 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);" AUSWŽHLEN :"
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);"FšR 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 BETRŽGE : ";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);"FšR 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
' ------------------------------------------------------------------------------
' FšR WINDOW ANWEISUNGEN
' ------------------------------------------------------------------------------
PROCEDURE mess
IF MENU(1)=22
ALERT 2," WIRKLICH SCHLIEžEN ?",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
' ------------------------------------------------------------------------------
' MENšPUNKTE :
' ------------------------------------------------------------------------------
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 PRšFEN ' ----- 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 FšR 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 RšCKUMSCHLAG" 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 BETŽTIGT .| M™CHTEN 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 BETŽTIGT . | 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 SCHREIBGESCHšTZT ! ",1," MIST ",l
ENDIF
CLOSE
CLOSEW 1
zuhz:
IF abc=1
@hauptmenue
ENDIF
abc=0
RETURN
' ------------------------------------------------------------------------------
PROCEDURE schl ! FENSTER SCHLIEžEN
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 →

  1. Hadley B. Jones
    14. Juli 2016 um 12:47

    Ich habe mir die Tage meinen Source-Code von „Mafia II – The Game“ angeschaut und NICHTS, aber auch gar NICHTS mehr kapiert! 🙂

    Antworten

Schreibe einen Kommentar

Pflichtfelder sind mit * markiert.


Diese Website verwendet Akismet, um Spam zu reduzieren. Erfahre mehr darüber, wie deine Kommentardaten verarbeitet werden.