' ********************************** ' * Konto V2.00c * ' * © 27.3.1993 by Henry König * ' * 2000 Hamburg 53, Bornheide 71 * ' ********************************** ' reservierung ! auf Speichererweiterung prüfen IF speicher%>100 THEN ! Speichererweiterung vorhanden? ' RESERVE speicher% ! ja, dann Speicher reservieren ENDIF ' pwd%=1 ! 1 = ohne Paßwort, 0 = Shareware pwd%=0 ! 1 = ohne Paßwort, 0 = Shareware init ! Initialisieren anschluss ! alle angeschlossenen Geräte feststellen info ! Startinfo start: programmkopf ' anweisung(27) ON MENU GOSUB menÜkontrolle REPEAT SLEEP UNTIL ende! CLOSEW #1 CLOSES 1 END ! system PROCEDURE anweisung.ok PRINT AT(6,28);"Linke Maustaste = speichern, speichern und weiteren Eintrag mit 'j'" PRINT AT(6,31);"Rechte Maustaste oder beliebige Taste = Abbruch ohne Speicherung." DO EXIT IF MOUSEK ! Maustaste gedrückt, dann Schleife abbrechen wiederhol$=INKEY$ EXIT IF LEN(wiederhol$) ! bei gedrückter Taste Schleife abbrechen LOOP wiederhol$=UPPER$(wiederhol$) RETURN PROCEDURE auflisten ! Kontoauszug auf dem Bildschirm oeffne.i ! Datei öffnen IF n%>1 THEN bereich ! Bereich abfragen d%=5 ! Zeilenzähler FOR i%=v% TO n% GET #1,i% IF d%=5 THEN programmkopf COLOR 1,0 TEXT 8,32,"Datum" TEXT 104,32,"Text" COLOR 3,0 ! rot TEXT 400,32,"Soll" COLOR 6,0 ! grün TEXT 480,32,"Haben" COLOR 1,0 ! weiß TEXT 532,32,"Kontostand" COLOR 5,0 ! LINE 4,35,616,35 LINE 4,24,4,200 LINE 94,24,94,200 LINE 348,24,348,200 LINE 436,24,436,200 LINE 524,24,524,200 LINE 616,24,616,200 ENDIF INC d% ! Zeilenzähler plus 1 COLOR 1,0 TEXT 8,d%*8,datum$ TEXT 104,d%*8,text$ IF VAL(betrag$)<=0 THEN COLOR 3,0 TEXT 352,d%*8,betrag$ ELSE COLOR 6,0 TEXT 440,d%*8,betrag$ ENDIF COLOR 1,0 IF VAL(kontostand$)<=0 THEN COLOR 3,0 ELSE COLOR 5,0 ! gelb ENDIF TEXT 528,d%*8,kontostand$ COLOR 5,0 IF d%=25 THEN d%=5 PRINT AT(4,31);"Linke Maustaste oder Space = weiter, rechte Maustaste oder Esc = Abbruch." DO EXIT IF MOUSEK t$=INKEY$ EXIT IF LEN(t$) LOOP IF MOUSEK>1 OR t$=CHR$(27) THEN i%=n% ENDIF ENDIF NEXT i% IF d%>5 THEN LINE 4,d%*8+4,616,d%*8+4 LINE 4,d%*8+6,616,d%*8+6 tastendruck ENDIF ENDIF CLOSE #1 RETURN PROCEDURE ausdrucken ! Kontoauszug auf Drucker oeffne.i ! Datei öffnen IF n%>1 THEN ! mindestens zwei Datensätze bereich ! Bereichswahl abfragen IF v%>0 AND v%<=n% THEN OPEN "O",#4,"PRT:" ! Drucker öffnen FOR i%=v% TO n% GET #1,i% ! Datensatz lesen PRINT #4,datum$;'';text$;'';betrag$;'';kontostand$ NEXT i% tastendruck ! auf Tastendruck warten ENDIF ENDIF CLOSE ! alle dateien und Kanäle schließen RETURN PROCEDURE ausgaben wiederhol$="J" WHILE wiederhol$="J" oeffne.i maske.einblenden COLOR 3,0 PRINT AT(16,5);n%+1;". Datensatz A U S G A B E N" datum ! Datum abfragen text ! Text zur Buchung abfragen buchungsbetrag.aus ! Buchungsbetrag abfragen PRINT AT(6,16);da$ PRINT AT(6,18);te$ PRINT AT(6,20);"Buchung ";w$;". "; be$=STR$(be,10,2) PRINT be$ anweisung.ok ! Anweisung ausgeben IF MOUSEK=1 OR wiederhol$="J" THEN kontostand.speichern ! ja. dann Kontostand speichern wiederhol$="J" ! wegen der WHILE-Schleife ENDIF CLOSE #1 WEND RETURN PROCEDURE beenden ! Programm beenden ALERT 0,"Wollen Sie aufhören",1,"Ende|Weiter",wahl% ende!=(wahl%=1) RETURN PROCEDURE berechnungen ! Ein- und Ausgaben berechnen oeffne.i ! Datei öffnen IF n%>1 THEN ! mindestens zwei Datensätze vorhanden CLR gesamtminus ! Werte löschen CLR gesamtplus programmkopf GET #1,1 ! 1. Datensatz lesen erstbetrag=VAL(kontostand$) PRINT AT(2,5);"Erster Eintrag am ";datum$;" Kontostand ";kontostand$;" ";w$ GET #1,n% ! Datensatz lesen PRINT AT(2,7);"Letzter Eintrag am ";datum$;" Kontostand ";kontostand$;" ";w$ endbetrag=VAL(kontostand$) ! PRINT AT(14,28);"Bitte etwas Geduld ich lese alle Datensätze." FOR i%=1 TO n% ! Alle Datensätze lesen GET #1,i% ! Datensatz lesen PRINT AT(56,2);i% ! Anzeige gesamt=VAL(betrag$) ! Betrag einlesen IF gesamt>0 THEN ! positive gesamtplus=gesamtplus+gesamt ELSE ! negativ gesamtminus=gesamtminus+ABS(gesamt) ENDIF NEXT i% PRINT AT(2,9);"Einnahmen gesamt : "; PRINT USING "######.##",gesamtplus; PRINT " ";w$ ! Währungszeichen ausgeben PRINT AT(2,11);"Ausgaben gesamt : "; PRINT USING "######.##",gesamtminus; PRINT " ";w$ PRINT AT(2,14);"Differenz des absoluten Kontostandes am ";datum$;" = "; PRINT USING "######.##",gesamtplus-gesamtminus; PRINT " ";w$ PRINT PRINT " Differenz der Einnahmen und Ausgaben am ";datum$;" = "; PRINT USING "######.##",endbetrag-erstbetrag; PRINT " ";w$ tastendruck ENDIF CLOSE #1 RETURN PROCEDURE bereich ! welche Datensätze sollen ausgegeben werden programmkopf ! Bildschirm löschen PRINT AT(4,28);"Ab welchem Datensatz ( 1 - ";n%;" ) "; INPUT v$ v%=VAL(v$) ! in Zahl wandeln IF v%<1 OR v%>n% THEN ! gültiger Bereich? v%=1 ! nein, dann ab 1. Datensatz ENDIF RETURN PROCEDURE buchungsbetrag.aus ! Buchungsbetrag abfragen eingabe(1,12,14,30,SPACE$(30)) v%=INSTR(tx$,",") ! Dezimalkomma eingegeben? IF v%<>0 THEN ! ja MID$(tx$,v%,1)="." ! dann gegen Punkt tauschen ENDIF be=-VAL(tx$) ! Buchungsbetrag übergeben RETURN PROCEDURE buchungsbetrag.ein ! Buchungsbetrag abfragen eingabe(1,12,14,30,SPACE$(30)) v%=INSTR(tx$,",") ! Dezimalkomma eingegeben? IF v%<>0 THEN ! ja MID$(tx$,v%,1)="." ! dann gegen Punkt tauschen ENDIF be=VAL(tx$) ! Buchungsbetrag übergeben RETURN PROCEDURE cursor.aus ! Ersatz-Cursor ausschalten LOCATE spalte%+sp%,zeile% ! Cursor positionieren textstil(0,1,0) ! Invers ausschalten PRINT MID$(t$,sp%,1) ! Zeichen ausgeben RETURN PROCEDURE datum ! Datum abfragen da$=DATE$ ! Datum übergeben eingabe(1,8,14,10,da$) ! zur Eingaberoutine da$=tx$ ! Datum merken RETURN PROCEDURE eingabe(sp%,zeile%,spalte%,lg%,t$) undo1$=t$ ! Eingabe sichern eingabe0: PRINT AT(spalte%+1,zeile%);t$ ! String auf Bildschirm eingabe1: IF sp%<1 THEN ! Spalte < 1 sp%=1 ! ja, dann Spalte = 1 ELSE IF sp%>lg% ! Spalte > Stringlaenge sp%=lg% ! ja, dann Spalte = Stringlaenge ENDIF LOCATE spalte%+sp%,zeile% ! Cursor positionieren textstil(7,3,6) ! Invers an PRINT MID$(t$,sp%,1) ! Zeichen ausgeben textstil(0,1,0) ! Invers aus taste ! Zeichen von Tastatur holen IF mausy%>0 THEN ! mit Maus positioniert cursor.aus ! Ersatz-Cursor aus IF (cf% AND mausy%<>zeile%) OR (cf% AND mausx%spalte%+lg%) THEN GOTO eingabe.ende ! ja, dann Ende ELSE sp%=mausx%-spalte% ! Spaltenposition = Mausspalte-Spalte ENDIF ENDIF IF cf%=1 THEN ! Datenfeld links/rechts IF x%=12 OR x%=18 OR x%=20 OR x%=22 THEN ! GOTO eingabe.ende ENDIF ENDIF IF x%=13 OR x%=27 THEN ! Abbbruch durch Esc oder RETURN? GOTO eingabe.ende ELSE IF x%=155 ! Sondertasten cursor.aus ! Ersatz-Cursor ausschalten x%=ASC(MID$(x$,2,1)) ! ASCII-Wert merken IF x%=32 THEN ! Shift-Cursor gedrückt? x%=ASC(MID$(x$,3,1)) ! ja, dann nächsten ASCII-Wert IF x%=64 THEN ! Shift-Cursor-rechts? x%=22 ! ja, dann Ersatzwert übergeben ELSE IF x%=65 ! Shift-Cursor-links? x%=20 ! ja, dann Ersatz-Wert übergeben ENDIF GOTO eingabe.ende ! und abbrechen ENDIF IF x%=65 AND cf%=1 OR x%=66 AND cf%=1 THEN ! Abbbruch GOTO eingabe.ende ENDIF IF x%=63 THEN ! HELP-Taste ELSE IF x%=67 ! Cursor rechts INC sp% ! ja, dann Spalte +1 ELSE IF x%=68 ! Cursor links DEC sp% ! ja, dann Spalte -1 ELSE IF x%=90 ! TAB links sp%=sp%-8 ! Spalte -8 ENDIF ELSE IF x%=127 ! Delete t$=LEFT$(t$,sp%-1)+MID$(t$,sp%+1,lg%-sp%)+" " ! Zeichen löschen ELSE IF x%<32 OR x%>127 AND x%<160 ! Steuerzeichen? cursor.aus IF x%=8 AND sp%>1 THEN ! Backspace t$=LEFT$(t$,sp%-2)+MID$(t$,sp%,lg%-sp%+1)+" " ! Leerzeichen einfügen sp%=sp%-1 ! Spalte -1 ELSE IF x%=4 ! Ctrl-d = Wort löschen WHILE MID$(t$,sp%,1)<>" " AND sp%>1 DEC sp% ! kein Space, dann Startposition minus 1 WEND spe%=sp%+1 ! Startposition and Enposition übergeben WHILE MID$(t$,spe%,1)<>" " AND spe%1 AND sp%1 THEN bereich ! Bereich abfragen GET #1,v% ! Anfangsdatensatz lesen datum1$=datum$ ! Anfangsdatum übergeben GET #1,n% ! letzten Datensatz lesen datum2$=datum$ ! Enddatum übergeben FOR i%=v% TO n% GET #1,i% ! Datensatz lesen grafikpunkt=grafikpunkt+1 wert(grafikpunkt)=VAL(kontostand$) IF wert(grafikpunkt)>maximalwert THEN maximalwert=wert(grafikpunkt) ENDIF NEXT i% teilerv=maximalwert/225 teilerh=590/grafikpunkt wert1=ROUND(maximalwert/4) wert2=ROUND(maximalwert/2) wert3=ROUND(maximalwert/4*3) CLS ! Bildschirm für die Grafik löschen COLOR 4,0 DEFLINE -17554 FOR j%=24 TO 616 STEP 40 LINE j%,12,j%,232 NEXT j% DEFLINE 3 FOR j%=12 TO 245 STEP 20 LINE 24,j%,616,j% NEXT j% DEFLINE 1 PRINT AT(3,29);datum1$ PRINT AT(68,29);datum2$ PRINT AT(3,22);wert1 PRINT AT(3,15);wert2 PRINT AT(3,8);wert3 PRINT AT(3,1);INT(maximalwert) COLOR 5,0 PLOT 24,240-INT(wert(1)/teilerv) FOR p%=2 TO grafikpunkt DRAW TO p%*teilerh+24,240-INT(wert(p%)/teilerv) NEXT p% COLOR 5,0 TEXT 260,243,"H A R D C O P Y" BOX 248,234,390,246 taste ! auf Mausklick warten IF mausk% THEN x%=mausx% ! Mauskoordinaten übergeben y%=mausy% ' IF x%>248 AND x%<390 AND y%>234 AND y%<246 THEN IF x%>31 AND x%<49 AND y%>29 AND y%<31 THEN SETCOLOR 0,15,15,15 ! Farben zurücksetzen SETCOLOR 1,0,0,0 SETCOLOR 4,15,15,15 SETCOLOR 5,4,4,4 SETCOLOR 7,0,0,0 HARDCOPY farben.setzen ! farben neu setzen ENDIF tastendruck ! auf Tastendruck warten ENDIF ENDIF CLOSE ! alle Dateien schließen RETURN PROCEDURE info ! Kurzinfo übers Programm programmkopf PCOLOR 5,0 PRINT AT(10,5);"Konto 2.00. Kontoverwaltung " PCOLOR 3,0 IF pwd%=0 THEN PRINT AT(5,20);"Vertrieb auf Datenträgern nur mit meiner schriftlichen Genehmigung!" PRINT AT(5,22);"Diese Version ist für PDK." ENDIF PCOLOR 1,0 PRINT AT(9,31);"© 1992 by Henry König, Bornheide 71, 2000 Hamburg 53." tastendruck RETURN PROCEDURE init ! init.variable ! Variable vorbesetzen bildschirm ! Bildschirm und Fenster öffnen farben.setzen ! Farbzuweisungen menueein ! Menüs einschalten RETURN PROCEDURE kontostand ! Kontostand anzeigen oeffne.i ! Datei öffnen IF n%>1 THEN ! mindestens zwei Datensätze vorhanden programmkopf GET #1,1 ! 1. Datensatz lesen PRINT AT(2,5);"" PRINT " Erster Eintrag am ";datum$;" Kontostand ";kontostand$;" ";w$ PRINT GET #1,n% ! letzten Datensatz lesen PRINT " Letzter Eintrag am ";datum$;" Kontostand ";kontostand$;" ";w$ PRINT " ===============" PRINT PRINT " Insgesamt sind ";n%;" Datensätze gespeichert." tastendruck ENDIF CLOSE #1 RETURN PROCEDURE kontostand.speichern IF n%>=1 THEN ! schon eine Buchung vorhanden? GET #1,n% ! letzen Datensatz lesen ge=VAL(kontostand$) ! Kontostand merken ENDIF LSET datum$=da$ ! Datum übergeben LSET text$=te$ ! Bemerkung zur Buchung übergeben betrag$=be$ ! Buchungsbetrag übergeben ge=ge+be ! Buchung addieren kontostand$=STR$(ge,10,2) ! Kontostand merken PUT #1,INT(n%+1.5) ! Datensatz speichern RETURN PROCEDURE maske.einblenden programmkopf COLOR 3,0 PRINT AT(6,6);"----------------------------------------" PRINT AT(6,8);"Datum" PRINT AT(6,10);"Text" PRINT AT(6,12);"Betrag" PRINT AT(6,14);"----------------------------------------" PRINT AT(6,20);"Buchung" PRINT AT(6,22);"----------------------------------------" RETURN PROCEDURE menueein ! Menüs zuweisen menue$(0)=" Projekt " menue$(1)="+I Info " menue$(2)="+O Datei öffnen " menue$(3)=" Datei einrichten " menue$(4)="+Q Beenden " menue$(5)="" menue$(6)=" Einträge " menue$(7)=" Einnahmen " menue$(8)=" Ausgaben " menue$(9)="" menue$(10)=" Datei " menue$(11)=" Auflisten " menue$(12)=" Kontostand " menue$(13)=" Grafik " menue$(14)=" Ausdrucken " menue$(15)=" Berechnungen " menue$(16)="" menue$(17)="" MENU menue$() RETURN PROCEDURE menÜkontrolle mn%=MENU(0) SELECT mn% CASE 1 info CASE 2 programmname CASE 3 neue.datei CASE 4 beenden CASE 7 einnahmen CASE 8 ausgaben CASE 11 auflisten CASE 12 kontostand CASE 13 grafik CASE 14 ausdrucken CASE 15 berechnungen ENDSELECT programmkopf RETURN PROCEDURE neue.datei programmname IF abbruch%=0 THEN oeffne.r ! Datei anlegen CLOSE #1 ENDIF RETURN PROCEDURE oeffne.i ! Datei öffnen OPEN "I",#1,pfad$(0)+d$(0) n%=LOF(#1)/le% ! Anzahl der Datensätze lo%=n%*le% ! Dateigröße CLOSE #1 ! Datei schließen oeffne.r ! Datei öffnen RETURN PROCEDURE oeffne.r ! Datei öffnen OPEN "R",#1,pfad$(0)+d$(0),le% FIELD #1,10 AS datum$,30 AS text$,10 AS betrag$,10 AS kontostand$ RETURN PROCEDURE programmname pfad$=pfad$(x2%) ! Pfad übergeben für Fileselect filerequester("Datei auswählen"," OK",pfad$,file$) dateiname$=rdatei$ pfad$=rpfad$ IF dateiname$="" THEN abbruch%=1 ! Abbruchflag setzen ELSE CLR abbruch% ! Abbruchflag löschen x$=UPPER$(RIGHT$(dateiname$,6)) IF x$=".DATEN" OR x$=".MASKE" THEN dateiname$=LEFT$(dateiname$,LEN(dateiname$)-6) ENDIF d$(x2%)=dateiname$+".Daten" ! Datenbankname ' maske$(x2%)=dateiname$+".Maske"! Name der Konfigurationsdatei ENDIF pfad$(x2%)=pfad$ ! Pfad sichern für nächstes Fileselect RETURN PROCEDURE programmkopf CLS ! Bildschirm löschen COLOR 2 ! schwarz PBOX 1,1,639,21 ! Box zeichnen COLOR 0 ! grau PBOX 4,3,636,19 ! Box zeichnen zeichne.schalter(1,1,639,21,1) PCOLOR 5,0 ! gelbe Schrift PRINT AT(3,2);"Prg.:";d$(0) PRINT AT(21,2);"Frei:";FRE(0) PRINT AT(34,2);"Größe:";lo% PRINT AT(47,2);"Extern: ";n% PRINT AT(65,2);DATE$ ' PRINT AT(65,2);"Intern: ";tx% PCOLOR 1,0 ! weiße Schrift programmfuss RETURN PROCEDURE programmfuss ! Anweisungsboxen zeichnen COLOR 2 ! schwarz PBOX 1,208,639,254 ! schwarze Box COLOR 0,0 ! grau PBOX 6,(27*8)-5,633,(28*8)+4 ! 1. graue Box PBOX 6,(29*8)+2,633,251 ! 2. graue Box zeichne.schalter(5,209,633,230,1)! 1. Schalter zeichne.schalter(5,233,633,253,0)! 2. Schalter RETURN PROCEDURE programmfuss1 ! Anweisungsbox ausblenden COLOR 0,0 ! grau PBOX 6,(27*8)-5,633,(28*8)+4 ! 1. graue Box RETURN PROCEDURE satz.lesen ! einen Datensatz lesen ' rn%=rc%(i%) ! Recordnummer GET #1,i% ' GET #1,rn% FOR j1%=1 TO be% te$(j1%)=MID$(record$,po%(j1%),td%(j1%)) NEXT j1% RETURN PROCEDURE satz.schreiben ! Datensatz in Datenbank speichern IF a$(i%)<>te$(id%(0)) THEN ! wurde der Indexeintrag verändert? a$(i%)=te$(id%(0)) ! ja, dann Eintrag übernehmen CLR sortflag% ! Datei ist nicht mehr sortiert ENDIF IF mg2% AND tx%=n% THEN ! Flag für Datei intern verwalten FOR j1%=1 TO be% IF te$(j1%)<>MID$(record$,po%(j1%),td%(j1%)) THEN schreibe.satz ! Datensatz muß extern gespeichert werden aa$(rn%)=record$ ! Datensatz intern ändern j1%=be% ! Schleife abbrechen ENDIF NEXT j1% ELSE ! Datensätze werden nicht intern verwaltet schreibe.satz ! Datensatz m u ß extern gespeichert werden ENDIF RETURN PROCEDURE schreibe.satz ! Datensatz extern speichern rc$="" ! Datensatz löschen FOR j1%=1 TO be% rc$=rc$+te$(j1%) ! Datensatz zusammensetzen NEXT j1% LSET record$=rc$ ! Datensatz übergeben PUT #1,rn% ! und speichern RETURN PROCEDURE text ! Text zur Buchung abfragen eingabe(1,10,14,30,SPACE$(30))! Text abfragen te$=tx$ ! eingabe übergeben IF te$="" THEN ! Leereingabe? te$="-" ! ja, dann Bindestrich übergeben ENDIF RETURN PROCEDURE init.variable ! Variablenzuweisungen max%=200 breite%=640 ! Screenbreite hoehe%=256 ! Screenhöhe ebenen%=3 ! 3 Bitplanes zmenue%=5 ! Anzahl der Zusatz-Menüs w$="DM" le%=61 ! Datensatzlänge be%=4 ! 4 Datenfelder DIM pfad$(3),d$(3) ! Pfadnamen und Dateinamen DIM menue$(21) ! Anzahl der Menüs DIM geraete$(100) ! Anzahl der möglichen Geräte DIM strgadget%(3) DIM file$(max%) DIM wert(999) DIM te$(3),td$(3),td%(3),po%(3) td%(1)=10 td%(2)=30 td%(3)=10 ' td%(4)=10 po%(1)=1 po%(2)=11 po%(3)=41 po%(1)=51 RETURN PROCEDURE bildschirm ! Bildschirm und Fenster öffnen OPENS 1,0,0,breite%,hoehe%,ebenen%,&H8000 OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1 ' LPOKE ADD(FindTask(0),184),WINDOW(1)! Requester auf GFA-Screen umlenken RETURN PROCEDURE taste ! ein Zeichen von der Tastatur holen CLR x% ! Steuerzeichen löschen CLR mausk% CLR mausx% ! Mausspalte löschen CLR mausy% ! Mauszeile löschen WHILE x%=0 AND MOUSEK=0 x$=INKEY$ ! Zeichen von Tastatur x%=ASC(x$) ! ASCII-Wert für Auswertung WEND IF MOUSEK<>0 THEN ! linke Maustaste mausx%=INT(MOUSEX/8)+1 ! ja, dann Spalte = mausx mausy%=INT(MOUSEY/8)+1 ! Zeile = mausy mausk%=MOUSEK ! Maustaste ENDIF RETURN PROCEDURE tastendruck ! auf Tastendruck warten PRINT AT(4,28);SPACE$(74); PCOLOR 5,0 PRINT AT(18,28);" Weiter mit beliebiger Taste oder Mausklick." GOSUB taste PCOLOR 1,0 PRINT AT(4,28);SPACE$(74) RETURN PROCEDURE textstil(stil%,vfarbe%,hfarbe%) par$=STR$(stil%)+";"+STR$(30+vfarbe%)+";"+STR$(40+hfarbe%) PRINT CHR$(&H9B);par$;CHR$(&H6D); RETURN ' ********* ! nur die Filerequester-Prozeduren PROCEDURE filerequester(titel$,ok$,pfad$,file$) x&=-1 ! senkrecht zentrieren y&=-1 ! waagerecht zentrieren IF pfad$="" THEN ' path$=DIR$(0) path$="RAM:" ELSE path$=pfad$ ! Pfad merken ENDIF CLR rek% ! rememberKey rk%=V:rek% ! Zeiger auf rememberKey IF geraetez%>10 THEN ! mehr als 10 Geräte vorhanden? rbreite&=448 ! ja, dann Boxbreite 448 Pixel ELSE ! max. 10 Geräte rbreite&=348 ! Boxbreite 348 Pixel ENDIF rhoehe&=190 ! Boxhöhe IF x&=-1 THEN x&=(640-rbreite&)/2 ! Box in der Breite zentrieren ENDIF IF y&=-1 THEN y&=(234-rhoehe&)/2 ! Box in der Höhe zentrieren ENDIF OPENW #9,x&,y&,rbreite&,rhoehe&,96,2048+4096,1 COLOR 2 ! schwarz BOX 1,1,rbreite&-1,rhoehe&-1 ! Dateibox COLOR 4 ! grau BOX 4,2,rbreite&-4,rhoehe&-2 ! Rahmen in der Box COLOR 0 zeichne.auswahlbox ! Dateiauswahlbox zeichnen zeichne.schalter(13*8-4,5,342,22,1) ! Anweisungsbox zeichnen COLOR 5,0 TEXT 14*8,16,titel$ ! Anweisung ausgeben FOR x|=1 TO 10 gadget(x|,18,21+x|*10,2+22*8+2+4,10) NEXT x| COLOR 1,0 strgadget(x|,23,22+(x|+1)*10,301,9,50,path$) ! Path-Gadget 11 INC x| strgadget(x|,23,28+(x|+1)*10,301,9,50,"") ! File-Gadget 12 INC x| gadget(x|,18,31+(x|+1)*10,70,12) ! OK-Gadget 13 zeichne.schalter(8,(21+(x|+1)*10)+6,96,(21+(x|+1)*10)+26,0) INC x| gadget(x|,rbreite&-88,31+x|*10,70,12) ! Cancel-Gadget 14 zeichne.schalter(rbreite&-96,21+x|*10+6,rbreite&-8,21+x|*10+26,0) INC x| gadget(x|,18,8,55,10) ! Parent-Gadget 15 zeichne.schalter(8,4,80,22,0) INC x| COLOR 3,0 TEXT 22,16,"PARENT" TEXT 22,20+x|*10,ok$ ! OK-Gadget TEXT rbreite&-78,20+x|*10,"ABBRUCH" geraeteschalter ! Geräteschalter zeichnen zeichne.schalter(200,23,240,137,0) ! Proportionalgadget umrahmen erstellen(path$) ! Pfad erstellen und anzeigen propgadget(x|,214,30,15,101) ! Proportionalgadget 16 CLR roll% ! Scrollflag löschen uport%=LPEEK(WINDOW(9)+86) ! Zeiger auf Intui-Message CLR ok% ! OK-Flag löschen WHILE ok%=0 ! ausgabe(roll%) DO CLR imsg% ! letzte Nachricht löschen imsg%=GetMsg(uport%) ! auf Nachricht warten LOOP UNTIL imsg%<>0 IF LONG{imsg%+20}=32 OR LONG{imsg%+20}=64 userid&=DPEEK(LPEEK(imsg%+28)+38) ENDIF ~ReplyMsg(imsg%) ! Nachricht an Task zurückgeben ' SELECT userid& CASE 1 TO 10 ! Filefenster IF LEFT$(file$(userid&+roll%),1)="*" AND filez%<>0 THEN path$=path$+MID$(file$(userid&+roll%),2,LEN(file$(userid&+roll%))-1)+"/" erstellen(MID$(path$,0,LEN(path$)-1)) CLR roll% CARD{pginfo%+4}=0 ~OnGadget(pgadget%,WINDOW(9),0) ! Gadget einschaltem ausgabe(roll%) ! Datei oder Ordner anzeigen refresh(pathadr%,MID$(path$,0,LEN(path$))) ELSE IF filez%<>0 ! Datei ' IF x%=userid&+roll% THEN ! Doppelklick ' rpfad$=CHAR{LONG{LONG{pathadr%+34}}} ' rdatei$=CHAR{LONG{LONG{fileadr%+34}}} ' ok%=1 ! Auswahl abbrechen ' ENDIF refresh(fileadr%,file$(userid&+roll%)) ENDIF CASE 11 ! Pfad-Gadget path$=CHAR{LONG{LONG{pathadr%+34}}} erstellen(MID$(path$,0,LEN(path$))) CASE 12 TO 13 ! File- und OK-Gadget rpfad$=CHAR{LONG{LONG{pathadr%+34}}} rdatei$=CHAR{LONG{LONG{fileadr%+34}}} ok%=1 ! Auswahl abbrechen CASE 14 ! Cancel-Gadget rpfad$="" ! Rückgabepfad löschen rdatei$="" ! Rückgabedateiname löschen ok%=1 ! Auswahl abbrechen CASE 15 ! Parent-Gadget IF INSTR(path$,"/",0) anz|=RINSTR(path$,"/",LEN(path$)) IF anz|<>0 THEN path$=MID$(path$,0,anz|) erstellen(MID$(path$,0,LEN(path$)-1)) ELSE path$=LEFT$(path$,INSTR(path$,":",0)) erstellen(MID$(path$,0,LEN(path$))) ENDIF CLR roll% CARD{pginfo%+4}=0 ~OnGadget(pgadget%,WINDOW(9),0) ! Gadget einschaltem ausgabe(roll%) refresh(pathadr%,MID$(path$,0,LEN(path$))) ENDIF CASE 16 ! Proportionalgadget oldroll%=roll% weiter!=FALSE IF CARD{pginfo%}>255 THEN DO rollen IF roll%<>oldroll% THEN ausgabe(roll%) ENDIF oldroll%=roll% imsg%=GetMsg(uport%) IF LONG{imsg%+20}=64 ~ReplyMsg(imsg%) weiter!=TRUE ENDIF LOOP UNTIL CARD{pginfo%}<255 OR weiter!=TRUE ELSE rollen ENDIF CASE 17 TO 37 ! Devicegadgets zeichne.auswahlbox ! Dateiauswahlbox löschen und zeichnen path$=geraete$(userid&-17+1)+":" refresh(pathadr%,MID$(path$,0,LEN(path$))) erstellen(path$) CLR roll% ausgabe(roll%) refresh(pathadr%,MID$(path$,0,LEN(path$))) ENDSELECT WEND CLOSEW #9 ' ~FreeRemember(rk%,1) ' CLR adr% IF rpfad$<>"" THEN v%=INSTR(rpfad$,":") v1%=LEN(rpfad$) IF v1%>v% AND RIGHT$(rpfad$,1)<>"/" THEN rpfad$=rpfad$+"/" ENDIF ENDIF RETURN PROCEDURE erstellen(path$) lpath$=path$+CHR$(0) CLR filez% ! Dateizähler löschen filelock%=Lock(V:lpath$,-2) IF filelock%=0 THEN ! kein Lock filez%=-1 ! Dateizähler löschen ELSE IF adr%=0 THEN adr%=AllocRemember(rk%,300,65537) ! CHIP-RAM anfordern ENDIF nochfiles|=1 e%=Examine(filelock%,adr%) WHILE nochfiles| ! noch Dateien u. kein Mausknopf gedrückt e%=ExNext(filelock%,adr%) IF e%<>0 THEN sign%=SGN(LPEEK(adr%+4)) adr2%=adr%+8 file$="" file$=LEFT$(CHAR{adr2%},32) IF filez%0 THEN ! Dateien oder Ordner vorhanden QSORT file$(),filez% ! ja, dann sortieren ENDIF IF filez%<=10 THEN CARD{pginfo%+8}=65535 ! VertBody div%=65535 ELSE CARD{pginfo%+8}=65535/(filez%-10) ! VertBody div%=65535/(filez%-10) ENDIF ENDIF IF filelock%>0 THEN ! Lock vorhanden ~UnLock(filelock%) ! ja, dann wieder freigeben ENDIF RETURN PROCEDURE gadget(x|,x&,y&,breite&,hoehe&) bgadget%=AllocRemember(rk%,50,65537) CARD{bgadget%+4}=x& ! linke Ecke CARD{bgadget%+6}=y& ! obere Ecke CARD{bgadget%+8}=breite& ! Breite CARD{bgadget%+10}=hoehe& ! Höhe CARD{bgadget%+12}=3 ! Gadget wird nicht verändert CARD{bgadget%+14}=1 ! Gadget wird sofort aktiv CARD{bgadget%+16}=1 ! Gadgettyp, 1 = Boolean CARD{bgadget%+38}=x| ! Gadget-ID ~AddGadget(WINDOW(9),bgadget%,-1) ~OnGadget(bgadget%,WINDOW(9),0) ! Gadget einschalten RETURN PROCEDURE strgadget(x|,x&,y&,breite&,hoehe&,maxz&,default$) COLOR 1 BOX x&-6,y&-4,x&+breite&+8,y&+hoehe& ! Stringgadget einrahmen BOX x&-5,y&-4,x&+breite&+9,y&+hoehe& ! Stringgadget einrahmen COLOR 2 BOX x&-4,y&-3,x&+breite&+10,y&+hoehe&+1 ! Stringgadget einrahmen BOX x&-3,y&-3,x&+breite&+11,y&+hoehe&+1 ! Stringgadget einrahmen strbuffer%=AllocRemember(rk%,maxz&,65537) stringundo%=AllocRemember(rk%,maxz&,65537) stringinfo%=AllocRemember(rk%,40,65537) strgadget%=AllocRemember(rk%,50,65537) FOR i=1 TO LEN(default$) BYTE{strbuffer%+(i-1)}=ASC(MID$(default$,i,1)) NEXT i BYTE{strbuffer%+i}=0 LONG{stringinfo%+0}=strbuffer% ! Buffer LONG{stringinfo%+4}=stringundo% ! UndoBuffer CARD{stringinfo%+8}=0 ! Buffer Position CARD{stringinfo%+10}=maxz& ! Maximale Zeichenanzahl CARD{stringinfo%+12}=0 ! DispPos CARD{strgadget%+4}=x& ! linke Ecke CARD{strgadget%+6}=y& ! obere Ecke CARD{strgadget%+8}=breite&+8 ! Breite CARD{strgadget%+10}=hoehe& ! Höhe CARD{strgadget%+14}=1 ! Activation RELVERIFY STRINGCENTER CARD{strgadget%+16}=4 ! Gadgettype STRGADGET LONG{strgadget%+18}=0 ! Gadget Render Zeiger LONG{strgadget%+34}=stringinfo% ! SpecialInfo für Stringgadget CARD{strgadget%+38}=x| ! GadgetID ~AddGadget(WINDOW(9),strgadget%,-1) ~OnGadget(strgadget%,WINDOW(9),0) IF x|=11 pathadr%=strgadget% ELSE IF x|=12 fileadr%=strgadget% ENDIF RETURN PROCEDURE propgadget(x|,x&,y&,breite&,hoehe&) render%=AllocRemember(rk%,100,65537) pginfo%=AllocRemember(rk%,30,65537) pgadget%=AllocRemember(rk%,50,65537) CARD{pginfo%}=5 ! Flags AUTOKNOB FREEVERT CARD{pginfo%+4}=0 ! VertPot hier werden Werte ausgelesen IF filez%<=10 THEN CARD{pginfo%+8}=65535 ! VertBody div%=65535 ELSE CARD{pginfo%+8}=65535/(filez%-10) ! VertBody div%=65535/(filez%-10) ENDIF CARD{pgadget%+4}=x& ! linke Ecke CARD{pgadget%+6}=y& ! obere Ecke CARD{pgadget%+8}=breite& ! Breite CARD{pgadget%+10}=hoehe& ! Hoehe CARD{pgadget%+12}=3 ! Flags GADGHNONE CARD{pgadget%+14}=3 ! Activation RELVERIFY GADGIMMEDIATE CARD{pgadget%+16}=3 ! GadgetType PROPORTIONALGADGET LONG{pgadget%+18}=render% ! Gadget Render LONG{pgadget%+34}=pginfo% ! SpecialInfo CARD{pgadget%+38}=x| ! GadgetID User defined ' gad%=AddGadget(WINDOW(9),pgadget%,-1)! Gadget in Liste eintragen ~OnGadget(pgadget%,WINDOW(9),0) ! Gadget einschaltem RETURN PROCEDURE refresh(gadget%,aus$) FOR i=0 TO LEN(aus$) BYTE{LONG{LONG{gadget%+34}}+(i-1)}=ASC(MID$(aus$,i,1)) NEXT i BYTE{LONG{LONG{gadget%+34}}+i-1}=0 ~OnGadget(gadget%,WINDOW(9),0)! Gadget einschalten x%=userid&+roll% ! Zeiger auf Dateinamen merken RETURN PROCEDURE ausgabe(roll%) ! Requesteranzeige scrollen IF roll%+10<=filez% OR filez%<=10 THEN COLOR 0,colrando| PBOX 18,29,18+22*8+2+4,25+10*10+6 COLOR 1,0 IF filez%>10 THEN ! mehr als 10 Dateien zz%=10 ELSE zz%=filez% ENDIF FOR x|=1 TO zz% ! IF LEFT$(file$(x|+roll%),1)="*" THEN COLOR 3,0 ! Ordner in rot ausgeben TEXT 20,28+x|*10,MID$(file$(x|+roll%),1,22) ELSE COLOR 1,0 ! Dateien in weiß ausgeben TEXT 20,28+x|*10,MID$(file$(x|+roll%),1,22) ENDIF NEXT x| ENDIF RETURN PROCEDURE rollen IF filez%>10 THEN roll%=INT(CARD{pginfo%+4}/div%) ! Vertpot auslesen von Gadget 1 ENDIF RETURN PROCEDURE anschluss ! alle angeschlossenen Geräte anzeigen root%=LPEEK(_DosBase+34) ! Zeiger auf das Root-Device info%=LPEEK(root%+24)*4 devinfo%=LPEEK(info%+4)*4 texte%=LPEEK(devinfo%+40)*4 type&=PEEK(devinfo%+7) CLR geraetez% WHILE devinfo%<>0 ! x$="" lg%=PEEK(texte%) ! Textlänge FOR j%=1 TO lg% x$=x$+CHR$(PEEK(texte%+j%))! Gerätenamen zusammensetzen NEXT j% IF type&=0 OR type&=2 ! interner/externer Gerätename IF x$="PRT" OR x$="PAR" OR x$="SER" OR x$="CON" OR x$="NEWCON" OR x$="RAW" THEN ' Standardgeräte ausblenden ELSE IF x$="PIPE" OR x$="AUX" OR x$="SPEAK" THEN ' Standardgeräte ausblenden ELSE INC geraetez% ! Gerätezähler plus 1 geraete$(geraetez%)=x$! internen Gerätenamen merken ENDIF ENDIF ENDIF devinfo%=LPEEK(devinfo%)*4 texte%=LPEEK(devinfo%+40)*4 type&=PEEK(devinfo%+7) WEND INC geraetez% geraete$(geraetez%)="SYS" ! Systemgerät IF geraetez%>20 THEN ! mehr als 20 angeschlossene Geräte geraetez%=20 ! ja, dann auf 20 begrenzen ENDIF QSORT geraete$(),geraetez%+1 CLR j% WHILE j%10 THEN zeichne.schalter(334,23,442,137,1) ! Dateiauswahlbox zeichnen ENDIF COLOR 5,0 FOR j%=1 TO geraetez% INC xx| ! IF j%<=10 THEN gadget(xx|,238,19+(xx|-16)*10,98,12) TEXT 246,19+(xx|-16)*10+9,LEFT$(geraete$(j%),10) ELSE gadget(xx|,338,19+(xx|-16)*10-100,98,12) TEXT 346,19+(xx|-16)*10+9-100,LEFT$(geraete$(j%),10) ENDIF NEXT j% RETURN PROCEDURE zeichne.schalter(sx1%,sy1%,sx2%,sy2%,an%) IF an% THEN schatten%=2 licht%=4 ELSE schatten%=4 licht%=2 ENDIF COLOR 2 ! schwarz COLOR 0 ! grau COLOR licht% ! hellgrau oder schwarz LINE sx1%+8,sy2%-4,sx2%-7,sy2%-4 ! untere Lichtlinien LINE sx2%-7,sy1%+5,sx2%-7,sy2%-4 ! rechte Lichtlinie COLOR schatten% ! schwarz oder hellgrau LINE sx1%+8,sy1%+4,sx2%-7,sy1%+4 ! obere Schatttenlinie LINE sx1%+8,sy1%+4,sx1%+8,sy2%-4 ! linke Schattenlinie RETURN PROCEDURE zeichne.auswahlbox ! Dateiauswahlbox löschen und zeichnen COLOR 0,0 PBOX 8,23,208,137 ! Dateiauswahlbox löschen zeichne.schalter(8,23,208,137,1) ! Dateiauswahlbox zeichnen RETURN REM