Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
screen 0 unter xp / win95
| Uploader: |  oldcoolman |
| Datum/Zeit: | 04.11.2007 21:22:51 |
DECLARE FUNCTION FStr (Zahl as INTEGER) as STRING
DECLARE FUNCTION Zeitformat (urstring as STRING) as STRING
DECLARE SUB Statustoggle (stt as INTEGER )
DECLARE FUNCTION statusselect(zst as INTEGER ) as STRING
DECLARE FUNCTION Pegel (in, stellen as INTEGER )as STRING
DECLARE FUNCTION binaer(in, stellen as INTEGER ) as STRING
DECLARE SUB Statusread (status as INTEGER )
DECLARE SUB fragebox (FR as STRING, Rue as STRING)
DECLARE SUB Hypertext (FileName as STRING, Schluessel as STRING)
DECLARE SUB ZeigeMarke(Markealt as INTEGER ,marke as INTEGER ,Index as STRING,Indexstrf() as STRING,Querf() as INTEGER)
DECLARE SUB ZeigeWort (Querf() as INTEGER,Markealt as INTEGER ,Indexstrf() as STRING)
DECLARE SUB Zeigmenu (max as INTEGER , wahl as INTEGER , locsp as INTEGER , Bu1 as STRING, Rest as STRING)
'DECLARE SUB transkop (Nos as INTEGER )
DECLARE SUB kommando (by as INTEGER )
DECLARE FUNCTION take ()
DECLARE SUB SInput (Parameter as STRING, Vorgabe as STRING, Steuerung)
DECLARE sub SIShow (P2,SHOW as STRING,work as STRING,SImax,SIZeile,SISpalte)
DECLARE sub SIDelete(work as STRING,cpos)
DECLARE sub SIInsert(work as STRING,cpos,SImax,Eingabe as STRING,SIUeberschreiben)
DECLARE sub SIAnz (P2,SHOW as STRING,work as STRING,SImax,SIZeile,SISpalte,cpos)
DECLARE FUNCTION Entfspace (strg as STRING, laeng as INTEGER )as STRING
DECLARE SUB awlmenu ()
DECLARE SUB Operantenformat (Ostrhin as STRING, Ostrrueck as STRING, OPArtAlt as STRING)
DECLARE SUB kopmenu ()
DECLARE SUB fupmenu ()
DECLARE SUB eingang (z as INTEGER , sp as INTEGER , zf as INTEGER )
DECLARE SUB fupeingang (z as INTEGER , sp as INTEGER , zf as INTEGER )
DECLARE SUB AGKasten (x as INTEGER , y as INTEGER , banz as INTEGER , eintr() as STRING, ou() as STRING, z as INTEGER )
DECLARE SUB AGkop (x as INTEGER , y as INTEGER , banz as INTEGER , eintr() as STRING, ou() as STRING)
DECLARE SUB VKKasten (x as INTEGER , y as INTEGER , eintr() as STRING, neg() as STRING, banz as INTEGER , in as STRING, z as INTEGER )
DECLARE SUB transfup (Nos as INTEGER )
DECLARE sub klammer(bk as STRING,b as STRING,z as INTEGER ,zoffset as INTEGER ,zf as INTEGER ,banz as INTEGER ,neg() as STRING,eintr() as STRING,zalt as INTEGER ,sp as INTEGER ,O as STRING,klammerauf as INTEGER )
DECLARE sub loescheFup ()
DECLARE SUB grenzebld ()
DECLARE SUB zeigfup1 (tl as INTEGER )
DECLARE SUB cursor (tl as INTEGER ,zakt as INTEGER )
DECLARE SUB prinfup1 ()
DECLARE SUB EDFup ()
'DECLARE SUB EDKop ()
DECLARE SUB Format (Bstrhin as STRING, Bstrrueck as STRING)
DECLARE SUB nachricht (na as STRING)
DECLARE SUB Suche (l as INTEGER , z as INTEGER , weiter as INTEGER )
DECLARE FUNCTION hexadez (Hexazahl as STRING) as INTEGER
DECLARE SUB pfadsetup (setpf as STRING)
DECLARE SUB Uebertrage ()
DECLARE SUB drucken ()
DECLARE SUB Zeileeinfuegen (lz as INTEGER )
DECLARE SUB Zeileloeschen (lz as INTEGER )
DECLARE SUB deco ()
DECLARE SUB clrs ()
DECLARE FUNCTION Dez (Befehl as STRING)
DECLARE SUB InCodeSetzen (ero as INTEGER ,erolin as INTEGER )
DECLARE SUB Uebernehme (zeile2, topline2)
DECLARE SUB shiften (zeile, re)
DECLARE SUB Editiere ()
DECLARE SUB hexanzeige ()
DECLARE SUB clrpuffer ()
DECLARE SUB Rahmenweg (SeiteOben, SeiteUnten, SeiteLinks, SeiteRechts)
DECLARE SUB zeichnrahmen (oben, unten, links, rechts)
DECLARE SUB filebox (pfad as STRING, pf as STRING, ok as integer,endung as string)
'CLEAR , , 2048': OUT &H278, 0
DIM SHARED GrundfarbeV, GrundfarbeH, RahmenfarbeV, RahmenfarbeH, MenufarbeV, MenufarbeH
DIM SHARED Menu1farbeV, Menu1farbeH, MenufeldfarbeV, MenufeldfarbeH, Menufeld1farbeH, Menufeld1farbeV
DIM SHARED NachrichtfarbeV, NachrichtfarbeH, NachrichtblinkfarbeV
DIM SHARED MenuinvertfarbeV, MenuinvertfarbeH, Menu1invertfarbeV, Menu1invertfarbeH
DIM SHARED MenufeldinvertfarbeV, MenufeldinvertfarbeH, Menufeld1invertfarbeV, Menufeld1invertfarbeH
DIM SHARED feldend as INTEGER , status as INTEGER ,topmax as integer
'
TYPE linpos
culin AS INTEGER
cupos AS INTEGER
END TYPE
DIM SHARED ElNr as INTEGER : ElNr = 1500
DIM SHARED cufeld(ElNr) AS linpos
DIM SHARED feld(ElNr)
DIM SHARED assfeld(ElNr) AS STRING * 20
DIM SHARED stsfeld(ElNr) AS INTEGER
DIM SHARED Befehlsfeld(ElNr) AS STRING * 57
DIM SHARED Pufferfeld(64) AS STRING * 57
DIM SHARED topline, zeile, lz: DIM SHARED pfad2 as STRING
DIM SHARED Pufferbeginn as INTEGER , Pufferende as INTEGER , Puffergroesse as INTEGER
DIM SHARED markeL(4) as INTEGER : DIM SHARED markeZ(4)as INTEGER
DIM SHARED na as STRING, deczeile, zmax, su as INTEGER , bis as INTEGER , Suchstr as STRING, spmin as INTEGER , zoffset as INTEGER
DIM SHARED fupf(64) AS STRING * 156
DIM SHARED be as INTEGER , fmax as INTEGER , LetztesNetzwerk as INTEGER , keinNetzwerk as INTEGER , bldgrenze as INTEGER , ou(64) as STRING
DIM SHARED Hmenusel as INTEGER , Letztepos as INTEGER , tpneu as INTEGER , sgrenze as INTEGER , wgrenze as INTEGER , errbld as INTEGER
DIM SHARED grenze as INTEGER , offend as INTEGER , toplinefupalt as INTEGER , BLDanz as INTEGER
DIM SHARED Nos as INTEGER , weiterI as INTEGER , resumehmenu as INTEGER
DIM SHARED StringPosAdr(ElNr) as INTEGER
DIM Farbe as INTEGER , resum as STRING, pfad as STRING, asw as STRING, Dasw as STRING, Basw as STRING, Easw as STRING, ext as INTEGER
DIM Pulldown as INTEGER , Dateimenusel as INTEGER , Blockmenusel as INTEGER , Editormenusel as INTEGER
DIM pf as STRING, ok, Txtdat as STRING, offen, ps AS SINGLE, Datdat as STRING, Datei as STRING, feldin as INTEGER , pupos
DIM knopf as STRING, pmax, ero as INTEGER , erolin as INTEGER , p as INTEGER , ub, serin as INTEGER , serinalt as INTEGER
DIM x, y, erro,Dasw2 as STRING, Basw2 as STRING ,Easw2 as STRING
dim endung as STRING, t as double
DIM msx as INTEGER, msy as INTEGER, msb as INTEGER
'+++++++++++++++++++ Bild und Farbe einstellen ++++++++++++++++++++++++++++++++
'
Farbe = 0
IF Farbe = 1 THEN
GrundfarbeV = 14: GrundfarbeH = 1
MenufarbeV = 0: MenufarbeH = 7: MenuinvertfarbeV = 7: MenuinvertfarbeH = 0
Menu1farbeV = 1: Menu1farbeH = 7: Menu1invertfarbeV = 12: Menu1invertfarbeH = 0
MenufeldfarbeV = 14: MenufeldfarbeH = 1: MenufeldinvertfarbeV = 15: MenufeldinvertfarbeH = 0
Menufeld1farbeV = 15: Menufeld1farbeH = 1: Menufeld1invertfarbeV = 10: Menufel1dinvertfarbeH = 0
RahmenfarbeV = 4: RahmenfarbeH = 1
NachrichtfarbeV = 12: NachrichtfarbeH = 7: NachrichtblinkfarbeV = 20 '0,3,16
ELSE
GrundfarbeV = 0: GrundfarbeH = 7
MenufarbeV = 0: MenufarbeH = 3: MenuinvertfarbeV = 3: MenuinvertfarbeH = 0
Menu1farbeV = 15: Menu1farbeH = 3: Menu1invertfarbeV = 15: Menu1invertfarbeH = 0
MenufeldfarbeV = 1: MenufeldfarbeH = 7: MenufeldinvertfarbeV = 7: MenufeldinvertfarbeH = 0
Menufeld1farbeV = 0: Menufeld1farbeH = 7: Menufeld1invertfarbeV = 15: Menufel1dinvertfarbeH = 0
RahmenfarbeV = 1: RahmenfarbeH = 7
NachrichtfarbeV = 0: NachrichtfarbeH = 3: NachrichtblinkfarbeV = 16
END IF
ON ERROR GOTO Zeilenzahl' dort wird lz auf 24 gesetzt
lz = 24: LOCATE 24, , 0 '####### Schauen ob VGA50 aktiv #########
'lz = <------- letzte Zeile !!!
Hmenusel = 1: Dateimenusel = 1: Blockmenusel = 1: Editormenusel = 1
SCREEN 0
COLOR GrundfarbeV, GrundfarbeH: clrs
ON ERROR GOTO Dateifehler
'SHELL "C:": SHELL "CD \" 'QB45\SPS52"
OPEN "C:\FBcomp05.pfd" FOR INPUT AS #1
if resumehmenu = 1 then goto setupdateierzeugen
INPUT #1, pfad
if resumehmenu = 1 then goto setupdateierzeugen
CLOSE : CHDIR pfad
goto hmenu
setupdateierzeugen:
pfadsetup(curdir)
Hmenu: '########### Haupt-Men ##############
Pulldouwn = 0:resumehmenu = 0
asw = INKEY
if asw="" then
getmouse(msx,msy,,msb)
IF msb=1 then
IF msy=0 THEN 'Menübalken geklickt
IF msx>0 AND msx<8 THEN asw = "d"
IF msx>9 AND msx<15 THEN asw = "s"
IF msx>17 AND msx<26 THEN asw = "e"
END IF
sleep 100
endif
END IF
IF asw > "" THEN
IF LEN(asw) > 1 THEN
ext = ASC(MID(asw, 2, 1))
IF ext = 77 THEN IF Hmenusel = 3 THEN Hmenusel = 1 ELSE Hmenusel = Hmenusel + 1
IF ext = 75 THEN IF Hmenusel = 1 THEN Hmenusel = 3 ELSE Hmenusel = Hmenusel - 1
IF ext = 80 THEN Pulldouwn = 1
IF ext = 104 THEN Hypertext "Editor.hlp", "Inhalt":sleep
clrs
END IF
asw = UCASE(asw)
IF asw = CHR(13) OR Pulldouwn = 1 THEN
SELECT CASE Hmenusel
CASE 1: asw = "D"
CASE 2: asw = "S"
CASE 3: asw = "E"
END SELECT
END IF
IF asw = "D" THEN Hmenusel = 1: clrs: GOTO Dateimenu
IF asw = "S" THEN Hmenusel = 2: clrs: GOTO Blockmenu
IF asw = "E" THEN Hmenusel = 3: clrs: GOTO Editormenu
IF asw = CHR(27) THEN END
END IF
GOTO Hmenu
Dateimenu:
DO
zeichnrahmen 2, 10, 2, 15
ON ERROR GOTO 0
Zeigmenu 7, Dateimenusel, 3, "NLSVFMQ", "eues Prog aden ichern on Eprom r Assemb S-DOS uit "
DO
Dasw = INKEY
if Dasw="" then
getmouse(msx,msy,,msb)
IF msb=1 then
IF msx>1 AND msx < 14 THEN 'Menübalken geklickt
IF msy = 2 THEN DASw = "n"
IF msy = 3 THEN Dasw = "l"
IF msy = 4 THEN Dasw = "s"
IF msy = 5 THEN Dasw = "v"
IF msy = 6 THEN Dasw = "f"
IF msy = 7 THEN Dasw = "m"
IF msy = 8 THEN Dasw = "q"
END IF
IF msy = 0 and msx > 9 and msx < 15 THEN Dasw = chr(255) + chr(77)
IF msy = 0 and msx > 17 and msx < 26 THEN Dasw = chr(255) + chr(75)
sleep 100
endif
END IF
IF Dasw > "" THEN
Dasw2 = UCASE(Dasw)
COLOR GrundfarbeV, GrundfarbeH: LOCATE 1, 40
IF Dasw = CHR(13) THEN Dasw2 = MID("LSVFMQ", Dateimenusel, 1)
IF Dasw2 = "Q" THEN END
IF Dasw2 = "N" THEN na = "Speicher l”schen...": GOSUB neuesProgramm: Dasw = CHR(27): EXIT DO
IF Dasw2 = "L" THEN na = "Datei laden... ": GOSUB laden: Dasw = CHR(27): EXIT DO
IF Dasw2 = "V" THEN na = "Bin„re Eprom-Datei laden... ": GOSUB LadenBin: Dasw = CHR(27): EXIT DO
IF Dasw2 = "S" THEN na = "Datei sichern... ": GOSUB Sichern: Dasw = CHR(27): EXIT DO
IF Dasw2 = "F" THEN na = "Datei fr Assembler bin„r sichern...": GOSUB SichernBin: Dasw = CHR(27): EXIT DO
IF Dasw2 = "M" THEN na = "MSDOS zurck mit EXIT ": clrs: SHELL: Dasw = CHR(27): EXIT DO
IF LEN(Dasw) > 1 THEN
ext = ASC(RIGHT(Dasw, 1))
IF ext = 104 THEN Hypertext "SPS.HLP", "Datei Men"
IF ext = 77 THEN Hmenusel = 2: clrs: GOTO Blockmenu
IF ext = 75 THEN Hmenusel = 3: clrs: GOTO Editormenu
IF ext = 72 THEN IF Dateimenusel < 2 THEN Dateimenusel = 7 ELSE Dateimenusel = Dateimenusel - 1
IF ext = 80 THEN IF Dateimenusel > 6 THEN Dateimenusel = 1 ELSE Dateimenusel = Dateimenusel + 1
END IF
END IF
LOOP UNTIL LEN(Dasw) > 1 OR Dasw = CHR(27)
LOOP UNTIL Dasw = CHR(27)
Rahmenweg 2, 10, 2, 15
na = " ": clrs
GOTO Hmenu
Blockmenu:
DO
zeichnrahmen 2, 11, 10, 25
Zeigmenu 8, Blockmenusel, 11, "šHSABDPR", "bertrag SPSole von SPStatus VKE usw.Status ild-Memory ata-l”sch rog-l”sch un =starten"
DO
Basw = INKEY
if Basw="" then
getmouse(msx,msy,,msb)
IF msb=1 then
IF msx>9 AND msx < 23 THEN 'Menübalken geklickt
IF msy = 2 THEN Basw = "" 'ü
IF msy = 3 THEN Basw = "h"
IF msy = 4 THEN Basw = "s"
IF msy = 5 THEN Basw = "a"
IF msy = 6 THEN Basw = "b"
IF msy = 7 THEN Basw = "d"
IF msy = 8 THEN Basw = "p"
IF msy = 9 THEN Basw = "r"
END IF
IF msy = 0 and msx > 0 and msx < 8 THEN Basw = chr(255) + chr(75)
IF msy = 0 and msx > 17 and msx < 26 THEN Basw = chr(255) + chr(77)
sleep 100
endif
END IF
IF Basw > "" THEN
COLOR GrundfarbeV, GrundfarbeH
Basw2 = UCASE(Basw)
IF Basw = CHR(13) THEN Basw2 = MID("šHSABDPR", Blockmenusel, 1)
IF Basw2 = "š" OR Basw = "" THEN Uebertrage: Basw = CHR(27): EXIT DO
IF Basw2 = "H" THEN GOSUB HoleBlock: Basw = CHR(27): EXIT DO
IF Basw2 = "S" THEN Statustoggle (1): Basw = CHR(27): EXIT DO
IF Basw2 = "A" THEN Statustoggle (2): Basw = CHR(27): EXIT DO
IF Basw2 = "B" THEN GOSUB Bildmem: Basw = CHR(27): EXIT DO
IF Basw2 = "D" THEN GOSUB Datloesch: Basw = CHR(27): EXIT DO
IF Basw2 = "P" THEN GOSUB Progloesch: Basw = CHR(27): EXIT DO
IF Basw2 = "R" THEN GOSUB starten: Basw = CHR(27): EXIT DO
IF LEN(Basw) > 1 THEN
ext = ASC(MID(Basw, 2, 1))
IF ext = 104 THEN Hypertext "SPS.HLP", "SPS Men"
IF ext = 77 THEN Hmenusel = 3: clrs: GOTO Editormenu
IF ext = 75 THEN Hmenusel = 1: clrs: GOTO Dateimenu
IF ext = 72 THEN IF Blockmenusel < 2 THEN Blockmenusel = 8 ELSE Blockmenusel = Blockmenusel - 1
IF ext = 80 THEN IF Blockmenusel > 7 THEN Blockmenusel = 1 ELSE Blockmenusel = Blockmenusel + 1
END IF
END IF
LOOP UNTIL LEN(Basw) > 1 OR Basw = CHR(27)
LOOP UNTIL Basw = CHR(27)
Rahmenweg 2, 11, 10, 25
clrs
GOTO Hmenu
Editormenu:
DO
zeichnrahmen 2, 6, 20, 26
Zeigmenu 3, Editormenusel, 21, "AFK", "WL UP OP "
DO
Easw = INKEY
if Easw="" then
getmouse(msx,msy,,msb)
IF msb=1 then
IF msx>19 AND msx < 25 THEN 'Menübalken geklickt
IF msy = 2 THEN Easw = "a"
IF msy = 3 THEN Easw = "f"
IF msy = 4 THEN Easw = "k"
END IF
IF msy = 0 and msx > 0 and msx < 8 THEN Easw = chr(255) + chr(77)
IF msy = 0 and msx > 9 and msx < 15 THEN Easw = chr(255) + chr(75)
sleep 100
endif
END IF
IF Easw > "" THEN
COLOR GrundfarbeV, GrundfarbeH
Easw2 = UCASE(Easw)
IF Easw = CHR(13) THEN Easw2 = MID("AFK", Editormenusel, 1)
IF Easw2 = "A" THEN GOTO AWL: EXIT DO
IF Easw2 = "F" THEN GOTO FUP: EXIT DO
IF Easw2 = "K" THEN GOTO KOP: EXIT DO
IF LEN(Easw) > 1 THEN
ext = ASC(MID(Easw, 2, 1))
IF ext = 104 THEN Hypertext "SPS.HLP", "Editor Men"
IF ext = 77 THEN Hmenusel = 1: clrs: GOTO Dateimenu
IF ext = 75 THEN Hmenusel = 2: clrs: GOTO Blockmenu
IF ext = 72 THEN IF Editormenusel < 2 THEN Editormenusel = 3 ELSE Editormenusel = Editormenusel - 1
IF ext = 80 THEN IF Editormenusel > 2 THEN Editormenusel = 1 ELSE Editormenusel = Editormenusel + 1
END IF
END IF
LOOP UNTIL LEN(Easw) > 1 OR Easw = CHR(27)
LOOP UNTIL Easw = CHR(27)
Rahmenweg 2, 6, 20, 26
clrs
GOTO Hmenu
AWL:
ON ERROR GOTO 0
zeichnrahmen 2, lz, 1, 10
zeichnrahmen 2, lz, 12, 34
zeichnrahmen 2, lz, 38, 79
Editiere
clrs
GOTO Hmenu
FUP:
ON ERROR GOTO 0
clrs
EDFup
clrs
ON ERROR GOTO Dateifehler
GOTO Hmenu
KOP:
clrs
'EDKop
'clrs
GOTO Hmenu
neuesProgramm:
gosub loescheAlles
p=0
zmax=1
topmax=20
RETURN
laden:
endung = "*.TXT"
filebox pfad, pf, ok,endung
pupos = INSTR(pf, ".")
IF pupos = 0 THEN Txtdat = pf + ".TXT" ELSE Txtdat = LEFT(pf, pupos) + "TXT"
IF ok = 1 THEN OPEN Txtdat FOR INPUT AS #1: offen = 1
IF Txtdat > "" AND ok = 0 THEN RETURN
IF offen = 1 THEN
GOSUB LoescheAlles
p = 0
DO WHILE NOT EOF(1)' AND p < 255
LINE INPUT #1, Befehlsfeld(p)
p = p + 1
LOOP
zmax = p: topline = 0:topmax = p
END IF
CLOSE : offen = 0:
RETURN
LadenBin:
anfLadenBin:
endung = "*.DAT"
filebox pfad, pf, ok,endung
pupos = INSTR(pf, ".")
IF pupos = 0 THEN Datdat = pf + ".DAT"
IF ok = 1 THEN OPEN pf FOR BINARY AS #1: offen = 1
IF Datei > "" AND ok = 0 THEN GOTO anfLadenBin
IF offen = 1 THEN
GOSUB LoescheAlles
p = 0
DO WHILE NOT EOF(1)
GET #1, p + 1, feldin
feld(p ) = feldin AND 255
p = p + 1
LOOP
zmax = p : topline = 0
END IF
CLOSE : offen = 0:
deco
ON ERROR GOTO 0
RETURN
Sichern:
endung = "*.TXT"
anfSichern:
filebox pfad, pf, ok,endung
pupos = INSTR(pf, ".")
IF pupos = 0 THEN Txtdat = pf + ".TXT": ELSE Txtdat = LEFT(pf, pupos) + "TXT"
ON ERROR GOTO weiter
IF ok = 1 THEN OPEN Txtdat FOR INPUT AS #1
if weiterI = 1 then goto oeffnen
CLOSE
ON ERROR GOTO 0
: clrs: LOCATE 11, 10
PRINT "Datei schon vorhanden !! ...šberschreiben ? (J/N)"
knopf = INPUT(1): IF UCASE(knopf) = "J" THEN GOTO oeffnen ELSE clrs: CLOSE : RETURN
clrs
weiter:
weiterI = 1
RESUME next
oeffnen:
weiterI = 0
ON ERROR GOTO Dateifehler
IF ok = 1 THEN OPEN Txtdat FOR OUTPUT AS #1: offen = 1
IF Datei > "" AND ok = 0 THEN GOTO anfSichern
pmax = 0
IF offen = 1 THEN
pmax = zmax
FOR p = 0 TO pmax
PRINT #1, RTRIM(Befehlsfeld(p))
NEXT p
END IF
CLOSE : offen = 0:
ON ERROR GOTO 0
'#########################################################################
RETURN
SichernBin:
endung = "*.INC"
anfSichernBin:
filebox pfad, pf, ok,endung
pupos = INSTR(pf, ".")
IF pupos = 0 THEN Datdat = pf + ".INC"
ON ERROR GOTO weiterBin
IF ok = 1 AND Datdat > "" THEN OPEN Datdat FOR INPUT AS #1
if weiterI = 1 then goto weiterBin
CLOSE
ON ERROR GOTO 0
: clrs: LOCATE 11, 10
PRINT "Datei schon vorhanden !! ...šberschreiben ? (J/N)"
knopf = INPUT(1): IF UCASE(knopf) = "J" THEN GOTO oeffnenBin ELSE clrs: CLOSE : RETURN
clrs
weiterBin:
weiterI = 0
RESUME next'oeffnenBin
oeffnenBin:
ON ERROR GOTO Dateifehler
CLOSE
IF ok = 1 THEN OPEN Datdat FOR OUTPUT AS #4: offen = 1
IF Datei > "" AND ok = 0 THEN GOTO anfSichernBin
InCodeSetzen ero,erolin ' ##### Text wird assembliert #####
IF ero = 1 THEN nachricht "Fehler in Zeile " + Str(erolin): CLOSE : RETURN
'OPEN "MP8048.DAT" FOR BINARY AS #2
p = 1
'FOR link = 0 TO &H2FF
'GET #2, link + 1, Byte
'dat = Byte AND 255
'GOSUB sende
'NEXT link
PRINT #4, "SPS_CODE:"
FOR ub = 0 TO zmax'255
PRINT #4, assfeld(ub) + "; " + RTRIM(Befehlsfeld(ub))' dat = feld(ub) AND 255
'GOSUB sende
NEXT ub
'FOR link = &H400 TO &H640
'GET #2, link + 1, Byte
'dat = Byte AND 255
'GOSUB sende
'NEXT
CLOSE : offen = 0
ON ERROR GOTO 0
RETURN
'sende:
'PUT #4, p, dat
'p = p + 1
'RETURN
HoleBlock:
ON ERROR GOTO Dateifehler
CLOSE
OPEN COM "COM1:19200,N,8,1,CS0,DS0,CD0,BIN" FOR RANDOM AS #3
GOSUB LoescheAlles
PRINT #3, CHR(1); 'stop
DO
LOOP UNTIL LOC(3)
serin = ASC(INPUT(1, #3))
PRINT #3, CHR(3); 'Byte anfordern
p = 0
DO
t = TIMER
DO
IF TIMER > t + 1 THEN GOTO hbend
LOOP UNTIL LOC(3)
serin = ASC(INPUT(1, #3))
feld(p) = serin
IF serin = 240 AND serinalt = 32 THEN GOTO hbend
serinalt = serin
PRINT #3, CHR(0); 'n„chstes Byte anfordern
p = p + 1
LOOP UNTIL p > ElNr - 4
hbend:
PRINT #3, CHR(0);
CLOSE
deco
ON ERROR GOTO 0
RETURN
Bildmem:
Rahmenweg 2, 11, 10, 25
CLOSE
OPEN COM "COM1:19200,N,8,1,CS0,DS0,CD0,BIN" FOR RANDOM AS #3
PRINT #3, CHR(1); 'stop
DO
LOOP UNTIL LOC(3)
serin = ASC(INPUT(1, #3))
IF serin <> 1 THEN PRINT "Fehler", serin: SLEEP
'Do 'ohne stopbefehl st„nige Anzeige in einer Schleife
FOR x = 0 TO 7
FOR y = 0 TO 15
LOCATE y + 4, (x * 10) + 1
PRINT x * 16 + y;
LOCATE y + 4, (x * 10) + 6
PRINT #3, CHR(5); 'Byte anfordern
DO
LOOP UNTIL LOC(3) 'auf ack warten
serin = ASC(INPUT(1, #3))
PRINT #3, CHR(x * 16 + y); 'Adresse; ausgeben
DO
LOOP UNTIL LOC(3) 'auf Byte warten
serin = ASC(INPUT(1, #3))
PRINT HEX(serin); "h"
NEXT y
NEXT x
'LOOP UNTIL INKEY > ""
PRINT #3, CHR(0); 'Start
CLOSE
do:
getmouse (msx,msy,,msb)
loop until inkey >"" or msb > 0
return
Registerbild:
LOCATE 3, 1
PRINT "Bedeutung Bin„r Hex Bedeutung Bin„r Hex Bedeutung Bin„r Hex "
PRINT "Register0"
PRINT "SPSADR lo"
PRINT "Register2"
PRINT "Register3"
PRINT "Register4"
PRINT "Register5"
PRINT "Zeitflags"
PRINT "Verkn.erg"
PRINT "Stack 0"
PRINT "Stack 1"
PRINT "Stack 2"
PRINT "Stack 3"
PRINT "Stack 4"
PRINT "Stack 5"
PRINT "Stack 6"
PRINT "Stack 7"
PRINT "KlammerFl"
PRINT "Zeitflag0"
PRINT "Zeitflag1"
PRINT "Zeitflag2"
PRINT "Akku 1";
LOCATE 4, 27
PRINT "Akku 2";
LOCATE 5, 27
PRINT "Zeitflank";
LOCATE 6, 27
PRINT "ZeitregT0"
LOCATE 7, 27
PRINT "ZeitregT1"
LOCATE 8, 27
PRINT "ZeitregT2"
LOCATE 9, 27
PRINT "ZeitregT3"
LOCATE 10, 27
PRINT "ZeitregT4"
LOCATE 11, 27
PRINT "ZeitregT5"
LOCATE 12, 27
PRINT "ZeitregT6"
LOCATE 13, 27
PRINT "ZeitregT7"
LOCATE 14, 27
PRINT "Z„hlflank"
LOCATE 15, 27
PRINT "Z„hler Z0"
LOCATE 16, 27
PRINT "Z„hler Z1"
LOCATE 17, 27
PRINT "Z„hler Z2"
LOCATE 18, 27
PRINT "Z„hler Z3"
LOCATE 19, 27
PRINT "Z„hler Z4"
LOCATE 20, 27
PRINT "Z„hler Z5"
LOCATE 21, 27
PRINT "Z„hler Z6"
LOCATE 22, 27
PRINT "Z„hler Z7"
LOCATE 23, 27
PRINT "SPSADR hi"
LOCATE 24, 27
PRINT "ADRSPR lo"
LOCATE 4, 53
PRINT "ADRSPR hi"
LOCATE 5, 53
PRINT "SYS-Flags"
LOCATE 6, 53
PRINT "ZeitAusg"
LOCATE 7, 53
PRINT "Z„hlAusg"
LOCATE 8, 53
PRINT "PAE EB0"
LOCATE 9, 53
PRINT "PAE EB1"
LOCATE 10, 53
PRINT "PAE EB2"
LOCATE 11, 53
PRINT "PAE EB3"
LOCATE 12, 53
PRINT "PAE EB4"
LOCATE 13, 53
PRINT "PAE EB5"
LOCATE 14, 53
PRINT "PAE EB6"
LOCATE 15, 53
PRINT "PAE EB7"
LOCATE 16, 53
PRINT "PAA AB0"
LOCATE 17, 53
PRINT "PAA AB1"
LOCATE 18, 53
PRINT "PAA AB2"
LOCATE 19, 53
PRINT "PAA AB3"
LOCATE 20, 53
PRINT "PAA AB4"
LOCATE 21, 53
PRINT "PAA AB5"
LOCATE 22, 53
PRINT "PAA AB6"
LOCATE 23, 53
PRINT "PAA AB7"
LOCATE 24, 53
'SLEEP
RETURN
Datloesch:
OPEN COM "COM1:19200,N,8,1,CS0,DS0,CD0,BIN" FOR RANDOM AS #3
PRINT #3, CHR(7); 'l”schen
CLOSE
RETURN
Progloesch:
RETURN
starten:
OPEN COM "COM1:19200,N,8,1,CS0,DS0,CD0,BIN" FOR RANDOM AS #3
PRINT #3, CHR(0); 'starten durch löschen des stop-bits
CLOSE
RETURN
LoescheAlles:
FOR x = 0 TO ElNr
Befehlsfeld(x) = ""
assfeld(x) = ""
StringPosAdr(x)=0
feld(x) = 0
NEXT x
RETURN
Dateifehler:
clrs
COLOR NachrichtfarbeV, NachrichtfarbeH
LOCATE 20, 4: erro = ERR
SELECT CASE erro
CASE 5
PRINT "Unzul„ssiger Funktionsaufruf !"
CASE 6
PRINT "šberlauf-Zahlenwert "
CASE 7
PRINT "Speicher voll"
CASE 9
PRINT " Feld-šberlauf ..."
CASE 14
PRINT "String-Variable zu lang "
CASE 27
PRINT "Drucker-Papier ist zu Ende gegangen"
CASE 39
PRINT "Ich brauche CASE ELSE"
CASE 53
PRINT "Datei nicht vorhanden!!!"
CASE 61
PRINT "Diskette/Festplatte voll "
CASE 64
PRINT "Unzul„ssiger Dateinahme ->Benutze nur Buchstaben,"
PRINT "Ziffern,:,\,und/oder den Punkt (.)"
CASE 67
PRINT "Zu viele Dateien im Verzeichnis (>255)"
CASE 70
PRINT "Zugriff nicht erlaubt. (Schreibschutz)"
CASE 71
PRINT "Laufwerk nicht bereit"
CASE 72
PRINT "Dikette/Festplatte defekt"
CASE 75
PRINT "Falscher Zusammenhang zwischen Pfad und Datei"
CASE 76
PRINT pfad; " ->Ich kann diesen Pfad nicht finden !!"
pfad = pfad2
CASE ELSE
PRINT "Fehlercode:"; erro; " "
END SELECT
SLEEP 1500: na = " "
COLOR GrundfarbeV, GrundfarbeH
clrs
IF erro = 71 OR erro = 27 THEN
BEEP
RESUME
ELSE
CLOSE
resumeHmenu = 1
RESUME next'Hmenu
end if
file:
ON ERROR GOTO Dateifehler
'do
'Files= dir("*.*",55)
'loop while Files <> ""
RESUME NEXT
Zeilenzahl:
lz = 24
LOCATE 1, 1
RESUME NEXT
REM STATIC
SUB AGKasten (x, y, banz, eintr() as STRING, ou() as STRING, stsz as INTEGER)
DIM banz2 as integer
IF y + 3 * banz > 63 THEN nachricht "Bildschirmgrenze unten erreicht!": fupmenu: bldgrenze = 1: fmax = 64: EXIT SUB
banz2 = 2
IF banz = 1 THEN
MID(fupf(y), x, 9) = " ÚÄÄÄÄÄ¿"
IF status > 0 THEN
SELECT CASE MID(assfeld(stsz - banz - 1), 3, 1)
CASE "H"
MID(fupf(y + 1), x, 15) = "==´" + ou(1) + "³" + eintr(1)
CASE "L"
MID(fupf(y + 1), x, 15) = "--\" + ou(1) + "³" + eintr(1)
CASE ELSE
MID(fupf(y + 1), x, 15) = "ÄÄ´" + ou(1) + "³" + eintr(1)
MID(fupf(y + 2), x + 11, 15) = MID(assfeld(stsz - banz - 1), 1, 15)'
END SELECT
ELSE
MID(fupf(y + 1), x, 15) = "ÄÄ´" + ou(1) + "³" + eintr(1)
END IF
MID(fupf(y + 2), x, 9) = " ÀÄÄÄÄÄÙ"
banz2 = banz
ELSE
MID(fupf(y), x, 9) = " ÚÄÄÄÄÄ¿"
IF status > 0 THEN
SELECT CASE MID(assfeld(stsz - banz - 1), 3, 1)
CASE "H"
MID(fupf(y + 1), x, 15) = "==´" + ou(1) + "³" + eintr(1)
CASE "L"
MID(fupf(y + 1), x, 15) = "Â-\" + ou(1) + "³" + eintr(1)
CASE ELSE
MID(fupf(y + 1), x, 15) = "ÂÄ´" + ou(1) + "³" + eintr(1)
MID(fupf(y + 2), x + 11, 15) = MID(assfeld(stsz - banz - 1), 1, 15)'
END SELECT
ELSE
MID(fupf(y + 1), x, 15) = "ÂÄ´" + ou(1) + "³" + eintr(1)
END IF
MID(fupf(y + 2), x, 9) = "³ ÀÄÄÄÄÄÙ"
banz2 = 2
DO UNTIL banz2 >= banz
MID(fupf(y + 3 * (banz2 - 1)), x, 9) = "³ ÚÄÄÄÄÄ¿"
IF status > 0 THEN
SELECT CASE MID(assfeld(stsz - banz + banz2 - 2), 3, 1)
CASE "H"
MID(fupf(y + 3 * (banz2 - 1) + 1), x, 15) = "==´" + ou(banz2) + "³" + eintr(banz2)
CASE "L"
MID(fupf(y + 3 * (banz2 - 1) + 1), x, 15) = "Ã-\" + ou(banz2) + "³" + eintr(banz2)
CASE ELSE
MID(fupf(y + 3 * (banz2 - 1) + 1), x, 15) = "ÃÄ´" + ou(banz2) + "³" + eintr(banz2)
MID(fupf(y + 3 * (banz2 - 1) + 2), x + 11, 15) = MID(assfeld(stsz - banz + banz2 - 2), 1, 15)'
END SELECT
ELSE
MID(fupf(y + 3 * (banz2 - 1) + 1), x, 15) = "ÃÄ´" + ou(banz2) + "³" + eintr(banz2)
END IF
MID(fupf(y + 3 * (banz2 - 1) + 2), x, 9) = "³ ÀÄÄÄÄÄÙ"
banz2 = banz2 + 1
LOOP
MID(fupf(y + 3 * (banz2 - 1)), x, 9) = "³ ÚÄÄÄÄÄ¿"
IF status > 0 THEN
SELECT CASE MID(assfeld(stsz - banz + banz2 - 2), 3, 1)
CASE "H"
MID(fupf(y + 3 * (banz2 - 1) + 1), x, 15) = "==´" + ou(banz2) + "³" + eintr(banz2)
CASE "L"
MID(fupf(y + 3 * (banz2 - 1) + 1), x, 15) = "ÀÄ\" + ou(banz2) + "³" + eintr(banz2)
CASE ELSE
MID(fupf(y + 3 * (banz2 - 1) + 1), x, 15) = "ÀÄ´" + ou(banz2) + "³" + eintr(banz2)
MID(fupf(y + 3 * (banz2 - 1) + 2), x + 11, 15) = MID(assfeld(stsz - banz + banz2 - 2), 1, 15)'
END SELECT
ELSE
MID(fupf(y + 3 * (banz2 - 1) + 1), x, 15) = "ÀÄ´" + ou(banz2) + "³" + eintr(banz2)
END IF
MID(fupf(y + 3 * (banz2 - 1) + 2), x, 9) = " ÀÄÄÄÄÄÙ"
END IF
fmax = y + 3 * banz2
END SUB
SUB awlmenu
DIM li as INTEGER, po as INTEGER
COLOR GrundfarbeV, GrundfarbeH
li = CSRLIN: po = POS(0)
LOCATE 1, 1
COLOR MenufarbeV, MenufarbeH: PRINT STRING(80, 32)
LOCATE 1, 1
PRINT "F1 M1³F2 M2³F3 M3³F4 M4³F5³St³F7 Mark³F8 Copy³F9 Su³F10 Wei Su³F11 šbtr³F12 Dru";
COLOR GrundfarbeV, GrundfarbeH: LOCATE li, po
END SUB
FUNCTION binaer (in, stellen as INTEGER) as STRING
DIM binstr AS STRING, xb as INTEGER
binstr = ""
FOR xb = 1 TO stellen
IF xb MOD 4 = 1 THEN binstr = " " + binstr
binstr = CHR((in AND 1) + 48) + binstr
in = in \ 2
NEXT
binaer = binstr
END FUNCTION
SUB clrs
DIM li as INTEGER, po as INTEGER
COLOR GrundfarbeV, GrundfarbeH
CLS
li = CSRLIN: po = POS(0)
COLOR MenufarbeV, MenufarbeH: PRINT STRING(80, 32): LOCATE 1, 1
IF Hmenusel = 1 THEN COLOR MenuinvertfarbeV, MenuinvertfarbeH ELSE COLOR MenufarbeV, MenufarbeH
LOCATE 1, 4: PRINT "atei ";
IF Hmenusel = 2 THEN COLOR MenuinvertfarbeV, MenuinvertfarbeH ELSE COLOR MenufarbeV, MenufarbeH
LOCATE 1, 13: PRINT "PS ";
IF Hmenusel = 3 THEN COLOR MenuinvertfarbeV, MenuinvertfarbeH ELSE COLOR MenufarbeV, MenufarbeH
LOCATE 1, 21: PRINT "ditor ";
IF Hmenusel = 1 THEN COLOR Menu1invertfarbeV, Menu1invertfarbeH ELSE COLOR Menu1farbeV, Menu1farbeH
LOCATE 1, 2: PRINT " D";
IF Hmenusel = 2 THEN COLOR Menu1invertfarbeV, Menu1invertfarbeH ELSE COLOR Menu1farbeV, Menu1farbeH
LOCATE 1, 11: PRINT " S";
IF Hmenusel = 3 THEN COLOR Menu1invertfarbeV, Menu1invertfarbeH ELSE COLOR Menu1farbeV, Menu1farbeH
LOCATE 1, 19: PRINT " E";
COLOR NachrichtfarbeV, NachrichtfarbeH: LOCATE 1, 30: PRINT na: LOCATE 2, 1
COLOR MenufarbeH, GrundfarbeH: PRINT STRING(80, 205)
COLOR GrundfarbeV, GrundfarbeH: LOCATE li, po
END SUB
SUB deco
DIM pmaxi as INTEGER, asszeile as INTEGER, endlin as INTEGER, by as INTEGER, vorbef as INTEGER
DIM BefehlAnhang AS STRING, Bd AS STRING,deczeile as INTEGER
DIM Labelnr as INTEGER
DIM Adressfeld_A(200) as INTEGER, adr_gefunden as INTEGER
DIM adrstack as INTEGER
pmaxi = 0: deczeile = 0: asszeile = 0: labelnr = 0: adrstack=0
endlin = ElNr
DO UNTIL NOT ((feld(endlin) = 0) OR (feld(endlin) = 255))
endlin = endlin - 1
LOOP
pmaxi = endlin: zmax = endlin
DO'---------------------------Erst mal schauen ob Befehl mit Data ------------
Befehlsfeld(asszeile) = "": BefehlAnhang = ""
StringPosAdr(deczeile)=asszeile
SELECT CASE feld(deczeile) AND 31
CASE 1
Befehlsfeld(asszeile) = "U"
CASE 2
Befehlsfeld(asszeile) = "O"
CASE 6
Befehlsfeld(asszeile) = "S"
CASE 7
Befehlsfeld(asszeile) = "R"
CASE 8
Befehlsfeld(asszeile) = "="
CASE 10
Befehlsfeld(asszeile) = "SE"
CASE 11
Befehlsfeld(asszeile) = "SA" '+ Str((feld(deczeile) AND 224) / 32)
CASE 12
Befehlsfeld(asszeile) = "ZV" '+ Str((feld(deczeile) AND 224) / 32)
CASE 13
Befehlsfeld(asszeile) = "ZR" '+ Str((feld(deczeile) AND 224) / 32)
CASE 14
Befehlsfeld(asszeile) = "S " '+ Str((feld(deczeile) AND 224) / 32)
CASE 15
Befehlsfeld(asszeile) = "R "' + Str((feld(deczeile) AND 224) / 32)
CASE 17
Befehlsfeld(asszeile) = "UN"
CASE 18
Befehlsfeld(asszeile) = "ON"
CASE 21
Befehlsfeld(asszeile) = "L KF"
CASE 23
Befehlsfeld(asszeile) = "L "
CASE 24
SELECT CASE feld(deczeile)
CASE 24
Befehlsfeld(asszeile) = "LC "
CASE 56
Befehlsfeld(asszeile) = "LL "
CASE 88
Befehlsfeld(asszeile) = "LH "
CASE 120
Befehlsfeld(asszeile) = "LI "
CASE 152
Befehlsfeld(asszeile) = "LB "
END SELECT
CASE 25
SELECT CASE feld(deczeile)
CASE 25
Befehlsfeld(asszeile) = "T "
CASE 57
Befehlsfeld(asszeile) = "TI "
CASE 121
Befehlsfeld(asszeile) = "TSS "
CASE 153
Befehlsfeld(asszeile) = "TB "
CASE 185
Befehlsfeld(asszeile) = "SSS "
CASE 217
Befehlsfeld(asszeile) = "UHR "
END SELECT
CASE 31
Befehlsfeld(asszeile) = "SL "
case 29
select case feld(deczeile)
CASE 125
Befehlsfeld(asszeile) = "SZP "
end select
CASE ELSE
IF (feld(deczeile) AND 31) = 22 THEN Befehlsfeld(asszeile) = "L KT "
END SELECT '----------------Wenn Data-Befehl dann schreibe Data-------------
IF RTRIM(Befehlsfeld(asszeile)) <> "" THEN
vorbef = feld(deczeile) AND 31
'mid(Befehlsfeld(asszeile),40,4)=Str(feld(deczeile))
deczeile = deczeile + 1
'mid(Befehlsfeld(asszeile),45,4)=Str(feld(deczeile))
assfeld(asszeile)=str(vorbef)+" "+str(feld(deczeile))
SELECT CASE vorbef
CASE 21
BefehlAnhang = SPACE(6 - LEN(Str(feld(deczeile)))) + Str(feld(deczeile))
CASE 22
BefehlAnhang = SPACE(4 - LEN(Str(feld(deczeile)))) + Str(feld(deczeile)) + "." + Str((feld(deczeile - 1) AND 192) / 64)
CASE 10, 11
BefehlAnhang = "T" + SPACE(5 - LEN(Str(feld(deczeile)))) + Str(feld(deczeile))'
CASE 12, 13, 14, 15
BefehlAnhang = "Z" + SPACE(5 - LEN(Str(feld(deczeile)))) + Str(feld(deczeile))'
CASE 23, 24, 25
by = feld(deczeile) and 255: Bd = ""
'IF by > 22 AND by < 31 THEN Bd = "T " + SPACE(4 - LEN(Str(by - 23))) + Str(by - 23)
'IF by > 31 AND by < 40 THEN Bd = "Z " + SPACE(4 - LEN(Str(by - 32))) + Str(by - 32)
IF by > 32 AND by < 41 THEN Bd = "EB" + SPACE(4 - LEN(Str(by - 33))) + Str(by - 33)
IF by > 40 AND by < 49 THEN Bd = "AB" + SPACE(4 - LEN(Str(by - 41))) + Str(by - 41)
IF by > 48 THEN Bd = "MB" + SPACE(4 - LEN(Str(by - 49))) + Str(by - 49)
IF Bd = "" THEN Bd = "SB" + SPACE(4 - LEN(Str(by))) + Str(by)
BefehlAnhang = Bd
CASE 31
by = feld(deczeile) and 255: Bd = ""
IF by > 48 AND by < 128 THEN Bd = "MW" + SPACE(4 - LEN(Str(by - 48))) + Str(by - 48)
IF Bd = "" THEN Bd = "SB" + SPACE(4 - LEN(Str(by))) + Str(by)
BefehlAnhang = Bd
CASE 29
SELECT CASE feld(deczeile-1)
CASE 125
by=feld(deczeile) and 255:Bd = " "
IF by=127 THEN
Mid(Bd,1,3)="TGL"
ELSE
IF by and 1 = 1 then Mid(Bd,1,2)="MO"
IF by and 2 = 2 then Mid(Bd,3,2)="DI"
IF by and 4 = 4 then Mid(Bd,5,2)="MI"
IF by and 8 = 8 then Mid(Bd,7,2)="DO"
IF by and 16 = 16 then Mid(Bd,9,2)="FR"
IF by and 32 = 32 then Mid(Bd,11,2)="SA"
IF by and 64 = 64 then Mid(Bd,13,2)="SO"
END IF
MID (Befehlsfeld(asszeile),5,14) = Bd
asszeile=asszeile+1:
StringPosAdr(deczeile)=asszeile
Befehlsfeld(asszeile)="ZEIT= "+FSTR(feld(deczeile+1))+"-"+ FSTR(feld(deczeile+2))+"-"+FSTR(feld(deczeile+3))
deczeile +=3
end select
CASE ELSE
by = (feld(deczeile) AND 255)
'IF by = 44 THEN Bd = "T " + Str((feld(deczeile - 1) AND 224) / 32)
'IF by = 45 THEN Bd = "Z " + Str((feld(deczeile - 1) AND 224) / 32)
IF by < 33 or by = 32 THEN Bd = "S" + SPACE(3 - LEN(Str(by))) + Str(by) + "." + Str((feld(deczeile - 1) AND 224) / 32)
IF by > 32 AND by < 41 THEN Bd = "E" + SPACE(3 - LEN(Str(by - 33))) + Str(by - 33) + "." + Str((feld(deczeile - 1) AND 224) / 32)
IF by > 40 AND by < 49 THEN Bd = "A" + SPACE(3 - LEN(Str(by - 41))) + Str(by - 41) + "." + Str((feld(deczeile - 1) AND 224) / 32)
IF by > 48 THEN Bd = "M" + SPACE(3 - LEN(Str(by - 49))) + Str(by - 49) + "." + Str((feld(deczeile - 1) AND 224) / 32)
BefehlAnhang = Bd
END SELECT
ELSE 'ansonsten d.h. wenn noch nichts dekodiert
IF (feld(deczeile) AND 31) = 9 THEN Befehlsfeld(asszeile) = "UBD" + Str((feld(deczeile) AND 32) / 32)
SELECT CASE feld(deczeile)
CASE 0: Befehlsfeld(asszeile) = "NOP 0"
CASE 64: Befehlsfeld(asszeile) = "NOPS0"
CASE 128: Befehlsfeld(asszeile) = "NOPE0"
CASE 32: Befehlsfeld(asszeile) = "*** "
CASE 96: Befehlsfeld(asszeile) = "***S"
CASE 160: Befehlsfeld(asszeile) = "***E"
END SELECT
IF feld(deczeile) = 3 THEN Befehlsfeld(asszeile) = "U("
IF feld(deczeile) = 4 THEN Befehlsfeld(asszeile) = "O("
IF feld(deczeile) = 5 THEN Befehlsfeld(asszeile) = ")"
IF feld(deczeile) = 19 THEN Befehlsfeld(asszeile) = "NOP res.P19"
IF feld(deczeile) = 20 THEN Befehlsfeld(asszeile) = "NOP res.P20"
IF feld(deczeile) = 26 THEN Befehlsfeld(asszeile) = "!=F"
IF feld(deczeile) = 27 THEN Befehlsfeld(asszeile) = "< F"
IF feld(deczeile) = 28 THEN Befehlsfeld(asszeile) = "> F"
IF feld(deczeile) = 29 THEN Befehlsfeld(asszeile) = "+ F"
IF feld(deczeile) = 30 THEN Befehlsfeld(asszeile) = "- F"
IF feld(deczeile) = 16 THEN Befehlsfeld(asszeile) = "BE"
IF feld(deczeile) = 48 THEN Befehlsfeld(asszeile) = "BEU"
IF feld(deczeile) = 61 THEN Befehlsfeld(asszeile) = "* F"
IF feld(deczeile) = 62 THEN Befehlsfeld(asszeile) = "/ F"
IF feld(deczeile) = 89 THEN Befehlsfeld(asszeile) = "INV"
IF feld(deczeile) = 93 THEN Befehlsfeld(asszeile) = "U F"
IF feld(deczeile) = 94 THEN Befehlsfeld(asszeile) = "O F"
IF feld(deczeile) = 126 THEN Befehlsfeld(asszeile) = "XOF"
IF feld(deczeile) = 240 THEN Befehlsfeld(asszeile) = "PE"
'jetzt die mit den Adressen
SELECT CASE feld(deczeile)
CASE 80
adresse=feld(deczeile+1)*256 + feld(deczeile+2)
such = 0:adr_gefunden=0
while such <= adrstack
IF Adressfeld_A(such)=adresse THEN
labelnr=such+1:adr_gefunden=1
EXIT WHILE
END IF
such = such +1
WEND
IF adr_gefunden=0 THEN
Adressfeld_A(adrstack)=adresse
adrstack=adrstack+1
labelnr=labelnr+1
END IF
Befehlsfeld(asszeile) = "SPB Label"+str(labelnr-1)
deczeile = deczeile + 2
CASE 184
adresse=feld(deczeile+1)*256 + feld(deczeile+2)
such = 0:adr_gefunden=0
while such <= adrstack
IF Adressfeld_A(such)=adresse THEN
labelnr=such+1:adr_gefunden=1
EXIT WHILE
END IF
such = such +1
WEND
IF adr_gefunden=0 THEN
Adressfeld_A(adrstack)=adresse
adrstack=adrstack+1
labelnr=labelnr+1
END IF
Befehlsfeld(asszeile) = "LPDI Label"+str(labelnr-1)
deczeile = deczeile + 2
END SELECT
END IF
IF RTRIM(Befehlsfeld(asszeile)) = "" THEN 'immer noch nix gefunden
Befehlsfeld(asszeile) = "DB "+ STR(feld(deczeile))
END IF
IF LEN(RTRIM(Befehlsfeld(asszeile))) < 7 THEN
Befehlsfeld(asszeile) = RTRIM(Befehlsfeld(asszeile)) + SPACE(6 - LEN(RTRIM(Befehlsfeld(asszeile)))) + BefehlAnhang
END IF
deczeile = deczeile + 1: asszeile = asszeile + 1
LOOP UNTIL deczeile > pmaxi
topmax=deczeile
zmax = pmaxi
for labelnr=0 to adrstack-1 'jetzt noch die Labels einsetzen
Zeileeinfuegen(StringPosAdr(Adressfeld_A(labelnr)))
Befehlsfeld(StringposAdr(Adressfeld_A(labelnr)))="Label"+str(labelnr)+":"
for shift = Adressfeld_A(labelnr) to zmax
StringPosAdr(shift)=StringPosAdr(shift)+1
next
next
END SUB
FUNCTION Dez (Befehl as STRING)
DIM dat, bef AS STRING, leerpos, binpos, binwert, hexpos, hexwert,dezimal
IF Befehl = "" THEN EXIT FUNCTION
dat = 1: Befehl = LTRIM(Befehl): bef = Befehl + " "
leerpos = INSTR(bef, " ")
IF leerpos > 1 THEN bef = LEFT(bef, leerpos - 1)
IF ASC(LEFT(bef, 1)) > 47 AND ASC(LEFT(bef, 1)) < 58 THEN dezimal = VAL(LEFT(bef, 4))
IF ASC(LEFT(bef, 1)) = 37 THEN
IF LEN(bef) = 1 THEN EXIT FUNCTION
FOR binpos = 0 TO LEN(bef) - 2
SELECT CASE ASC(MID(bef, LEN(bef) - binpos, 1))
CASE 48
binwert = 0
CASE 49
binwert = 1
CASE ELSE
dat = 0
END SELECT
dezimal = dezimal + binwert * 2 ^ binpos
NEXT
END IF
IF ASC(LEFT(bef, 1)) = 36 THEN
IF LEN(bef) = 1 THEN EXIT FUNCTION
FOR hexpos = 0 TO LEN(bef) - 2
SELECT CASE ASC(MID(bef, LEN(bef) - hexpos, 1))
CASE 48
hexwert = 0
CASE 49
hexwert = 1
CASE 50
hexwert = 2
CASE 51
hexwert = 3
CASE 52
hexwert = 4
CASE 53
hexwert = 5
CASE 54
hexwert = 6
CASE 55
hexwert = 7
CASE 56
hexwert = 8
CASE 57
hexwert = 9
CASE 65
hexwert = 10
CASE 66
hexwert = 11
CASE 67
hexwert = 12
CASE 68
hexwert = 13
CASE 69
hexwert = 14
CASE 70
hexwert = 15
CASE ELSE
dat = 0
END SELECT
dezimal = dezimal + hexwert * 16 ^ hexpos
NEXT
END IF
IF dat = 1 THEN Dez = dezimal
END FUNCTION
SUB drucken
DIM cpalt as INTEGER , clalt as INTEGER , H as string, vonA as INTEGER , bisA as INTEGER , dr, druzeile as INTEGER , leer as INTEGER
cpalt = POS(0): clalt = CSRLIN
LOCATE 1, 1: COLOR MenufarbeV, MenufarbeH
PRINT SPACE(79): LOCATE 1, 30
LOCATE 1, 10: COLOR MenufarbeV, MenufarbeH
INPUT ; "Von Zeile:", H: vonA = VAL(H)
LOCATE 1, 32
INPUT ; " Bis Zeile:", H: bisA = VAL(H)
IF bisA > zmax THEN bisA = zmax
FOR dr = vonA TO bisA
LPRINT STRING(6 - LEN(Str(dr)), 32); Str(dr); " : "; RTRIM(Befehlsfeld(dr))
druzeile = druzeile + 1
IF druzeile = 60 THEN druzeile = 0: LPRINT CHR(12)
NEXT
FOR leer = 0 TO 6: LPRINT : NEXT: 'CHR(12)
LOCATE 1, 1
COLOR MenufarbeV, MenufarbeH: PRINT STRING(79, 32): COLOR GrundfarbeV, GrundfarbeH
LOCATE clalt, cpalt
END SUB
SUB EDFup
DIM kn AS STRING, ext, tl, zakt, einf, bitz
DIM bytz, klauf, l, p, Kom AS STRING, s, Befaender as STRING , Para as STRING
DIM positioncu,k as STRING,alt as STRING,Ostringhin as STRING ,ostrrueck as STRING,Zaehler as STRING
DIM msx as INTEGER, msy as INTEGER, msb as INTEGER
fupmenu: errbld = 0
IF status > 0 THEN Statusread (status)
transfup Nos: fupmenu
IF LetztesNetzwerk = 1 THEN
zeile = 3: topline = 0: transfup (Nos)
endif
zeigfup1 tl
cursor tl,zakt
edifup:
IF status > 0 THEN Statusread (status): transfup Nos: zeigfup1 tl
kn = INKEY
IF errbld = 1 THEN kn = CHR(27)
if kn="" then
getmouse(msx,msy,,msb)
IF msb=1 then
IF msy>3 and msy<23 and msx<79 then
zakt=msy-4
kn=chr(8)
end if
'IF msy=1 THEN IF topline > 0 THEN topline = topline - 1'oberer Rand
'IF msy=23 THEN IF topline < ElNr - (lz - 4) THEN topline = topline + 1'unterer Rand
'IF msx=10 and msy>1 and msy<23 then topline = (topmax \ 20 )* (msy-2)'Scrollbalken
IF msy=0 THEN 'Menübalken geklickt
IF msx<4 THEN kn=chr(255)+chr(59)
IF msx>4 AND msx<11 THEN kn=chr(255)+chr(60)
IF msx>11 AND msx<18 THEN kn=chr(255)+chr(61)
IF msx>18 AND msx<25 THEN kn=chr(255)+chr(62)
IF msx>25 AND msx<30 THEN kn=chr(255)+chr(63)
IF msx>30 AND msx<35 THEN kn=chr(255)+chr(64)
IF msx>35 AND msx<40 THEN kn=chr(255)+chr(65)
IF msx>40 AND msx<49 THEN kn=chr(255)+chr(66)
IF msx>49 AND msx<54 THEN kn=chr(255)+chr(67)
IF msx>54 AND msx<59 THEN kn=chr(255)+chr(68)
IF msx>59 AND msx<66 THEN kn=chr(255)+chr(133)
IF msx>66 AND msx<74 THEN kn=chr(255)+chr(134)
IF msx>74 AND msx<76 THEN kn="-"'chr(255)+chr(133)
IF msx>76 THEN kn="+"'chr(255)+chr(134)
END IF
sleep 100
endif
if msb=2 and msy=0 then kn=chr(27)
END IF
IF kn > "" THEN Ascii = ASC(kn)
IF LEN(kn) = 2 THEN ' ### scrolling ###
ext = ASC(MID(kn, 2, 1))
IF ext = 104 AND status = 0 THEN Hypertext "SPS.HLP", "FUP"' ALT F1 fr Hilfe
IF ext = 73 AND tl > 0 THEN ' Bild hoch
tl = tl - 10: zakt = zakt - 10
IF tl < 0 THEN tl = 0
END IF
IF ext = 81 AND fmax > 20 THEN ' Bild runter
tl = tl + 10: zakt = zakt + 10
IF tl > 44 THEN tl = 44
IF tl > fmax - 20 THEN tl = fmax - 20
END IF
IF ext = 133 AND status = 0 THEN Uebertrage ' F11 šbtr
IF ext = 134 AND status = 0 THEN prinfup1' F12 Dru
IF ext = 72 THEN zakt = zakt - 1' Pfeil hoch
IF ext = 80 THEN zakt = zakt + 1' Pfeil runter
IF ext = 71 THEN zakt = 0 ' Pos1
IF ext = 79 THEN ' Ende
IF zakt = Letztepos THEN
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 12) = "*** "
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 12) = "= ??????"
zakt = 0: Nos = Nos + 1: transfup Nos
ELSE
zakt = Letztepos
END IF
END IF
IF ext = 59 AND status = 0 THEN ' F1
SELECT CASE MID(Befehlsfeld(zakt + zoffset), 1, 2)
CASE "U ", "UN"
IF sgrenze = 0 THEN
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 12) = "U ??????"
zakt = zakt + 1
ELSE
grenzebld
END IF
CASE "O ", "ON"
IF grenze = 0 THEN
Zeileeinfuegen (zakt + zoffset)
MID(Befehlsfeld(zakt + zoffset), 1, 2) = "O("
MID(Befehlsfeld(zakt + zoffset + 1), 1, 1) = "U"
Zeileeinfuegen (zakt + zoffset + 2)
MID(Befehlsfeld(zakt + zoffset + 2), 1, 12) = "U ??????"
Zeileeinfuegen (zakt + zoffset + 3)
MID(Befehlsfeld(zakt + zoffset + 3), 1, 1) = ")"
zakt = zakt + 1
ELSE
grenzebld
END IF
CASE "= ", "S ", "R ", "L ", "LC", "LK", "T ", "SL", "ZV", "ZR", "RZ", "SZ"
IF grenze = 0 THEN
Zeileeinfuegen (zakt + zoffset)
MID(Befehlsfeld(zakt + zoffset), 1, 12) = "U ??????"
IF zakt = 0 THEN
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 12) = "U ??????"
END IF
ELSE
grenzebld
END IF
CASE "O("
IF sgrenze = 0 THEN
Zeileeinfuegen (zakt + zoffset)
MID(Befehlsfeld(zakt + zoffset), 1, 2) = "O("
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 12) = "U ??????"
Zeileeinfuegen (zakt + zoffset + 2)
MID(Befehlsfeld(zakt + zoffset + 2), 1, 12) = "U ??????"
Zeileeinfuegen (zakt + zoffset + 3)
MID(Befehlsfeld(zakt + zoffset + 3), 1, 1) = ")"
ELSE
grenzebld
END IF
END SELECT
transfup Nos
END IF
IF ext = 60 AND status = 0 THEN ' F2
SELECT CASE MID(Befehlsfeld(zakt + zoffset), 1, 2)
CASE "O ", "ON"
IF sgrenze = 0 THEN
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 12) = "O ??????"
zakt = zakt + 1
ELSE
grenzebld
END IF
CASE "U ", "UN"
IF grenze = 0 THEN
Zeileeinfuegen (zakt + zoffset)
MID(Befehlsfeld(zakt + zoffset), 1, 2) = "U("
MID(Befehlsfeld(zakt + zoffset + 1), 1, 1) = "O"
Zeileeinfuegen (zakt + zoffset + 2)
MID(Befehlsfeld(zakt + zoffset + 2), 1, 12) = "O ??????"
Zeileeinfuegen (zakt + zoffset + 3)
MID(Befehlsfeld(zakt + zoffset + 3), 1, 1) = ")"
zakt = zakt + 1
ELSE
grenzebld
END IF
CASE "= ", "S ", "R ", "L ", "LC", "LK", "T ", "SL", "ZV", "ZR", "RZ", "SZ"
IF grenze = 0 THEN
Zeileeinfuegen (zakt + zoffset)
MID(Befehlsfeld(zakt + zoffset), 1, 12) = "O ??????"
IF zakt = 0 THEN
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 12) = "O ??????"
END IF
ELSE
grenzebld
END IF
CASE "U("
IF sgrenze = 0 THEN
Zeileeinfuegen (zakt + zoffset)
MID(Befehlsfeld(zakt + zoffset), 1, 2) = "U("
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 12) = "O ??????"
Zeileeinfuegen (zakt + zoffset + 2)
MID(Befehlsfeld(zakt + zoffset + 2), 1, 12) = "O ??????"
Zeileeinfuegen (zakt + zoffset + 3)
MID(Befehlsfeld(zakt + zoffset + 3), 1, 1) = ")"
ELSE
grenzebld
END IF
END SELECT
transfup Nos
END IF
IF (ext = 61 OR ext = 82) AND status = 0 THEN ' F3 oder Einfg
IF sgrenze = 0 THEN
SELECT CASE MID(Befehlsfeld(zakt + zoffset), 1, 2)
CASE "O("
Zeileeinfuegen (zakt + zoffset)
MID(Befehlsfeld(zakt + zoffset), 1, 12) = "O ??????"
CASE "O ", "ON"
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 12) = "O ??????"
zakt = zakt + 1
CASE "U("
Zeileeinfuegen (zakt + zoffset)
MID(Befehlsfeld(zakt + zoffset), 1, 12) = "U ??????"
CASE "U ", "UN"
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 12) = "U ??????"
zakt = zakt + 1
CASE "= ", "S ", "R ", "L ", "LC", "LK", "T ", "SL", "SE", "SA", "ZV", "ZR"
Zeileeinfuegen (zakt + zoffset + 1)
MID(Befehlsfeld(zakt + zoffset + 1), 1, 4) = MID(Befehlsfeld(zakt + zoffset), 1, 4)
MID(Befehlsfeld(zakt + zoffset + 1), 7, 6) = "??????"
zakt = zakt + 1
END SELECT
transfup Nos
ELSE
grenzebld
END IF
END IF
IF ext = 61 AND status = 0 THEN
IF sgrenze = 0 THEN
IF MID(Befehlsfeld(zakt + zoffset), 1, 2) = "**" THEN
Zeileeinfuegen (zakt + zoffset)
MID(Befehlsfeld(zakt + zoffset), 1, 12) = "= ??????"
END IF
transfup Nos
ELSE
grenzebld
END IF
END IF
IF ext = 82 AND status = 0 THEN ' Einfg auf Netzwerkende ***
IF MID(Befehlsfeld(zakt + zoffset), 1, 2) = "**" THEN
Zeileeinfuegen (zoffset)
MID(Befehlsfeld(zoffset), 1, 12) = "*** "
Zeileeinfuegen (zoffset)
MID(Befehlsfeld(zoffset), 1, 12) = "= ??????"
zakt = 0
transfup Nos
END IF
END IF
IF ext = 62 AND status = 0 THEN 'F4
SELECT CASE MID(Befehlsfeld(zakt + zoffset), 1, 2)
CASE "ON": MID(Befehlsfeld(zakt + zoffset), 1, 2) = "O "
CASE "UN": MID(Befehlsfeld(zakt + zoffset), 1, 2) = "U "
CASE "O ": MID(Befehlsfeld(zakt + zoffset), 1, 2) = "ON"
CASE "U ": MID(Befehlsfeld(zakt + zoffset), 1, 2) = "UN"
END SELECT
transfup Nos
END IF
IF (ext = 66 OR ext = 101 OR ext = 111) AND status = 0 THEN ' F8 oder STRG F8 oder Alt F8
IF MID(Befehlsfeld(zakt + zoffset), 1, 3) = "***" AND offend > 0 THEN
SELECT CASE ext
CASE 111 'ALT F8 #############
FOR einf = offend TO 0 STEP -1
Zeileeinfuegen (zoffset + zakt + 1)
MID(Befehlsfeld(zoffset + zakt + 1), 1, 6) = MID(Pufferfeld(einf), 1, 6)
MID(Befehlsfeld(zoffset + zakt + 1), 7, 6) = "??????"
NEXT
zakt = 0: Nos = Nos + 1: transfup Nos
CASE 101 'STRG F 8 ##########
FOR einf = offend TO 0 STEP -1
Zeileeinfuegen (zoffset + zakt + 1)
MID(Befehlsfeld(zoffset + zakt + 1), 1, 57) = MID(Pufferfeld(einf), 1, 57)
NEXT
zakt = 0: Nos = Nos + 1: transfup Nos
END SELECT
END IF
IF ext = 66 THEN '############ F 8 ############
offend = Letztepos
FOR einf = 0 TO offend
MID(Pufferfeld(einf), 1, 12) = MID(Befehlsfeld(einf + zoffset), 1, 12)
NEXT
MID(Pufferfeld(offend), 20, 21) = "Kopie von Netzwerk" + Str(Nos + 1)
ELSE
IF zakt > 0 THEN
IF MID(Befehlsfeld(zakt + zoffset), 7, 6) = "??????" AND MID(Befehlsfeld(zakt + zoffset - 1), 11, 1) = "." THEN
Zaehler = MID(Befehlsfeld(zakt + zoffset - 1), 9, 4)
bitz = ASC(RIGHT(Zaehler, 1)) - 48
bytz = VAL(LEFT(Zaehler, 3))
MID(Befehlsfeld(zakt + zoffset), 1, 8) = LEFT(Befehlsfeld(zakt + zoffset - 1), 8)
IF bitz < 7 THEN bitz = bitz + 1 ELSE bitz = 0: bytz = bytz + 1
MID(Befehlsfeld(zakt + zoffset), 10, 1) = Str(bytz)
MID(Befehlsfeld(zakt + zoffset), 11, 1) = "."
MID(Befehlsfeld(zakt + zoffset), 12, 1) = Str(bitz)
zakt = zakt + 1
END IF 'mid
END IF 'zakt
END IF 'ext=66
transfup Nos
END IF 'ext=66 or 101 or...
IF ext = 83 AND status = 0 THEN 'Entf
SELECT CASE MID(Befehlsfeld(zakt + zoffset), 1, 2)
CASE "U(", "O("
fragebox " Komplette Klammer l”schen ? J/N ", k
IF LCASE(k) = "j" THEN
klauf = 0
DO
IF MID(Befehlsfeld(zakt + zoffset), 1, 1) = ")" THEN klauf = klauf - 1
IF MID(Befehlsfeld(zakt + zoffset), 2, 2) = "( " THEN klauf = klauf + 1
Zeileloeschen zakt + zoffset
LOOP UNTIL klauf = 0 OR MID(Befehlsfeld(zakt + zoffset), 1, 3) = "***"
END IF
CASE "! ", "> ", "< ", "+ ", "- "
IF zakt + zoffset > 2 THEN
Zeileloeschen zakt + zoffset - 2
Zeileloeschen zakt + zoffset - 1
END IF
Zeileloeschen zakt + zoffset
CASE "U ", "UN", "O ", "ON", "= ", "S ", "R ", "L ", "LC", "T ", "SL", "ZV", "ZR", "UB", "NO"
IF MID(Befehlsfeld(zakt + zoffset + 1), 1, 1) = "*" THEN
fragebox " Letzten Ausgang l”schen ? J/N ", k
ELSE
k = "j" 'ansonsten l”schen
END IF
IF MID(Befehlsfeld(zakt + zoffset + 1), 1, 1) = ")" THEN
IF MID(Befehlsfeld(zakt + zoffset - 1), 2, 1) = "(" THEN
Zeileloeschen zakt + zoffset + 1
Zeileloeschen zakt + zoffset - 1: zakt = zakt - 1
END IF
END IF
IF LCASE(k) = "j" THEN Zeileloeschen zakt + zoffset
CASE "SA", "SE"
IF MID(Befehlsfeld(zakt + zoffset + 1), 1, 1) = "*" THEN
fragebox " Letzten Ausgang l”schen ? J/N ", k
ELSE
k = "j" 'ansonsten l”schen
END IF
IF LCASE(k) = "j" THEN
IF zakt + zoffset > 1 THEN
IF MID(Befehlsfeld(zakt + zoffset - 1), 1, 3) = "L K" THEN
Zeileloeschen zakt + zoffset - 1: zakt = zakt - 1
END IF
END IF
Zeileloeschen zakt + zoffset
END IF
CASE "**"
fragebox " Netzwerk l”schen ? J/N ", k
IF LCASE(k) = "j" THEN
FOR zl = 0 TO zakt
Zeileloeschen zoffset + 0 '+0 weil sonst zoffset sich „ndert
NEXT
IF Nos > 0 THEN Nos = Nos - 1
END IF
fupmenu
END SELECT
transfup Nos
END IF
IF ext = 75 AND status = 0 THEN 'Pfeil links
SELECT CASE MID(Befehlsfeld(zakt + zoffset), 1, 2)
CASE " ", "NO", "= ", "S ", "R ", "L ", "LC", "LK", "T ", "SL", "SE", "SA", "ZV", "ZR", "RZ", "SZ", "+ "
LOCATE l - tl, p - 6: PRINT " "; : LOCATE l - tl, p - 6
Befaender = ""
Para = "0000100005"
MID(Para, 3 - LEN(Str(l - tl)), LEN(Str(l - tl))) = Str(l - tl)
MID(Para, 6 - LEN(Str(p - 6)), LEN(Str(p - 6))) = Str(p - 6)
SInput Para, Befaender, s
Befaender = UCASE(Befaender)
IF LEFT(Befaender, 2) = "SE" THEN Befaender = "SET"
IF LEFT(Befaender, 2) = "SA" THEN Befaender = "SAT"
Format Befaender, Befaender
IF Befaender > "" THEN
MID(Befehlsfeld(zakt + zoffset), 1, 5) = " "
MID(Befehlsfeld(zakt + zoffset), 1, 5) = Befaender
END IF
END SELECT
transfup Nos
END IF
zeigfup1 tl: cursor tl,zakt
ELSE ' ansonsten ,wenn also len(kn) < 2
SELECT CASE kn
CASE "+"
Nos = Nos + 1: transfup Nos': tl = 0: zakt = 0: cursor tl,zakt
IF LetztesNetzwerk = 1 THEN transfup Nos
tl = 0: zakt = 0: cursor tl,zakt
CASE "-"
IF Nos > 0 THEN
Nos = Nos - 1: transfup Nos: tl = 0: zakt = 0: cursor tl,zakt
ELSE
nachricht "Kein Vorg„nger-Netzwerk!": fupmenu
end if
CASE CHR(27), CHR(8), CHR(9)
CASE ELSE
IF status = 0 THEN
IF kn > "" THEN
cursor tl,zakt
positioncu = POS(0): PRINT SPACE(6); : LOCATE , positioncu
IF kn = CHR(13) THEN
Kom = MID(Befehlsfeld(Letztepos + zoffset), 20, 38)
SInput "0320100038", Kom, s
MID(Befehlsfeld(Letztepos + zoffset), 20, 38) = Kom
END IF
WHILE kn <> CHR(13) AND POS(0) < positioncu + 6
IF LEN(kn) < 2 THEN
SELECT CASE kn
CASE "", CHR(9), CHR(13), CHR(34), CHR(27)
CASE CHR(8)
IF POS(0) > positioncu THEN LOCATE , POS(0) - 1: PRINT "?"; : LOCATE , POS(0) - 1
CASE ELSE
PRINT kn;
END SELECT
END IF
kn = INKEY
WEND
alt = MID(Befehlsfeld(zoffset + zakt), 7, 2)
Ostringhin = ""
FOR xlesepos = positioncu TO positioncu + 6
Ostringhin = Ostringhin + CHR(SCREEN(CSRLIN, xlesepos))
NEXT
Operantenformat Ostringhin, Ostrrueck, alt
IF Entfspace(Ostrrueck, LEN(Ostrrueck)) > "" THEN
MID(Befehlsfeld(zoffset + zakt), 7, 6) = Ostrrueck
zaktalt = zakt
DO UNTIL MID(Befehlsfeld(zoffset + zakt), 7, 1) = "?" OR zakt >= Letztepos
zakt = zakt + 1
LOOP
IF zakt >= Letztepos THEN zakt = zaktalt
END IF 'entfspace....
transfup Nos: zeigfup1 tl: cursor tl,zakt
END IF 'kn>13...
END IF 'status = 0
END SELECT
END IF '(else)if kn>2
IF Ascii <> 27 THEN GOTO edifup
LOCATE , , 0
'end if
END SUB
sub zeigfup1(tl as INTEGER)
dim ze as INTEGER
IF tl > 44 THEN tl = 44
LOCATE 3, 2: PRINT "Netzwerk " + Str(Nos + 1); " "
FOR ze = 1 TO (lz - 4)
LOCATE 3 + ze, 2, 0: PRINT MID(fupf(ze + tl), spmin, 78);
NEXT
end sub
sub grenzebld()
IF sgrenze = 1 THEN nachricht "Bildgrenze unten erreicht !!"
IF sgrenze = 0 THEN nachricht "Bildgrenze erreicht !!"
fupmenu
end sub
sub cursor (tl as INTEGER,zakt as INTEGER)
dim l as INTEGER,p as INTEGER,x as INTEGER
IF zakt < 0 THEN zakt = 0
IF zakt > Letztepos THEN zakt = Letztepos
l = cufeld(zakt).culin + 4
p = cufeld(zakt).cupos + 2 - spmin
IF l < 2 THEN l = 2
IF p < 1 THEN p = 2
WHILE l - tl < 4
IF tl > 9 THEN tl = tl - 10 ELSE tl = 0
WEND
WHILE l - tl > (lz - 4)
tl = tl + 10
WEND
zeigfup1 tl
LOCATE 3, 20: PRINT MID(Befehlsfeld(Letztepos + zoffset), 20, 38)'; MID(Befehlsfeld(zoffset), 20, 39)
COLOR NachrichtfarbeV, GrundfarbeH: LOCATE l - tl, p, 1', 6, 8
FOR x = 0 TO 5
PRINT CHR(SCREEN(l - tl, p + x)); 'aktuelle Position hervorheben
NEXT
COLOR GrundfarbeV, GrundfarbeH: LOCATE l - tl, p, 1', 6, 8
end sub
sub prinfup1 ()
dim cpalt as INTEGER,clalt as INTEGER,H as STRING,vonN as INTEGER,bisN as INTEGER,Hz as INTEGER,BlattNr as INTEGER
dim BlattNralt as INTEGER,zeileanz as INTEGER,Net as INTEGER,dfup as INTEGER
cpalt = POS(0): clalt = CSRLIN:
LOCATE 1, 1: COLOR MenufarbeV, MenufarbeH
PRINT SPACE(79): LOCATE 1, 30
INPUT ; "Von Netzwerk:", H: vonN = VAL(H)
LOCATE 1, 52
INPUT ; " Bis Netzwerk:", H: bisN = VAL(H)
LOCATE 1, 70
INPUT ; " Dru:", H: Hz = VAL(H)
BlattNr = 1: BlattNralt = 0
'IF (Hz AND 1) = 1 THEN LPRINT CHR(27) + CHR(120) + CHR(1); ELSE LPRINT CHR(27) + CHR(120) + CHR(0);
'IF (Hz AND 2) = 2 THEN LPRINT CHR(27); CHR(69); CHR(27); CHR(71); ELSE LPRINT CHR(27); CHR(70); CHR(27); CHR(72);
'IF (Hz AND 4) = 4 THEN LPRINT CHR(15); ELSE LPRINT CHR(18);
IF (Hz AND 8) = 8 THEN mitKommentar = 1 ELSE mitKommentar = 0
IF vonN = 0 THEN vonN = 1
zeilenanz = 0
FOR Net = vonN TO bisN
transfup Net - 1
IF LetztesNetzwerk = 1 THEN EXIT FOR
MID(fupf(0), spmin, 60) = "Netzwerk " + Str(Net) + " " + MID(Befehlsfeld(Letztepos + zoffset), 20, 38)
zeilenanz = zeilenanz + fmax + 2
IF zeilenanz > 60 THEN LPRINT CHR(12): zeilenanz = 0: BlattNr = BlattNr + 1
IF BlattNr > BlattNralt THEN MID(fupf(0), spmin + 64, 14) = "Blatt Nr.: " + Str(BlattNr): BlattNralt = BlattNr
FOR dfup = 0 TO fmax
LPRINT MID(fupf(dfup), spmin, 78)
NEXT dfup
NEXT Net
LOCATE 1, 30
COLOR MenufarbeV, MenufarbeH: PRINT STRING(49, 32): COLOR GrundfarbeV, GrundfarbeH
LOCATE clalt, cpalt
fupmenu
LPRINT CHR(12)
end sub
SUB Editiere
DIM Ascii as INTEGER, topline2 as INTEGER, zeile2 as INTEGER, Taste AS STRING, buflag as INTEGER, bupos as INTEGER, buasc as INTEGER, ext, bitz, bytz
DIM Eingef as INTEGER, cposition as INTEGER, k AS STRING, lin as INTEGER, erolin as INTEGER, ero as INTEGER, ausgabe AS STRING
DIM Zaehler as STRING ,msx as integer,msy as integer,msb as integer
awlmenu
Ascii = 0: zeile = 3: LOCATE zeile, 14
If zmax>1 then incodesetzen(ero,erolin)
hexanzeige
Edistart:
topline2 = topline: zeile2 = zeile
if topline > topmax then topmax = topline
Taste = INKEY
if Taste="" then
getmouse(msx,msy,,msb)
IF msb=1 then
IF msy>1 and msy<23 and (msx>12 and msx<32 or msx>38 and msx<77) then
locate msy+1,msx+1:zeile=msy+1 'innerhalb des editorfensters geklickt
end if
IF msy=1 THEN IF topline > 0 THEN topline = topline - 1'oberer Rand
IF msy=23 THEN IF topline < ElNr - (lz - 4) THEN topline = topline + 1'unterer Rand
IF msx=10 and msy>1 and msy<23 then topline = (topmax \ 20 )* (msy-2)'Scrollbalken
IF msy=0 THEN 'Menübalken geklickt
IF msx<5 THEN Taste=chr(255)+chr(59)
IF msx>5 AND msx<11 THEN Taste=chr(255)+chr(60)
IF msx>11 AND msx<17 THEN Taste=chr(255)+chr(61)
IF msx>17 AND msx<23 THEN Taste=chr(255)+chr(62)
IF msx>23 AND msx<26 THEN Taste=chr(255)+chr(63)
IF msx>26 AND msx<29 THEN Taste=chr(255)+chr(64)
IF msx>29 AND msx<37 THEN Taste=chr(255)+chr(65)
IF msx>37 AND msx<45 THEN Taste=chr(255)+chr(66)
IF msx>45 AND msx<51 THEN Taste=chr(255)+chr(67)
IF msx>51 AND msx<62 THEN Taste=chr(255)+chr(68)
IF msx>62 AND msx<71 THEN Taste=chr(255)+chr(133)
IF msx>71 THEN Taste=chr(255)+chr(134)
END IF
sleep 100
endif
IF msb=2 and msy=0 then Taste=chr(27)
END IF
IF Taste > "" THEN 'wenn also Taste >"" dann...
buflag = 0
FOR bupos = 14 TO 32
buasc = SCREEN(zeile, bupos)
IF buasc > 0 AND buasc <> 32 THEN buflag = 1
NEXT
Ascii = ASC(Taste)
IF LEN(Taste) = 2 THEN ' ### scrolling ###
ext = ASC(MID(Taste, 2, 1))
IF ext = 104 THEN Hypertext "sps.hlp", "AWL"
IF ext = 59 THEN topline = markeL(1): zeile = markeZ(1) + 3
IF ext = 60 THEN topline = markeL(2): zeile = markeZ(2) + 3
IF ext = 61 THEN topline = markeL(3): zeile = markeZ(3) + 3
IF ext = 62 THEN topline = markeL(4): zeile = markeZ(4) + 3
IF ext = 64 THEN Statustoggle (1): hexanzeige
IF ext = 109 THEN Statustoggle (2): hexanzeige
IF ext = 65 THEN
IF Pufferbeginn = 0 OR Pufferende > 0 THEN
Pufferbeginn = topline + zeile - 2
Pufferende = 0: Puffergroesse = 0
ELSE
Pufferende = topline + zeile - 2
Puffergroesse = Pufferende - Pufferbeginn + 1
IF Pufferende < Pufferbeginn THEN clrpuffer
END IF
hexanzeige
END IF
IF (ext = 100 OR ext = 110) AND status = 0 THEN
clrpuffer
hexanzeige
END IF
IF (ext = 111) AND (Puffergroesse > 0) AND status = 0 THEN 'ALT F8 #############
FOR einf = Puffergroesse - 1 TO 0 STEP -1
Zeileeinfuegen (topline + zeile - 3)
MID(Befehlsfeld(topline + zeile - 3), 1, 57) = MID(Pufferfeld(einf), 1, 57)
MID(Befehlsfeld(topline + zeile - 3), 7, 6) = "??????"
NEXT
hexanzeige
END IF
IF (ext = 101) AND (Puffergroesse > 0) AND status = 0 THEN 'STRG F8 #############
FOR einf = Puffergroesse - 1 TO 0 STEP -1
Zeileeinfuegen (topline + zeile - 3)
MID(Befehlsfeld(topline + zeile - 3), 1, 57) = MID(Pufferfeld(einf), 1, 57)
NEXT
hexanzeige
END IF
IF (ext = 66 OR ext = 101) AND ((topline + zeile) > 3) AND status = 0 THEN
IF (RTRIM(MID(Befehlsfeld(topline + zeile - 4), 1, 15)) > "") AND (RTRIM(MID(Befehlsfeld(topline + zeile - 3), 1, 15)) = "") AND (Puffergroesse = 0) THEN
IF ext = 66 THEN
LOCATE zeile, 14: PRINT LEFT(Befehlsfeld(topline + zeile - 4), 8);
ELSE
IF MID(Befehlsfeld(zeile + topline - 4), 11, 1) = "." THEN
Zaehler = MID(Befehlsfeld(zeile + topline - 4), 9, 4)
bitz = (ASC(RIGHT(Zaehler, 1)) - 48)
bytz = VAL(" " + LEFT(Zaehler, 3))
LOCATE zeile, 14: PRINT LEFT(Befehlsfeld(topline + zeile - 4), 8);
IF bitz < 7 THEN bitz = bitz + 1 ELSE bitz = 0: bytz = bytz + 1
PRINT bytz; "."; bitz; : LOCATE zeile, 33
ELSE
'kein Punkt !!!!
END IF
END IF
END IF
IF ext = 66 AND (Puffergroesse > 0) AND status = 0 THEN
FOR einf = 0 TO Puffergroesse - 1
MID(Pufferfeld(einf), 1, 57) = MID(Befehlsfeld(einf + Pufferbeginn - 1), 1, 57)
NEXT
END IF
END IF
IF ext = 94 THEN markeL(1) = topline: markeZ(1) = zeile - 3
IF ext = 95 THEN markeL(2) = topline: markeZ(2) = zeile - 3
IF ext = 96 THEN markeL(3) = topline: markeZ(3) = zeile - 3
IF ext = 97 THEN markeL(4) = topline: markeZ(4) = zeile - 3
IF ext = 67 AND status = 0 THEN Suche topline, zeile, 0: awlmenu
IF ext = 68 AND status = 0 THEN Suche topline, zeile, 1: awlmenu
IF ext = 73 THEN IF topline > lz - 5 THEN topline = topline - (lz - 4) ELSE topline = 0
IF ext = 81 THEN IF topline < ElNr - (2 * (lz - 4)) THEN topline = topline + (lz - 4) ELSE topline = ElNr - (lz - 4)
IF ext = 71 AND zeile = 3 AND (POS(0) = 14 OR POS(0) = 40) THEN topline = 0
IF ext = 79 AND zeile = (lz - 1) AND (POS(0) = 32 OR POS(0) = 77) THEN IF zmax < ElNr - (lz - 4) THEN topline = zmax - (lz - 2) ELSE topline = ElNr - (lz - 4)
IF topline < 0 THEN topline = 0 'verhindert negativen topline-Wert
IF ext = 72 AND zeile = 3 THEN IF topline > 0 THEN topline = topline - 1
IF ext = 80 AND zeile = (lz - 1) THEN IF topline < ElNr - (lz - 4) THEN topline = topline + 1
' ### ende scrolling ### cursor ###
IF ext = 72 AND zeile > 3 THEN zeile = zeile - 1: LOCATE zeile, POS(0)
IF ext = 80 AND zeile < (lz - 1) THEN zeile = zeile + 1: LOCATE zeile, POS(0)
IF ext = 71 AND (POS(0) = 14 OR POS(0) = 40) THEN zeile = 3: LOCATE zeile, POS(0)
IF ext = 79 AND (POS(0) = 32 OR POS(0) = 77) THEN zeile = (lz - 1): LOCATE zeile, POS(0)
IF ext = 75 THEN IF POS(0) = 40 THEN LOCATE zeile, 32 ELSE IF POS(0) > 14 THEN LOCATE zeile, POS(0) - 1
IF ext = 77 THEN IF POS(0) = 32 THEN LOCATE zeile, 40 ELSE LOCATE zeile, POS(0) + 1
IF ext = 71 THEN IF POS(0) > 33 THEN LOCATE zeile, 40 ELSE LOCATE zeile, 14
IF ext = 79 THEN IF POS(0) < 40 THEN LOCATE zeile, 32 ELSE LOCATE zeile, 77
IF ext = 83 AND POS(0) <> 33 AND POS(0) < 78 AND status = 0 THEN PRINT CHR(0); : LOCATE zeile, POS(0) - 1: shiften zeile, 0
IF (ext = 82) AND status = 0 THEN
Zeileeinfuegen (zeile + topline - 3)
LOCATE zeile, 14
hexanzeige
END IF
IF (ext = 83) AND status = 0 THEN
IF Puffergroesse = 0 THEN
IF ((buflag = 0 AND POS(0) < 34) OR POS(0) = 32) AND ((zmax - topline + 2) >= zeile) THEN Zeileloeschen (zeile + topline - 3): hexanzeige
ELSE
FOR entf = Pufferbeginn TO Pufferende
Zeileloeschen Pufferbeginn + topline - 1
NEXT
clrpuffer
hexanzeige
END IF
END IF
IF (ext = 133) AND status = 0 THEN Uebertrage
IF (ext = 134) AND status = 0 THEN drucken: awlmenu
ELSE
IF status = 0 THEN
SELECT CASE Taste
CASE CHR(13)
IF POS(0) < 33 THEN LOCATE zeile, 33 ELSE LOCATE zeile, 78
CASE CHR(8)
IF POS(0) > 14 AND POS(0) <> 40 THEN
LOCATE zeile, POS(0) - 1: PRINT CHR(0); : LOCATE zeile, POS(0) - 1
shiften zeile, 0
END IF
CASE CHR(9)
IF POS(0) < 40 THEN LOCATE zeile, 40 ELSE LOCATE zeile, 14
CASE CHR(34)
shiften zeile, 1: PRINT "'";
CASE ELSE
IF Taste > CHR(0) AND Taste <> CHR(27) THEN shiften zeile, 1: PRINT Taste;
END SELECT
END IF
END IF
END IF
IF POS(0) = 33 OR POS(0) = 78 THEN
IF topline < ElNr - (lz - 4) AND zeile > (lz - 2) THEN topline = topline + 1
IF zeile < (lz - 1) THEN zeile = zeile + 1
IF POS(0) = 33 THEN
LOCATE zeile, 14
IF ASC(LEFT(Befehlsfeld(zeile + topline - 3), 1)) > 0 AND ASC(LEFT(Befehlsfeld(zeile + topline - 3), 1)) <> 32 THEN Zeileeinfuegen (zeile + topline - 3): Eingef = 1
ELSE
LOCATE zeile, 40
END IF
END IF
IF POS(0) = 13 THEN
IF topline > 0 AND zeile < 4 THEN topline = topline - 1
IF zeile > 3 THEN zeile = zeile - 1
LOCATE zeile, 32
ELSE
IF status > 0 THEN Statusread (status): hexanzeige'
END IF
'speicher = FRE("")' ### ende cursor ###
IF zeile > (zmax - topline + 3) THEN zmax = zeile + topline - 3
IF (zeile2 <> zeile OR topline2 <> topline) AND status = 0 THEN Uebernehme zeile2, topline2
IF topline2 <> topline OR Eingef = 1 THEN hexanzeige: Eingef = 0
IF Ascii <> 27 THEN GOTO Edistart
LOCATE zeile, POS(0), 0
IF status > 0 THEN GOTO Schluss2 ELSE GOTO Schluss
'
Schluss:
Ascii = 0
InCodeSetzen ero,erolin ' ##### Text wird assembliert #####
IF ero = 1 THEN
nachricht "letzter Fehler in Zeile: " + Str(erolin)
fragebox "Fehler korrigieren? J/N ", k
IF LCASE(k) <> "n" THEN
awlmenu
zeile = erolin + 3
LOCATE zeile, 14
hexanzeige
GOTO Edistart
END IF
END IF
Schluss2:
Ascii = 0
END SUB 'editiere
sub clrPuffer()
Pufferbeginn = 0: Pufferende = 0: Puffergroesse = 0
end sub
sub hexanzeige() ' ####### Anzeige des geamten Fensters #######
dim cposition as integer,lin as integer, ausgabe as STRING
dim vscroll as integer
cposition = POS(0)
LOCATE , , 0
FOR lin = 3 TO (lz - 1)
IF lin >= (Pufferbeginn - topline + 2) AND lin <= (Pufferende - topline + 2) THEN COLOR GrundfarbeH, GrundfarbeV ELSE COLOR GrundfarbeV, GrundfarbeH
LOCATE lin, 3: REM rechtsbndig anzeigen
PRINT STRING(6 - LEN(Str(lin + topline - 3)), 32); Str(lin + topline - 3)
IF status > 0 THEN
ausgabe = MID(assfeld(lin + topline - 3), 1, 19)
ausgabe = ausgabe + MID(Befehlsfeld(lin + topline - 3), 20, 19)
SELECT CASE MID(assfeld(lin + topline - 3), 3, 1)
CASE "H"
COLOR 10, GrundfarbeH
CASE "L"
COLOR 4, GrundfarbeH
CASE ELSE
COLOR GrundfarbeV, GrundfarbeH
END SELECT
ELSE
'ausgabe= str(StringPosAdr(lin+topline-3))+" " 'aktuelle Adresse
ausgabe = MID(Befehlsfeld(lin + topline - 3), 20, 39)'orginalKommentar
'ausgabe = ausgabe + MID(assfeld(lin+topline-3),1,19) 'übersetzungscode
'ausgabe = ausgabe+ str(feld(lin+topline-3))'feldwerte(nicht zugeordnet)
END IF 'Kommentar evtl mit Status darstellen
LOCATE lin, 11: PRINT " ";
LOCATE lin, 40: PRINT SPC(38);
LOCATE lin, 40: PRINT ausgabe;
'Befehl darstellen
ausgabe = LEFT(Befehlsfeld(lin + topline - 3), 19)
LOCATE lin, 14
IF ausgabe = "" THEN PRINT SPC(19); ELSE PRINT ausgabe;
COLOR GrundfarbeV, GrundfarbeH
NEXT
if topmax<1 then topmax=1
vscroll=(20*(topline/topmax))+ 3
if vscroll<3 then vscroll=3
if vscroll>23 then vscroll=23
locate vscroll,11:Print">";
LOCATE zeile, cposition, 1', 6, 8
end sub
SUB eingang (z as INTEGER, sp as INTEGER, zf as INTEGER)
DIM eintr(32) AS STRING, neg(32) AS STRING, balt AS STRING, b AS STRING, O AS STRING, in AS STRING
banz = 0: ersterkasten = 1: z = z + 1
b = RTRIM(MID(Befehlsfeld(z), 1, 6)): balt = b
DO
b = RTRIM(MID(Befehlsfeld(z), 1, 6))
O = MID(Befehlsfeld(z), 7, 2) + MID(Befehlsfeld(z), 9, 4)
IF MID(b, 2, 1) = "(" THEN ' +++++ Klammer auf +++++
DO
cufeld(z - zoffset).culin = zf + banz: cufeld(z - zoffset).cupos = sp - 6
banz = banz + 1: neg(banz) = "¿ ³": eintr(banz) = ""
zalt = z
eingang z, sp - 6, zf + banz
DO UNTIL zalt >= z - 3
banz = banz + 1: neg(banz) = "³ ³": eintr(banz) = ""
zalt = zalt + 1
LOOP
banz = banz + 1:
neg(banz) = statusselect(z - 2)
eintr(banz) = "":
banz = banz + 1: neg(banz) = "Ù ³": eintr(banz) = ""
b = RTRIM(MID(Befehlsfeld(z), 1, 6))
O = MID(Befehlsfeld(z), 7, 2) + MID(Befehlsfeld(z), 9, 4)
LOOP UNTIL MID(b, 2, 1) <> "("
END IF
z = z + 1
banz = banz + 1
IF status > 0 THEN
SELECT CASE MID(assfeld(z - 1), 2, 2)
CASE "HH"
IF MID(b, 2, 1) = "N" THEN neg(banz) = "=o´" ELSE neg(banz) = "==´"
CASE "HL"
IF MID(b, 2, 1) = "N" THEN neg(banz) = "=o\" ELSE neg(banz) = "==\"
CASE "LH"
IF MID(b, 2, 1) = "N" THEN neg(banz) = "-o´" ELSE neg(banz) = "--´"
CASE "LL"
IF MID(b, 2, 1) = "N" THEN neg(banz) = "-o\" ELSE neg(banz) = "--\"
CASE ELSE
IF MID(b, 2, 1) = "N" THEN neg(banz) = "-o+" ELSE neg(banz) = "--+"
END SELECT
ELSE
IF MID(b, 2, 1) = "N" THEN neg(banz) = "Äo´" ELSE neg(banz) = "ÄÄ´"
END IF
eintr(banz) = O: cufeld(z - zoffset - 1).culin = zf - 1 + banz: cufeld(z - zoffset - 1).cupos = sp
LOOP UNTIL LEFT(b, 1) <> LEFT(balt, 1)
SELECT CASE balt
CASE "U(": in = " & "
CASE "U": in = " & "
CASE "O(": in = ">=1"
CASE "O": in = ">=1"
CASE "UN": in = " & "
CASE "ON": in = ">=1"
END SELECT
balt = b:
IF balt <> "***" THEN VKKasten sp, zf, eintr(), neg() , banz - 1, in, z
sp = sp + 6: zf = zf + banz - 2
IF zf > 59 THEN errbld = 1
END SUB
FUNCTION Entfspace (strg as STRING, laeng as INTEGER) as STRING
DIM Bsh AS STRING, bsh1 AS STRING, Bsr AS STRING, spos as INTEGER, Buchstabe AS STRING
Bsh = LTRIM(strg): bsh1 = "": Bsr = ""
Bsh = Bsh + SPACE(laeng + 1)
FOR spos = 1 TO laeng
Buchstabe = MID(Bsh, spos, 1)
IF Buchstabe > CHR(0) AND Buchstabe <> CHR(32) THEN bsh1 = bsh1 + Buchstabe
NEXT
Entfspace = bsh1
END FUNCTION
SUB files (filespec as STRING)
DIM filename AS STRING,attrib as integer
attrib = 16
if filespec = "" then filespec = "*.*"
filename = dir("*",attrib)
COLOR MenufeldfarbeV, MenufeldfarbeH
Print " Unter-Ordner:"
COLOR GrundfarbeV, GrundfarbeH
DO
PRINT filename,
filename = dir("",attrib)
LOOP WHILE filename <> ""
print
COLOR MenufeldfarbeV, MenufeldfarbeH
print" Dateien:"
COLOR GrundfarbeV, GrundfarbeH
filename = dir(filespec)
DO
PRINT filename,
filename = dir("")
LOOP WHILE filename <> ""
END SUB
SUB filebox (pfad as STRING, pf as STRING, ok as integer, endung as string) STATIC
DIM schell as INTEGER, Datei AS STRING, pfad3 AS STRING
clrs
filestart:
ok = 0: schell = 0
Datei = "": COLOR MenufeldfarbeV, MenufeldfarbeH
LOCATE 5, 3: PRINT "Aktueller Pfad:";
LOCATE 5, 20: COLOR GrundfarbeV, GrundfarbeH : print pfad
ON ERROR GOTO file: files(endung): ON ERROR GOTO Dateifehler
pfad2 = UCASE(pfad): pfad3 = "": LOCATE 3, 3: PRINT SPC(50); : COLOR NachrichtfarbeV, GrundfarbeH
LOCATE 3, 3: INPUT "Datei: ", pfad3: pfad3 = UCASE(pfad3)
IF pfad3 = "" THEN EXIT SUB
PRINT
IF LEFT(pfad3, 3) = "CD " then
chdir right(pfad3,len(pfad3)-3)
pfad = curdir
schell = 1
END IF
if LEFT(pfad3, 4) = "CD.." then
'SHELL pfad3: schell = 1
chdir ".."
pfad = curdir
schell=1
end if
if MID(pfad3, 2, 1) = ":" THEN
chdir pfad3
pfad = curdir
endif
IF schell = 1 THEN clrs: GOTO filestart ELSE IF pfad2 <> ".." THEN pfadsetup (pfad2)
LOCATE 4, 1: PRINT SPC(40); : COLOR NachrichtfarbeV, GrundfarbeH
Datei = pfad3' LOCATE 4, 3: INPUT "Bitte Datei angeben: ", Datei
IF Datei > "" THEN
pf = UCASE(Datei)
ok = 1
END IF
COLOR GrundfarbeV, GrundfarbeH
clrs
END SUB
SUB Format (Bstrhin as STRING, Bstrrueck as STRING)
DIM Bsh AS STRING, bsh1 AS STRING, Bsr AS STRING, spos, Buchstabe AS STRING
Bsh = LTRIM(Bstrhin): bsh1 = "": Bsr = ""
FOR spos = 1 TO 19
Buchstabe = MID(Bsh, spos, 1)
IF Buchstabe > CHR(0) AND Buchstabe <> CHR(32) THEN bsh1 = bsh1 + Buchstabe
NEXT
'IF RIGHT(bsh1,1)=":" THEN Bsr=bsh1+ SPACE(19 - LEN(bsh1)):goto e
bsh1 = bsh1 + SPACE(19 - LEN(bsh1))
'+++++++++++++++++ Abfrage ++++++++++++++++++++++++
IF LEFT(bsh1, 3) = "NOP" THEN Bsr = "NOP 0"
IF LEFT(bsh1, 4) = "NOPS" THEN Bsr = "NOPS0"
IF LEFT(bsh1, 4) = "NOPE" THEN Bsr = "NOPE0"
IF LEFT(bsh1, 4) = "U( " THEN Bsr = "U("
IF LEFT(bsh1, 4) = "O( " THEN Bsr = "O("
IF LEFT(bsh1, 4) = ") " THEN Bsr = ")"
IF LEFT(bsh1, 4) = "UBD0" THEN Bsr = "UBD0"
IF LEFT(bsh1, 4) = "UBD1" THEN Bsr = "UBD1"
IF LEFT(bsh1, 4) = "BE " THEN Bsr = "BE"
IF LEFT(bsh1, 4) = "BEU " THEN Bsr = "BEU"
IF LEFT(bsh1, 4) = "PE " THEN Bsr = "PE"
'IF LEFT(bsh1, 3) = "SPB" THEN Bsr = "SPB " + MID(bsh1,4,14)
IF LEFT(bsh1, 4) = "UN) " THEN Bsr = "BLD res"
IF LEFT(bsh1, 4) = "ON) " THEN Bsr = "BLD res"
IF LEFT(bsh1, 4) = "=F " OR LEFT(bsh1, 4) = "0F " OR LEFT(bsh1, 4) = "!=F " THEN Bsr = "!=F"
IF LEFT(bsh1, 4) = "<F " THEN Bsr = "< F"
IF LEFT(bsh1, 4) = ">F " THEN Bsr = "> F"
IF LEFT(bsh1, 4) = "+F " THEN Bsr = "+ F"
IF LEFT(bsh1, 4) = "-F " THEN Bsr = "- F"
IF LEFT(bsh1, 4) = "*F " THEN Bsr = "* F"
IF LEFT(bsh1, 4) = "/F " THEN Bsr = "/ F"
IF LEFT(bsh1, 4) = "INV " THEN Bsr = "INV"
IF LEFT(bsh1, 4) = "UF " THEN Bsr = "U F"
IF LEFT(bsh1, 4) = "OF " THEN Bsr = "O F"
IF LEFT(bsh1, 4) = "XOF " THEN Bsr = "XOF"
IF LEFT(bsh1, 4) = "BLD " THEN Bsr = "BLD"
IF LEFT(bsh1, 4) = "BLDS" THEN Bsr = "BLDS"
IF LEFT(bsh1, 4) = "BLDE" THEN Bsr = "BLDE"
SELECT CASE LEFT(bsh1, 4)
CASE "* ", "** ", "*** ", "+ ", "++ ", "+++ "
Bsr = "***"
CASE "*S ", "**S ", "***S", "+S ", "++S ", "+++S"
Bsr = "***S"
CASE "*E ", "**E ", "***E", "+E ", "++E ", "+++E"
Bsr = "***E"
END SELECT
IF LEFT (bsh1, 5) ="ZEIT=" THEN Bsr = "ZEIT= "+ Zeitformat(MID(bsh1,6,10))
IF LEFT(bsh1, 3) = "SZP" THEN Bsr = "SZP " + RTRIM(MID(bsh1,4,14))
IF LEFT(bsh1, 3) = "SET" THEN Bsr = "SE T" + SPACE(4 - LEN(RTRIM(MID(bsh1, 4, 3)))) + RTRIM(MID(bsh1, 4, 3))
IF LEFT(bsh1, 3) = "SAT" THEN Bsr = "SA T" + SPACE(4 - LEN(RTRIM(MID(bsh1, 4, 3)))) + RTRIM(MID(bsh1, 4, 3))
IF LEFT(bsh1, 3) = "ZVZ" THEN Bsr = "ZV Z" + SPACE(4 - LEN(RTRIM(MID(bsh1, 4, 3)))) + RTRIM(MID(bsh1, 4, 3))
IF LEFT(bsh1, 3) = "ZRZ" THEN Bsr = "ZR Z" + SPACE(4 - LEN(RTRIM(MID(bsh1, 4, 3)))) + RTRIM(MID(bsh1, 4, 3))
IF LEFT(bsh1, 3) = "LKF" THEN Bsr = "L KF " + SPACE(4 - LEN(RTRIM(MID(bsh1, 4, 3)))) + RTRIM(MID(bsh1, 4, 3))
IF LEFT(bsh1, 3) = "LKT" THEN Bsr = "L KT " + SPACE(6 - LEN(RTRIM(MID(bsh1, 4, 5)))) + RTRIM(MID(bsh1, 4, 5))
IF LEFT(bsh1, 3) = "SSS" THEN Bsr = "SSS " + MID(bsh1, 4, 2) + SPACE(4 - LEN(RTRIM(MID(bsh1, 6, 3)))) + RTRIM(MID(bsh1, 6, 3))
IF LEFT(bsh1, 3) = "UHR" THEN Bsr = "UHR " + MID(bsh1, 4, 2) + SPACE(4 - LEN(RTRIM(MID(bsh1, 6, 3)))) + RTRIM(MID(bsh1, 6, 3))
IF RTRIM(Bsr) > "" THEN GOTO e
IF LEFT(bsh1, 2) = "SZ" THEN Bsr = "S Z" + SPACE(4 - LEN(RTRIM(MID(bsh1, 3, 3)))) + RTRIM(MID(bsh1, 3, 3))
IF LEFT(bsh1, 2) = "RZ" THEN Bsr = "R Z" + SPACE(4 - LEN(RTRIM(MID(bsh1, 3, 3)))) + RTRIM(MID(bsh1, 3, 3))
IF RTRIM(Bsr) > "" THEN GOTO e
IF LEFT(bsh1, 2) = "UN" THEN Bsr = "UN "
IF LEFT(bsh1, 2) = "ON" THEN Bsr = "ON "
IF RTRIM(Bsr) > "" THEN
IF MID(bsh1, 3, 1) = "T" OR MID(bsh1, 3, 1) = "Z" THEN
Bsr = Bsr + MID(bsh1, 3, 1) + SPACE(5 - LEN(RTRIM(MID(bsh1, 4, 3)))) + RTRIM(MID(bsh1, 4, 3))
' Bsr = Bsr + MID(bsh1, 3, 1) + " " + MID(bsh1, 4, 1)
ELSE
Bsr = Bsr + MID(bsh1, 3, 1) + SPACE(5 - LEN(RTRIM(MID(bsh1, 4, 4)))) + RTRIM(MID(bsh1, 4, 4))
END IF
GOTO e
END IF
IF LEFT(bsh1, 1) = "U" THEN Bsr = "U "
IF LEFT(bsh1, 1) = "O" THEN Bsr = "O "
IF RTRIM(Bsr) > "" THEN
IF MID(bsh1, 2, 1) = "T" OR MID(bsh1, 2, 1) = "Z" THEN
Bsr = Bsr + MID(bsh1, 2, 1) + SPACE(5 - LEN(RTRIM(MID(bsh1, 3, 3)))) + RTRIM(MID(bsh1, 3, 3))
' Bsr = Bsr + MID(bsh1, 2, 1) + " " + MID(bsh1, 3, 1)
ELSE
Bsr = Bsr + MID(bsh1, 2, 1) + SPACE(5 - LEN(RTRIM(MID(bsh1, 3, 4)))) + RTRIM(MID(bsh1, 3, 4))
END IF
GOTO e
END IF
IF LEFT(bsh1, 2) = "SL" THEN Bsr = "SL " + MID(bsh1, 3, 2) + SPACE(4 - LEN(RTRIM(MID(bsh1, 5, 3)))) + RTRIM(MID(bsh1, 5, 3))
IF RTRIM(Bsr) > "" THEN GOTO e
IF LEFT(bsh1, 1) = "S" THEN Bsr = "S " + MID(bsh1, 2, 1) + SPACE(5 - LEN(RTRIM(MID(bsh1, 3, 4)))) + RTRIM(MID(bsh1, 3, 4))
IF LEFT(bsh1, 1) = "R" THEN Bsr = "R " + MID(bsh1, 2, 1) + SPACE(5 - LEN(RTRIM(MID(bsh1, 3, 4)))) + RTRIM(MID(bsh1, 3, 4))
IF LEFT(bsh1, 1) = "=" OR LEFT(bsh1, 1) = "0" THEN Bsr = "= " + MID(bsh1, 2, 1) + SPACE(5 - LEN(RTRIM(MID(bsh1, 3, 4)))) + RTRIM(MID(bsh1, 3, 4))
IF RTRIM(Bsr) > "" THEN GOTO e
IF LEFT(bsh1, 3) = "TSS" THEN Bsr = "TSS " + MID(bsh1, 4, 2) + SPACE(4 - LEN(RTRIM(MID(bsh1, 6, 3)))) + RTRIM(MID(bsh1, 6, 3))
IF LEFT(bsh1, 2) = "LC" THEN Bsr = "LC " + MID(bsh1, 3, 2) + SPACE(4 - LEN(RTRIM(MID(bsh1, 5, 3)))) + RTRIM(MID(bsh1, 5, 3))
IF LEFT(bsh1, 2) = "LL" THEN Bsr = "LL " + MID(bsh1, 3, 2) + SPACE(4 - LEN(RTRIM(MID(bsh1, 5, 3)))) + RTRIM(MID(bsh1, 5, 3))
IF LEFT(bsh1, 2) = "LH" THEN Bsr = "LH " + MID(bsh1, 3, 2) + SPACE(4 - LEN(RTRIM(MID(bsh1, 5, 3)))) + RTRIM(MID(bsh1, 5, 3))
IF LEFT(bsh1, 2) = "LI" THEN Bsr = "LI " + MID(bsh1, 3, 2) + SPACE(4 - LEN(RTRIM(MID(bsh1, 5, 3)))) + RTRIM(MID(bsh1, 5, 3))
IF RTRIM(Bsr) > "" THEN GOTO e
IF LEFT(bsh1, 1) = "L" THEN Bsr = "L " + MID(bsh1, 2, 2) + SPACE(4 - LEN(RTRIM(MID(bsh1, 4, 3)))) + RTRIM(MID(bsh1, 4, 3))
IF LEFT(bsh1, 1) = "T" THEN Bsr = "T " + MID(bsh1, 2, 2) + SPACE(4 - LEN(RTRIM(MID(bsh1, 4, 3)))) + RTRIM(MID(bsh1, 4, 3))
IF LEFT(bsh1, 2) = "DB" THEN Bsr = "DB " + SPACE(3 - LEN(RTRIM(MID(bsh1, 3, 3)))) + RTRIM(MID(bsh1, 3, 3))
e:
IF LEFT(bsh1, 1) = "?" THEN Bsr = "??????"
Bstrrueck = Bsr
END SUB
SUB fragebox (FR as STRING, Rue as STRING)
DIM frgr as Integer
frgr = LEN(FR)
zeichnrahmen 18, 22, 39 - (frgr \ 2), 41 + (frgr \ 2)
LOCATE 20, 40 - (frgr \ 2): PRINT FR;
Rue = INPUT(1)
END SUB
SUB fupmenu
DIM li as Integer, po as Integer
COLOR GrundfarbeV, GrundfarbeH
li = CSRLIN: po = POS(0)
LOCATE 1, 1
COLOR MenufarbeV, MenufarbeH: PRINT STRING(80, 32)
LOCATE 1, 1
PRINT "F1 &³F2 >=1³F3 ÄÄ´³F4 Äo´³F5 ³F6 ³F7 ³F8 Copy ³F9 ³F10 ³F11 šb³F12 Dru - +";
COLOR MenufarbeH, GrundfarbeH: LOCATE 2, 1: PRINT STRING(80, 205)'ÍÍÍÍÍ
COLOR GrundfarbeV, GrundfarbeH: LOCATE li, po
END SUB
SUB Hypertext (FileName as STRING, Schluessel as STRING)
DIM i as INTEGER, IndexL AS STRING, J as INTEGER, Schluessel2 AS STRING, Indices as INTEGER, Hyoffset as INTEGER, Hyanz as INTEGER, Found as INTEGER
DIM Head AS STRING, Quer as INTEGER, Markealt as INTEGER, marke as INTEGER, ianf as INTEGER, in as INTEGER, such as INTEGER, flag as INTEGER, Qm as INTEGER
DIM Key1 AS STRING, sk as INTEGER, of as INTEGER, Schluesselalt AS STRING
DIM Indexstr as STRING, Index as INTEGER
'*** Hypertext-Seite aus FileName zu Schlssel Schluessel anzeigen
'** Sonderfall: Schlsselwort "Inhalt"
'** Querverweise hell darstellen, aktuellen invertieren
'** Auswahl mit Cursortasten und <Return> oder Maus
'IF NOT Exists(FileName) THEN BEEP: EXIT SUB '** Datei existiert nicht!
exit sub
DIM HText(23) as STRING, Indexstrf(200) as STRING, Indexf(200), Querf(50, 2) as INTEGER
'PCOPY 0, 1
OPEN "I", #1, FileName
FOR i = 1 TO 200
LINE INPUT #1, IndexL '** Indices einlesen
IF IndexL = "" THEN EXIT FOR '** Ende der Liste!
Indexstr = LEFT(IndexL, INSTR(IndexL, " ") - 1)
Index = VAL(MID(IndexL, INSTR(IndexL, " ") + 1))
FOR J = 1 TO i - 1
IF Indexstr < Indexstrf(J) THEN '** Index einsortieren
SWAP Indexstr, Indexstrf(J)
SWAP Index, Indexf(J)
END IF
NEXT J
Indexstrf(i) = Indexstr
Indexf(i) = Index
NEXT i
Schluessel2 = Schluessel '** Originalschlssel retten
Indices = i - 1 '** Anzahl Indices
Hyoffset = SEEK(1) '** Offset in Datei zum Textanfang
DO '********************* Žuáere Schleife **********************
IF Schluessel2 = "Inhalt" THEN '** Inhaltsverzeichnis bilden
FOR i = 1 TO 23: HText(i) = "": NEXT i
Hyanz = 1
FOR i = 1 TO Indices
IF LEN(HText(Hyanz)) + LEN(Indexstrf(i)) + 6 > 78 THEN Hyanz = Hyanz + 1
HText(Hyanz) = HText(Hyanz) + " < " + Indexstrf(i) + " > "
NEXT i
Found = 1
ELSE
FOR i = 1 TO Indices '** Eintrag suchen
IF UCASE(Indexstrf(i)) = UCASE(Schluessel2) THEN
Found = Indexf(i)
EXIT FOR
END IF
NEXT i
IF Found THEN '** Schlssel gefunden:
SEEK #1, Hyoffset + Found '** Textanfang in Datei suchen
FOR i = 1 TO 23
LINE INPUT #1, HText(i) '** Textseite einlesen
IF LEFT(HText(i), 1) = ";" OR EOF(1) THEN EXIT FOR
NEXT i
Hyanz = i - 1 - EOF(1)
END IF
END IF
IF Found = 0 THEN '** Schlssel unbekannt!
BEEP
PRINT "** Schlssel " + Schluessel2 + " nicht gefunden!", 1
SLEEP 1
EXIT DO
END IF
'PCOPY 1, 0
VIEW PRINT 1 TO Hyanz + 2
CLS
'DrawBox -2, 80, Hyanz + 2 '** Anzeigebereich umrahmen
zeichnrahmen 1, Hyanz + 2, 1, 80
COLOR MenufarbeV, MenufarbeH
IF Schluessel2 = "Inhalt" THEN
Head = "<<<<< Inhaltsverzeichnis der Schlsselw”rter >>>>>"
ELSE
Head = "< *** Text zum Schlsselwort " + Schluessel2 + " *** >"
END IF
LOCATE 1, 40 - (LEN(Head) / 2)
PRINT Head
LOCATE Hyanz + 2, 5
PRINT "< Querverweis w„hlen, <Return> aktiviert, <F1>=Inhalt, <Escape>=Ende >";
VIEW PRINT 2 TO Hyanz + 2
COLOR GrundfarbeV, GrundfarbeH
Quer = 0
Markealt = 0
marke = 1 '** aktuelle Marke = 1
FOR i = 1 TO Hyanz
LOCATE , 3
PRINT HText(i); '** Text anzeigen
ianf = Quer + 1
FOR J = 1 TO Indices
'** ggf. Querverweise darstellen
such = 1
in = INSTR(MID(HText(i), such), Indexstrf(J) + " ")
DO UNTIL in = 0
in = INSTR(MID(HText(i), such), Indexstrf(J) + " ")
IF in THEN
COLOR GrundfarbeV + 8
LOCATE , in + such + 1
PRINT Indexstrf(J); '** Querverweis!
COLOR GrundfarbeV
Quer = Quer + 1
Querf(Quer, 0) = i '** Zeile und
Querf(Quer, 1) = in + such - 1 '** Spalte retten
Querf(Quer, 2) = J '** Index-Nummer
END IF
such = such + in + 1
LOOP
NEXT J
DO
flag = 0
FOR Qm = ianf TO Quer - 1
IF Querf(Qm, 1) > Querf(Qm + 1, 1) THEN '** Spalte einsortieren
SWAP Querf(Qm, 1), Querf(Qm + 1, 1)
SWAP Querf(Qm, 2), Querf(Qm + 1, 2)
flag = 1
END IF
NEXT Qm
LOOP UNTIL flag = 0
PRINT
NEXT i
DO
IF Quer THEN ZeigeMarke(Markealt,marke,Indexstr,Indexstrf() ,Querf()) '** Querverweis markieren
DO
Key1 = INKEY
IF LEN(Key1) > 1 THEN
sk = ASC(RIGHT(Key1, 1)) '** Sondertasten-Code in sk
ELSE
sk = 0
END IF
LOOP UNTIL Key1 > "" '** Warten auf Taste/Mausklick
IF UCASE(Key1) >= "A" AND UCASE(Key1) <= "Z" THEN
of = marke
FOR i = 1 TO Quer '** Anfangsbuchstaben suchen
IF i + of > Quer THEN of = 0
IF UCASE(Key1) = UCASE(LEFT(Indexstrf(Querf(i + of, 2)), 1)) THEN
marke = i + of
EXIT FOR
END IF
NEXT i
sk = 0
END IF
SELECT CASE sk
CASE 59 '** <F1>: Inhaltsverzeichnis
Indexstr = "Inhalt"
Key1 = CHR(13)
CASE 9, 77: marke = marke + 1 '** n„chster Verweis
CASE 75, 15: marke = marke - 1 '** vorheriger Verweis
CASE 80, 72 '** n„chste/vorherige Zeile
DO
marke = marke + (sk = 72) - (sk = 80)
IF marke < 0 THEN marke = Quer
LOOP UNTIL (Querf(marke, 0) <> Querf(Markealt, 0)) OR Quer = 0
CASE 73
IF LEN(Schluesselalt) THEN '** vorherige Seite
Indexstr = Schluesselalt
Key1 = CHR(13)
END IF
CASE 71 '** ursprngliche Seite
Indexstr = Schluessel
Key1 = CHR(13)
CASE ELSE
END SELECT
IF Key1 = CHR(13) THEN '** n„chste Seite zeigen!
Schluesselalt = Schluessel2
Schluessel2 = Indexstr
END IF
IF marke > Quer THEN marke = 1
IF marke < 1 THEN marke = Quer
LOOP UNTIL Key1 = CHR(13) OR Key1 = CHR(27)
LOOP UNTIL Key1 = CHR(27)
CLOSE #1
VIEW PRINT 1 TO 25
'PCOPY 1, 0
END SUB
sub ZeigeMarke(Markealt AS INTEGER,marke AS INTEGER,Indexstr as STRING,Indexstrf() as STRING,Querf() AS INTEGER)
IF Markealt THEN
COLOR GrundfarbeV + 8, GrundfarbeH
ZeigeWort (Querf(),Markealt,Indexstrf() ) '** alte Markierung weg
END IF
Markealt = marke
COLOR GrundfarbeH, GrundfarbeV
ZeigeWort (Querf(),Markealt,Indexstrf() ) '** neue Markierung setzen
COLOR GrundfarbeV, GrundfarbeH
Indexstr = Indexstrf(Querf(Markealt, 2))
end sub
'** ==> ENDE !
sub ZeigeWort (Querf() as INTEGER,Markealt as INTEGER,Indexstrf() as STRING) '** Schlsselwort ausgeben
LOCATE Querf(Markealt, 0) + 1, Querf(Markealt, 1) + 2
PRINT Indexstrf(Querf(Markealt, 2));
end sub
SUB InCodeSetzen (ero as INTEGER,erolin as INTEGER)
DIM feldpos as INTEGER, strpos as INTEGER, l as INTEGER, adrstack as INTEGER
DIM Befehle AS STRING, letzterstack as INTEGER, letztezeile as INTEGER
DIM Adressfeld_A(200)as INTEGER
DIM Adressfeld_N(200)as STRING
DIM feldwert as INTEGER
feldpos = 0: strpos = 0: ero = 0 : adrstack = 0
FOR l = 0 TO ElNr
feld(l) = 0
NEXT
DO
Befehle = RTRIM(Befehlsfeld(strpos))
IF INSTR(LEFT(Befehle,19),":") > 1 then
Adressfeld_A(adrstack) = feldpos
Adressfeld_N(adrstack) = LEFT(Befehle,INSTR(Befehle,":")-1)
adrstack=adrstack + 1
'mid(Befehlsfeld(strpos),20,3)=str(adrstack-1)
'mid(Befehlsfeld(strpos),24,10)=Adressfeld_N(adrstack-1)'str (feldpos)
goto Adressenfund
END IF
StringPosAdr(strpos)=feldpos
IF LEFT(Befehle, 2) = "U(" THEN feld(feldpos) = 3: assfeld(strpos) = "db 3"
IF LEFT(Befehle, 2) = "O(" THEN feld(feldpos) = 4: assfeld(strpos) = "db 4"
IF LEFT(Befehle, 1) = ")" THEN feld(feldpos) = 5: assfeld(strpos) = "db 5"
IF LEFT(Befehle, 4) = "UBD0" THEN feld(feldpos) = 9: assfeld(strpos) = "db 9"
IF LEFT(Befehle, 4) = "UBD1" THEN feld(feldpos) = 41: assfeld(strpos) = "db 41"
IF LEFT(Befehle, 3) = "BEU" THEN
feld(feldpos) = 48: assfeld(strpos) = "db 48"
ELSE
IF LEFT(Befehle, 2) = "BE" THEN feld(feldpos) = 16: assfeld(strpos) = "db 16"
END IF
IF LEFT(Befehle, 2) = "PE" THEN feld(feldpos) = 240: assfeld(strpos) = "db 240": feldend = feldpos: EXIT do
IF LEFT(Befehle, 3) = "RES" THEN feld(feldpos) = 19: assfeld(strpos) = "db 19"
IF LEFT(Befehle, 3) = "RES" THEN feld(feldpos) = 20: assfeld(strpos) = "db 20"
IF LEFT(Befehle, 3) = "!=F" THEN feld(feldpos) = 26: assfeld(strpos) = "db 26"
IF LEFT(Befehle, 3) = "< F" THEN feld(feldpos) = 27: assfeld(strpos) = "db 27"
IF LEFT(Befehle, 3) = "> F" THEN feld(feldpos) = 28: assfeld(strpos) = "db 28"
IF LEFT(Befehle, 3) = "+ F" THEN feld(feldpos) = 29: assfeld(strpos) = "db 29"
IF LEFT(Befehle, 3) = "- F" THEN feld(feldpos) = 30: assfeld(strpos) = "db 30"
IF LEFT(Befehle, 3) = "* F" THEN feld(feldpos) = 61: assfeld(strpos) = "db 61"
IF LEFT(Befehle, 3) = "/ F" THEN feld(feldpos) = 62: assfeld(strpos) = "db 62"
IF LEFT(Befehle, 3) = "INV" THEN feld(feldpos) = 89: assfeld(strpos) = "db 89"
IF LEFT(Befehle, 3) = "U F" THEN feld(feldpos) = 93: assfeld(strpos) = "db 93"
IF LEFT(Befehle, 3) = "O F" THEN feld(feldpos) = 94: assfeld(strpos) = "db 94"
IF LEFT(Befehle, 3) = "XOF" THEN feld(feldpos) = 126: assfeld(strpos) = "db 126"
IF LEFT(Befehle, 3) = "BLD" OR LEFT(Befehle, 3) = "***" THEN feld(feldpos) = 32: assfeld(strpos) = "db 32"
IF LEFT(Befehle, 3) = "NOP" THEN feld(feldpos) = 0: assfeld(strpos) = "db 0"
SELECT CASE LEFT(Befehle, 4)
CASE "BLDS", "***S", "NOPS"
feld(feldpos) = feld(feldpos) OR 64
CASE "BLDE", "***E", "NOPE"
feld(feldpos) = feld(feldpos) OR 128
END SELECT
IF feld(feldpos) > 0 THEN GOTO exi
IF LEFT(Befehle, 7) = "SE T" THEN feld(feldpos) = 10
IF LEFT(Befehle, 7) = "SA T" THEN feld(feldpos) = 11
IF LEFT(Befehle, 7) = "ZV Z" THEN feld(feldpos) = 12
IF LEFT(Befehle, 7) = "ZR Z" THEN feld(feldpos) = 13
IF LEFT(Befehle, 7) = "S Z" THEN feld(feldpos) = 14
IF LEFT(Befehle, 7) = "R Z" THEN feld(feldpos) = 15
IF feld(feldpos) > 0 THEN
feldpos = feldpos + 1
feld(feldpos)= VAL(MID(Befehle, 10, 3)): assfeld(strpos) = "db " + Str(feld(feldpos-1)) + ", " + Str(feld(feldpos))
GOTO exi
END IF
IF LEFT(Befehle, 3) = "U " THEN feld(feldpos) = 1
IF LEFT(Befehle, 3) = "O " THEN feld(feldpos) = 2
IF LEFT(Befehle, 3) = "UN " THEN feld(feldpos) = 17
IF LEFT(Befehle, 3) = "ON " THEN feld(feldpos) = 18
IF LEFT(Befehle, 3) = "S " THEN feld(feldpos) = 6
IF LEFT(Befehle, 3) = "R " THEN feld(feldpos) = 7
IF LEFT(Befehle, 3) = "= " THEN feld(feldpos) = 8
IF feld(feldpos) > 0 THEN
feldpos = feldpos + 1
IF MID(Befehle, 7, 1) = "T" THEN feld(feldpos) = VAL(LTRIM(MID(Befehle, 10, 3))): feld(feldpos - 1) = (feld(feldpos - 1) AND 31) : assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld(feldpos))
IF MID(Befehle, 7, 1) = "Z" THEN feld(feldpos) = VAL(LTRIM(MID(Befehle, 10, 3))): feld(feldpos - 1) = (feld(feldpos - 1) AND 31) : assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld(feldpos))
IF MID(Befehle, 7, 1) = "E" THEN feld(feldpos) = 33 + VAL(MID(Befehle, 9, 2)): feld(feldpos - 1) = (feld(feldpos - 1) AND 31) + VAL(MID(Befehle, 12, 1)) * 32: assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld( _
feldpos))
IF MID(Befehle, 7, 1) = "A" THEN feld(feldpos) = 41 + VAL(MID(Befehle, 9, 2)): feld(feldpos - 1) = (feld(feldpos - 1) AND 31) + VAL(MID(Befehle, 12, 1)) * 32: assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld( _
feldpos))
IF MID(Befehle, 7, 1) = "M" THEN feld(feldpos) = 49 + VAL(LTRIM(MID(Befehle, 8, 3))): feld(feldpos - 1) = (feld(feldpos - 1) AND 31) + VAL(MID(Befehle, 12, 1)) * 32: assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str( _
feld(feldpos))
IF MID(Befehle, 7, 1) = "S" THEN feld(feldpos) = VAL(LTRIM(MID(Befehle, 8, 3))): feld(feldpos - 1) = (feld(feldpos - 1) AND 31) + VAL(MID(Befehle, 12, 1)) * 32: assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld( _
feldpos))
GOTO exi
END IF
IF LEFT(Befehle, 4) = "L " THEN feld(feldpos) = 23
IF LEFT(Befehle, 4) = "LC " THEN feld(feldpos) = 24
IF LEFT(Befehle, 4) = "LL " THEN feld(feldpos) = 56
IF LEFT(Befehle, 4) = "LH " THEN feld(feldpos) = 88
IF LEFT(Befehle, 4) = "LI " THEN feld(feldpos) = 120
IF LEFT(Befehle, 4) = "LB " THEN feld(feldpos) = 152
IF LEFT(Befehle, 4) = "T " THEN feld(feldpos) = 25
IF LEFT(Befehle, 4) = "TI " THEN feld(feldpos) = 57
IF LEFT(Befehle, 4) = "TSS " THEN feld(feldpos) = 121
IF LEFT(Befehle, 4) = "TB " THEN feld(feldpos) = 153
IF LEFT(Befehle, 4) = "SSS " THEN feld(feldpos) = 185
IF LEFT(Befehle, 4) = "UHR " THEN feld(feldpos) = 217
IF LEFT(Befehle, 4) = "SL " THEN feld(feldpos) = 31
IF feld(feldpos) > 0 THEN
feldpos = feldpos + 1
IF MID(Befehle, 7, 1) = "T" THEN feld(feldpos) = 1 + VAL(MID(Befehle, 10, 3)): assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld(feldpos))
IF MID(Befehle, 7, 1) = "Z" THEN feld(feldpos) = 1 + VAL(MID(Befehle, 10, 3)): assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld(feldpos))
IF MID(Befehle, 7, 2) = "EB" THEN feld(feldpos) = 33 + VAL(MID(Befehle, 12, 1)): assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld(feldpos))
IF MID(Befehle, 7, 2) = "AB" THEN feld(feldpos) = 41 + VAL(MID(Befehle, 12, 1)): assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld(feldpos))
IF MID(Befehle, 7, 2) = "MW" THEN feld(feldpos) = 49 + VAL(LTRIM(MID(Befehle, 10, 3))): assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld(feldpos))
IF MID(Befehle, 7, 2) = "MB" THEN feld(feldpos) = 49 + VAL(LTRIM(MID(Befehle, 10, 3))): assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld(feldpos))
IF MID(Befehle, 7, 2) = "SB" THEN feld(feldpos) = VAL(LTRIM(MID(Befehle, 10, 3))): assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + ", " + Str(feld(feldpos))
GOTO exi
END IF
IF LEFT(Befehle, 4) = "SZP " THEN
feld(feldpos) = 125
feldpos = feldpos + 1
feldwert=0
IF INSTR(MID(Befehle, 5, 14),"MO")>0 then feldwert=feldwert or 1
IF INSTR(MID(Befehle, 5, 14),"DI")>0 then feldwert=feldwert or 2
IF INSTR(MID(Befehle, 5, 14),"MI")>0 then feldwert=feldwert or 4
IF INSTR(MID(Befehle, 5, 14),"DO")>0 then feldwert=feldwert or 8
IF INSTR(MID(Befehle, 5, 14),"FR")>0 then feldwert=feldwert or 16
IF INSTR(MID(Befehle, 5, 14),"SA")>0 then feldwert=feldwert or 32
IF INSTR(MID(Befehle, 5, 14),"SO")>0 then feldwert=feldwert or 64
IF INSTR(MID(Befehle, 5, 14),"T")>0 then feldwert=127
feld(feldpos) = feldwert
assfeld(strpos)="db "+STR(feld(feldpos-1))+", "+STR(feld(feldpos))
goto exi
END IF
IF LEFT(Befehle, 5) = "LPDI " THEN
'StringPosAdr(strpos)=feldpos
feld(feldpos) = 184
feldpos = feldpos + 2
assfeld(strpos)="db 184, "
END IF
IF LEFT(Befehle, 4) = "SPB " THEN
'StringPosAdr(strpos)=feldpos
feld(feldpos) = 80
feldpos = feldpos + 2
assfeld(strpos)="db 80, "
END IF
IF LEFT(Befehle, 2) = "DB" THEN
feld(feldpos) = VAL(LTRIM(MID(Befehle, 10, 3)))
assfeld(strpos) = "db " + Str(feld(feldpos))
END IF
IF LEFT(Befehle, 5) = "ZEIT=" THEN
feld(feldpos) = VAL(MID(Befehle, 7, 2))
assfeld(strpos) = "db " + Str(feld(feldpos))
feldpos +=1
feld(feldpos) = VAL(MID(Befehle, 10, 2))
assfeld(strpos) = assfeld(strpos)+", " + Str(feld(feldpos))
feldpos +=1
feld(feldpos) = VAL(MID(Befehle, 13, 2))
assfeld(strpos) = assfeld(strpos)+", " + Str(feld(feldpos))
END IF
IF LEFT(Befehle, 4) = "L KF" THEN
feld(feldpos) = 21
feldpos = feldpos + 1
feld(feldpos) = VAL(LTRIM(MID(Befehle, 10, 3)))
assfeld(strpos) = "db " + Str(feld(feldpos - 1)) + "," + Str(feld(feldpos))
END IF
IF LEFT(Befehle,4) ="L KT" THEN
feld(feldpos) = 22 + VAL(MID(Befehle,12,1)) * 64
feldpos = feldpos +1
feld(feldpos)=VAL(LTRIM(MID(Befehle,8,3)))
assfeld(strpos) = "db "+Str(feld(feldpos -1))+", "+Str(feld(feldpos))
END IF
exi:
IF feld(feldpos) = 0 AND LEFT(Befehle, 3) <> "NOP" AND _
INSTR(Befehle, CHR(0)) <> 1 AND Befehle > "" AND _
MID(Befehle, 7, 1) <> "T" AND MID(Befehle, 3, 1) <> "K" AND _
INSTR(Befehle,":") = 0 AND LEFT(Befehle,2)<>"DB" _
THEN ero = ero'1: erolin = strpos
feldpos = feldpos + 1
Adressenfund: ' bei Adressenfund feldpos nicht inkrementieren
strpos = strpos + 1
LOOP UNTIL feldpos > ElNr - 6 OR strpos > zmax
feldend = feldpos
IF feldpos > ElNr - 8 THEN nachricht "speicher voll"
IF adrstack > 0 THEN ' ######### PASS 2 ####################
letzteZeile = strpos: letzterstack = adrstack - 1
strpos=0
DO
Befehle = RTRIM(LEFT(Befehlsfeld(strpos),19))
IF LEFT(Befehle,4)="LPDI" or LEFT(Befehle,3)="SPB"THEN
FOR adrstack = 0 TO letzterstack
IF INSTR(Adressfeld_N(adrstack),LTRIM(MID(Befehle,5,LEN(Befehle)-4))) > 0 THEN
feld(StringPosAdr(strpos)+1)= Adressfeld_A(adrstack)\256
feld(StringPosAdr(strpos)+2)= Adressfeld_A(adrstack) and 255
assfeld(strpos)=assfeld(strpos)+STR(feld(StringPosAdr(strpos)+1))+", "+str(feld(StringPosAdr(strpos)+2))
END IF
NEXT
END IF
strpos +=1
loop until strpos = letzteZeile or LEFT(Befehle,2) = "PE"
END IF
DO '++++++++ PE anhängen ++++++++++
feldpos = feldpos - 1: strpos = strpos - 1
be = ASC(LEFT(Befehlsfeld(strpos), 1))
LOOP UNTIL feldpos = 0 OR be > 0 AND be <> 32
'feld(feldpos + 1) = 32: Befehlsfeld(strpos + 1) = "***"
'feld(feldpos + 2) = 16: Befehlsfeld(strpos + 2) = "BE" 'Bausteinende
if (feld(feldpos)and 32) <> 32 then
feldpos = feldpos + 1 :strpos = strpos +1
feld(feldpos ) = 32: Befehlsfeld(strpos ) = "***"
END iF
feld(feldpos + 1) = 240: Befehlsfeld(strpos + 1) = "PE" 'Programmende
'####### Ende SPS ############
END SUB
SUB kommando (by as INTEGER)
PRINT #3, CHR(by);
END SUB
SUB nachricht (na as STRING)
cpalt = POS(0): clalt = CSRLIN
LOCATE 1, 1
COLOR MenufarbeV, MenufarbeH: PRINT STRING(80, 32);
LOCATE 1, 30: COLOR NachrichtblinkfarbeV, NachrichtfarbeH
LOCATE 1, 30: PRINT na
SLEEP 2000
LOCATE 1, 30
COLOR MenufarbeV, MenufarbeH: PRINT STRING(49, 32): COLOR GrundfarbeV, GrundfarbeH
LOCATE clalt, cpalt
END SUB
SUB Operantenformat (Ostrhin as STRING, Ostrrueck as STRING, OPArtAlt as STRING)
DIM Osh AS STRING, spos as INTEGER, Buchstabe AS STRING, OSh1 AS STRING, buchstwert as INTEGER
Osh = UCASE(LTRIM(Ostrhin)): OSh1 = "": Ostrrueck = " "
IF LEFT(Osh, 1) = "?" THEN Ostrrueck = "??????": GOTO endopformat
'IF Right(Osh,1)=":" THEN Ostrrueck=Ostrhin: GOTO endopformat
FOR spos = 1 TO 6
Buchstabe = MID(Osh, spos, 1)
IF Buchstabe > CHR(0) AND Buchstabe <> CHR(32) AND Buchstabe <> "?" THEN OSh1 = OSh1 + Buchstabe
NEXT
IF OSh1 = "" THEN EXIT SUB
buchstwert = ASC(LEFT(OSh1, 1))
IF buchstwert > 47 AND buchstwert < 58 THEN
Ostrrueck = SPACE(6 - LEN(OSh1)) + OSh1
ELSE
IF MID(OSh1, 2, 1) = "B" OR MID(OSh1, 2, 1) = "W" OR MID(OSh1, 1, 1) = "T" OR MID(OSh1, 1, 1) = "Z" THEN
IF MID(OSh1, 2, 1) = "B" OR MID(OSh1, 2, 1) = "W" THEN
MID(Ostrrueck, 1, 2) = LEFT(OSh1, 2)
MID(Ostrrueck, 3, 4) = SPACE(6 - LEN(OSh1)) + RTRIM(RIGHT(OSh1, LEN(OSh1) - 2))
ELSE
MID(Ostrrueck, 1, 1) = LEFT(OSh1, 1)
MID(Ostrrueck, 3, 4) = SPACE(5 - LEN(OSh1)) + RTRIM(RIGHT(OSh1, LEN(OSh1) - 1))
END IF
ELSE
IF LEN(OSh1) < 2 THEN EXIT SUB
MID(Ostrrueck, 1, 1) = LEFT(OSh1, 1)
MID(Ostrrueck, 6, 1) = CHR(((ASC(RTRIM(RIGHT(OSh1, 1))) - 48) AND 7) + 48) 'alter Befehl: RTRIM(RIGHT(Osh1, 1))
MID(Ostrrueck, 5, 1) = "."
IF MID(OSh1, LEN(OSh1) - 1, 1) = "." THEN
MID(Ostrrueck, 8 - LEN(RTRIM(OSh1)), LEN(RTRIM(OSh1)) - 3) = MID(OSh1, 2, LEN(RTRIM(OSh1)) - 3)
ELSE
MID(Ostrrueck, 7 - LEN(RTRIM(OSh1)), LEN(RTRIM(OSh1)) - 2) = MID(OSh1, 2, LEN(RTRIM(OSh1)) - 2)
'MID(Ostrrueck, 2, 5) = SPACE(6 - LEN(Osh1)) + RTRIM(RIGHT(Osh1, LEN(Osh1) - 1))
END IF
END IF
END IF
endopformat:
END SUB
FUNCTION Pegel (in, stellen) as STRING
DIM binstr AS STRING, xb
binstr = ""
FOR xb = 1 TO stellen
IF xb MOD 4 = 1 THEN binstr = " " + binstr
IF (in AND 1) = 1 THEN
binstr = "H" + binstr
ELSE
binstr = "L" + binstr
END IF
in = in \ 2
NEXT
Pegel = binstr
END FUNCTION
SUB pfadsetup (setpf as STRING)
CHDIR "C:\"
OPEN "C:\FBcomp05.pfd" FOR OUTPUT AS #3
PRINT #3, setpf
CLOSE
CHDIR setpf
END SUB
SUB Rahmenweg (SeiteOben, SeiteUnten, SeiteLinks, SeiteRechts)
DIM Zeil, Horizontal
Horizontal = 205
Rahmenbreit = SeiteRechts - SeiteLinks - 1
COLOR MenufarbeH, GrundfarbeH
LOCATE SeiteOben, SeiteLinks
PRINT STRING(Rahmenbreit + 2, CHR(205));
COLOR GrundfarbeV, GrundfarbeH
FOR Zeil = SeiteOben TO SeiteUnten
LOCATE Zeil, SeiteLinks
PRINT STRING(Rahmenbreit + 2, 32);
NEXT Zeil
END SUB
SUB shiften (zeile, re)
DIM delpos, shift, inspos
LOCATE , , 0
SELECT CASE re
CASE 0
delpos = POS(0)
IF POS(0) < 32 THEN
FOR shift = POS(0) TO 31
PRINT CHR(SCREEN(zeile, shift + 1));
NEXT shift
PRINT CHR(0);
END IF
IF POS(0) > 39 AND POS(0) < 78 THEN
FOR shift = POS(0) TO 77
PRINT CHR(SCREEN(zeile, shift + 1));
NEXT shift
PRINT CHR(0);
END IF
LOCATE zeile, delpos
CASE 1
inspos = POS(0)
IF inspos < 32 THEN
FOR shift = 32 TO inspos STEP -1
LOCATE zeile, shift
PRINT CHR(SCREEN(zeile, shift - 1));
NEXT shift
END IF
IF inspos > 39 AND POS(0) < 78 THEN
FOR shift = 77 TO inspos STEP -1
LOCATE zeile, shift
PRINT CHR(SCREEN(zeile, shift - 1));
NEXT shift
END IF
LOCATE zeile, inspos
END SELECT
LOCATE , , 1
END SUB
SUB SInput (Parameter as STRING, Vorgabe as STRING, Steuerung)
STATIC SIUeberschreiben
DIM lialt, posalt, SIZeile, SISpalte, SImin, SImax, P1, P2, work AS STRING
DIM cpos, Sprung, Steuerzeichen, Eingabe AS STRING,SHOW as string
lialt = CSRLIN: posalt = POS(0)
IF SIUeberschreiben = 0 THEN LOCATE , , 1 ELSE LOCATE , , 1
' Diese Prozedur bietet bessere M”glichkeiten zur Dateneingabe als INPUT
' und LINEINPUT. Sie ist besonders geeignet zur Maskeneingabe.
' Als Parameter erh„lt sie zwei Strings und eine numerische Variable
'
' Der 10-stellige String PARAMETER enth„lt folgende Daten:
'
' aabbcdeeff mit aa=Zeile bb=Spalte ee=minimale Anzahl Zeichen
' ff=maximale Anzahl Zeichen
' c=0 Vorgabe ist ungltig c=1 Vorgabe ist gltig
' d=0 Keine Feldkennzeichnung d=1 Kennzeichnung mit Punkten
'
' Vorgabe enth„lt beim Aufruf ggfs. den als Vorgabe bergebenen Wert und
' liefert bei Rckkehr den eingegebenen String.
'
' Steuerung liefert bei Rckkehr eine Information darber, wie die Eingabe
' verlassen wurde. 1=Eingabetaste 2=Esc 3=TAB 4=SHIFT+TAB
' Wird die Eingabetaste bet„tigt, wird geprft, ob gengend Zeichen
' eingegeben wurden.
'
' SINPUT ben”tigt MESSAGE
IF LEN(Parameter) <> 10 THEN GOTO SIEnde
'Ist der Parameterstring nicht 10 Zeichen lang, liegt ein Fehler vor..
SIZeile = VAL(LEFT(Parameter, 2)) ' Entnehmen der Werte von Parameter
SISpalte = VAL(MID(Parameter, 3, 2))
SImin = VAL(MID(Parameter, 7, 2))
SImax = VAL(MID(Parameter, 9, 2))
P1 = VAL(MID(Parameter, 5, 1))
P2 = VAL(MID(Parameter, 6, 1))
IF P1 = 1 THEN work = Vorgabe 'Vorgabe gltig ??
IF LEN(work) > SImax THEN GOTO SIEnde
'Kontrolle der Vorgabe..
cpos = 1 'Aktuelle Cursorposition innerhalb des Eingabestrings
SIAnz P2,SHOW,work,SImax,SIZeile,SISpalte,cpos'Anzeigen des Eingabestrings
SILoop:
Ende = 0 'Abbruchkriterien initialisieren
Sprung = 0
DO
Steuerzeichen = 0 'Noch liegt kein Steuerzeichen vor
DO ' Lesen
Eingabe = INKEY
LOOP UNTIL Eingabe <> "" '.. bis ein Zeichen eingegeben wurde
' Wurde die Cursor-links-Taste gedrckt ??
IF LEN(Eingabe) = 2 AND RIGHT(Eingabe, 1) = CHR(75) THEN
cpos = cpos - 1
END IF
' Wurde die Cursor-rechts-Taste gedrckt ??
IF LEN(Eingabe) = 2 AND RIGHT(Eingabe, 1) = CHR(77) THEN
cpos = cpos + 1
END IF
' Wurde die Einfg-Taste gedrckt ??
IF LEN(Eingabe) = 2 AND RIGHT(Eingabe, 1) = CHR(82) THEN
SIUeberschreiben = 1 - SIUeberschreiben
IF SIUeberschreiben = 0 THEN LOCATE , , 1 ELSE LOCATE , , 1
END IF
' Wurde die Pos 1 -Taste gedrckt ??
IF LEN(Eingabe) = 2 AND RIGHT(Eingabe, 1) = CHR(71) THEN
cpos = 0
IF SIUeberschreiben = 0 THEN LOCATE , , 1 ELSE LOCATE , , 1
END IF
' Wurde die Ende-Taste gedrckt ??
IF LEN(Eingabe) = 2 AND RIGHT(Eingabe, 1) = CHR(79) THEN
cpos = LEN(RTRIM(work)) + 1
END IF
' Wurde die Taste Entf (DEL) gedrckt ??
IF LEN(Eingabe) = 2 AND RIGHT(Eingabe, 1) = CHR(83) THEN
SIDelete work,cpos
END IF
' Wurde SHIFT+TAB gedrckt ??
IF LEN(Eingabe) = 2 AND RIGHT(Eingabe, 1) = CHR(15) THEN
Steuerung = 4
Sprung = 1
END IF
IF LEN(Eingabe) = 2 THEN Steuerzeichen = 1
' Alles was mit LEN=2 gedrckt werden kann ist Steuerzeichen..
'Nun mssen nur noch die Steuerzeichen abgefangen werden, die nur
' ein Zeichen lang sind ..
' Wurde die Eingabetaste gedrckt ??
IF Eingabe = CHR(13) THEN
Steuerzeichen = 1
Steuerung = 1
Ende = 1
END IF
' Wurde die Rck-Taste (Backspace) gedrckt ??
IF Eingabe = CHR(8) THEN
Steuerzeichen = 1
IF cpos > 1 THEN cpos = cpos - 1: SIDelete work,cpos
END IF
' Wurde TAB gedrckt ??
IF Eingabe = CHR(9) THEN
Steuerung = 3
Sprung = 1
Steuerzeichen = 1
END IF
' Wurde ESC gedrckt ??
IF Eingabe = CHR(27) THEN
Steuerung = 2
Sprung = 1
Steuerzeichen = 1
END IF
IF Steuerzeichen = 0 THEN SIInsert work,cpos,SImax,Eingabe,SIUeberschreiben
'Wurde das Zeichen bisher nicht als Steuerzeichen erkannt, ist es auszugeben
SIAnz P2,SHOW,work,SImax,SIZeile,SISpalte,cpos'Anzeigen des Arbeitsstrings
LOOP UNTIL Ende OR Sprung '.. und das solange, bis EINGABE,ESC,TAB oder
' SHIFT TAB gedrckt wird ...
'Falls die Eingabetaste bet„tigt wurde, und nicht gengend Zeichen
' eingegeben wurde, wir eine Nachricht ausgegeben.
IF LEN(work) < SImin AND Ende THEN
GOTO SILoop
END IF
SIEnde:
SIShow P2,SHOW,work,SImax,SIZeile,SISpalte
Vorgabe = work'šbergabe des Ergebnisses
LOCATE lialt, posalt
END SUB 'end SIInput
sub SIShow (P2,SHOW as STRING,work as STRING,SImax,SIZeile,SISpalte)
'SIShow ist ein Unterprogramm zu SINPUT. Es zeigt im Anzeigefeld den
' Arbeitsstring an.
IF P2 = 0 THEN SHOW = work + STRING(SImax, " ") 'Keine Pnktchen
IF P2 = 1 THEN SHOW = work + STRING(SImax, ".") 'Pnktchen
SHOW = LEFT(SHOW, SImax) 'Auf max Zeichen begrenzen
LOCATE SIZeile, SISpalte 'Cursor positionieren
PRINT SHOW; 'und Text ausgeben
end sub
sub SIDelete(work as STRING,cpos)
'SIDelete ist ein Unterprogramm zu SINPUT und l”scht das Zeichen unter dem
' Cursor.
IF LEN(work) = 0 THEN exit sub'Wo nichts ist, kann nichts gel”scht werden..
IF cpos > LEN(work) THEN exit sub 'Cursor hinter dem Text !
IF cpos = 1 THEN work = MID(work, 2): exit sub 'Cursor auf der ersten Pos.
work = LEFT(work, cpos - 1) + MID(work, cpos + 1) 'Entfernen
end sub
sub SIInsert(work as STRING,cpos,SImax,Eingabe as STRING,SIUeberschreiben)
'SIInsert ist ein Unterprogramm zu SINPUT und fgt das Zeichen in EINGABE
' in den Arbeitsstring ein. Das Zeichen unter dem Cursor wird dabei
' ggfs. berschrieben
IF cpos > LEN(work) AND LEN(work) = SImax THEN
END IF
IF LEN(work) = 0 THEN work = Eingabe: cpos = cpos + 1: exit sub
'Noch nichts eingegeben
IF cpos > LEN(work) THEN work = work + Eingabe: cpos = cpos + 1:exit sub
'Anfgen an den bisherigen Text
IF SIUeberschreiben = 0 THEN
work = MID(work, 1, cpos - 1) + Eingabe + MID(work, cpos, LEN(work) - cpos)
'Einfgen im Text
ELSE
MID(work, cpos, 1) = Eingabe 'oder ersetzen von vorhandenem Text
'šberschreiben im Text
END IF
cpos = cpos + 1 'Cursor um 1 nach rechts
end sub
sub SIAnz (P2,SHOW as STRING,work as STRING,SImax,SIZeile,SISpalte,cpos)
'SIAnz ist ein Unterprogramm zu SINPUT, das den Arbeitsstring nebst der
' optional anzuzeigenden Pnktchen auf dem Bildschirm ausgibt.
' Der relative Cursor wird hierbei ggfs. korrigiert und angezeigt.
SIShow P2,SHOW,work,SImax,SIZeile,SISpalte 'Anzeigen des Arbeitsstrings
IF cpos > LEN(work) THEN cpos = LEN(work) + 1 'Cursor zu weit rechts ??
IF cpos < 1 THEN cpos = 1 '..oder zu weit links ??
IF cpos > SImax THEN cpos = SImax '..oder ber die Grenze geschossen ??
LOCATE SIZeile, SISpalte + cpos - 1'Position des Cursors
end sub
SUB Statusread (stsmodus as INTEGER)
DIM strpos as INTEGER, ko AS STRING
dim ko2 AS STRING, Befehle AS STRING
dim t as integer
strpos = 0
IF stsmodus = 2 THEN
PRINT #3, CHR(6); 'Kommando 6 senden
DO
SELECT CASE RTRIM(Befehlsfeld(strpos))
CASE "***S", "BLDS", "NOPS"
EXIT DO
END SELECT
strpos = strpos + 1
LOOP UNTIL strpos > ElNr - 4
strpos = strpos + 1
END IF
IF stsmodus = 1 THEN
PRINT #3, CHR(5); 'Kommando 5 senden (lesen aus sps Ram)
't = timer + 200
DO
'if timer > t then print "timeout in A":sleep:exit do
LOOP UNTIL LOC(3)
ko = INPUT(1, #3)
PRINT #3, CHR(32); 'Systembyte 32 ausw„hlen
't = timer + 200
DO
' if timer > t then print "timeout in B":sleep:exit do
LOOP UNTIL LOC(3)
ko2 = INPUT(1, #3)
PRINT #3, CHR(4); 'Kommando 4 senden (schreiben ins interne Ram)
't= timer + 200
DO
'if timer > t then print "timeout in C":sleep:exit do
LOOP UNTIL LOC(3)
ko = INPUT(1, #3)
PRINT #3, CHR(32); 'Systembyte 32 ausw„hlen
't= timer + 200
DO
' if timer > t then print "timeout in D":sleep:exit do
LOOP UNTIL LOC(3)
ko = INPUT(1, #3)
PRINT #3, CHR(9 OR ASC(ko2)); ' 9 ins 32 schreiben 32.0=sts 32.3=stse
't= timer + 200
DO
'if timer > t then print "timeout in E":sleep:exit do
LOOP UNTIL LOC(3)
ko = INPUT(1, #3) 'ack abholen
END IF
'print "status vorbereitet"
DO
Befehle = RTRIM(LEFT(Befehlsfeld(strpos),19))
IF LEFT(Befehle, 2) = "BE" or LEFT(Befehle, 2) = "PE"_
or LEFT(Befehle, 2) = "DB" THEN EXIT DO
IF INSTR(Befehle,":")=0 THEN
SELECT CASE LEFT(Befehle, 3)
CASE "U ", "O ", "UN ", "ON ", "UBD"
'print"uo ",
't= timer + 200
DO
LOOP UNTIL LOC(3)
'print"ok"
MID(assfeld(strpos), 1, 3) = " " + Pegel(ASC(INPUT(1, #3)), 2)'status_in mit Eingang
CASE ELSE
SELECT CASE LEFT(Befehle, 7)
CASE "SE T", "SA T", "ZV Z", "ZR Z", "S Z", "R Z"
'print"sesa sel",
't= timer + 200
DO
LOOP UNTIL LOC(3)
'print "ok"
MID(assfeld(strpos), 1, 4) = Str(ASC(INPUT(1, #3))) + " "
CASE ELSE
SELECT CASE LEFT(Befehle, 3)
CASE ") ", "!=F", "< F", "> F", "S ", "R ", "= "
'print"vergleiche",
't= timer + 200
DO
LOOP UNTIL LOC(3)'>0 or timer>t
'print"ok"
MID(assfeld(strpos), 1, 3) = " " + Pegel(ASC(INPUT(1, #3)), 1)'status_in
CASE ELSE
SELECT CASE LEFT(Befehle, 3)
CASE "L ", "LL ", "LH ", "LI ","LPD", "T ", "TI ", "TSS", "INV", "+ F", "- F", "* F", "/ F", "U F", "O F", "XOF"
't= timer + 200
'print strpos,"lade",
DO
LOOP UNTIL LOC(3)'>0 or timer>t
stswert = ASC(INPUT(1, #3))
'print stswert,"ok"
MID(assfeld(strpos), 1, 4) = Str(stswert) + " "
MID(assfeld(strpos), 5, 10) = "=" + binaer(stswert, 8)
CASE "SL ", "LC "
't= timer + 200
'print"sllc",
DO
LOOP UNTIL LOC(3)'>0 or timer>t
'print"ok",
'print"byte 2",
MID(assfeld(strpos), 1, 9) = binaer(ASC(INPUT(1, #3)), 8) + " "
't= timer + 200
DO
LOOP UNTIL LOC(3)'>0 or timer>t
'print"ok"
MID(assfeld(strpos), 11, 9) = binaer(ASC(INPUT(1, #3)), 8) + " "
CASE ELSE
SELECT CASE LEFT(Befehle, 4)
CASE "***E", "BLDE", "NOPE", "SPB ", "SSS "
'print"status-ende"
EXIT SUB
case "SZP "
't= timer + 200
'print"szp",
DO
LOOP UNTIL LOC(3)'>0 or timer>t
'print"ok"
MID(assfeld(strpos), 1, 3) = " " + Pegel(ASC(INPUT(1, #3)), 1)'status_in
strpos = strpos + 1
END SELECT
END SELECT
END SELECT
END SELECT
END SELECT
END IF
strpos = strpos + 1
LOOP UNTIL strpos > zmax
END SUB
FUNCTION statusselect (zst AS INTEGER) as STRING
IF status > 0 THEN
SELECT CASE MID(assfeld(zst), 3, 1)
CASE "H"
statusselect = "Ã=´"
CASE "L"
statusselect = "Ã-\"
CASE ELSE
statusselect = "+-+"' Str(zst)
END SELECT
ELSE
statusselect = "ÃÄ´"
END IF
END FUNCTION
SUB Statustoggle (stt AS INTEGER)
DIM strpos AS INTEGER
IF stt = 1 THEN
IF status = 1 THEN
status = 0
CLOSE
ELSE
CLOSE
status = 1
FOR strpos = 0 TO zmax
MID(assfeld(strpos), 1, 20) = " "
NEXT
OPEN COM "COM1:19200,N,8,1,CS0,DS0,CD0,BIN" FOR RANDOM AS #3
END IF
END IF
IF stt = 2 THEN
IF status = 2 THEN
status = 0
CLOSE
ELSE
CLOSE
status = 2
FOR strpos = 0 TO zmax
MID(assfeld(strpos), 1, 20) = " "
NEXT
OPEN COM "COM1:19200,N,8,1,CS0,DS0,CD0,BIN" FOR RANDOM AS #3
END IF
END IF
END SUB
SUB Suche (l, z, weiter AS INTEGER)
DIM cpalt AS INTEGER, clalt AS INTEGER, von AS INTEGER, such AS STRING, Ustri AS STRING, Estri AS STRING, bfeh AS INTEGER
IF weiter = 0 THEN
cpalt = POS(0): clalt = CSRLIN
LOCATE 1, 1: COLOR MenufarbeV, MenufarbeH
PRINT SPACE(79): LOCATE 1, 30
LOCATE 1, 10
INPUT ; "Suche ab Zeile:", von
LOCATE 1, 35
INPUT ; " bis:", bis
LOCATE 1, 50
LINE INPUT ; "nach:", Suchstr
LOCATE 1, 1: PRINT SPACE(79)
LOCATE 1, 28: PRINT "Suche nach >"; Suchstr; "<"
IF bis = 0 THEN bis = zmax
su = von
Suchstr = UCASE(Suchstr)
such = Entfspace(Suchstr, LEN(Suchstr))
DO
Ustri = UCASE(Befehlsfeld(su))
Estri = Entfspace(Ustri, LEN(Ustri))
bfeh = INSTR(Estri, Suchstr)
su = su + 1
LOOP UNTIL (su > bis) OR (bfeh > 0)
LOCATE 1, 28
COLOR MenufarbeV, MenufarbeH: PRINT STRING(51, 32): COLOR GrundfarbeV, GrundfarbeH
LOCATE clalt, cpalt
ELSE
WHILE (su <= bis) AND (bfeh = 0)
Ustri = UCASE(Befehlsfeld(su))
Estri = Entfspace(Ustri, LEN(Ustri))
bfeh = INSTR(Estri, Suchstr)
su = su + 1
WEND
END IF
z = 3: l = su - 1
END SUB
SUB transfup (Nos AS INTEGER)
DIM eintr(64) as STRING, neg(64) as STRING
DIM schl AS INTEGER, z AS INTEGER, Nende AS INTEGER, sp AS INTEGER, zf AS INTEGER, b AS STRING, ersterkasten AS INTEGER
DIM balt AS STRING, banz AS INTEGER, evar AS INTEGER, zalt AS INTEGER
DIM O AS STRING, klammerauf AS INTEGER, KeinAusgang AS INTEGER, bk AS STRING
dim in as STRING
schl = 0: z = 0: LetztesNetzwerk = 0: keinNetzwerk = 0: grenze = 0: Nende = 0
sp = 78: spmin = 78: zf = 1: tpneu = 0: sgrenze = 0: wgrenze = 0: BLDanz = 0
' Wenn das Feld leer ist,die minimalen Befehle einfgen
IF LEFT(Befehlsfeld(z), 2) = "BE" OR ASC(Befehlsfeld(z)) = 0 THEN
nachricht "Eingabe": fupmenu
Befehlsfeld(0) = "= ??????"
Befehlsfeld(1) = "***"
Befehlsfeld(2) = "BE "
zmax = 3
END IF
IF LEFT(Befehlsfeld(z), 3) = "***" THEN Nende = 1: fupmenu: GOTO exitf
'Wenn die Ansicht in AWL ge„ndert worden ist
IF (topline + zeile - 3) <> toplinefupalt THEN
DO UNTIL z >= topline + zeile - 3 '#### suche nach Netzwerk - offset ###
b = RTRIM(LEFT(Befehlsfeld(z), 13))
IF LEFT(b, 3) = "***" THEN BLDanz = BLDanz + 1: tpneu = z + 1
IF RTRIM(LEFT(Befehlsfeld(z + 1), 13)) = "BE" THEN nachricht "Kein Nachfolge-Netzwerk!": LetztesNetzwerk = 1: fupmenu: GOTO exitf
z = z + 1
LOOP
zeile = 3: Nos = BLDanz: z = tpneu
ELSE 'wenn keine awl-Žnderung dann nach normalel Netzweroffset suchen
DO UNTIL BLDanz >= Nos '#### suche Netzwerk nach offset ###
b = RTRIM(LEFT(Befehlsfeld(z), 13))
IF LEFT(b, 3) = "***" THEN BLDanz = BLDanz + 1
IF LEFT(Befehlsfeld(z + 1), 2) = "BE" THEN nachricht "Kein Nachfolge-Netzwerk!": LetztesNetzwerk = 1: fupmenu: GOTO exitf
z = z + 1
LOOP
END IF
'So, der Offset steht fest. Variablen init
zoffset = z: topline = z: toplinefupalt = topline
loescheFup
b = RTRIM(MID(Befehlsfeld(z), 1, 6)): balt = b
ersterkasten = 1: IF LEFT(b, 3) = "***" THEN GOTO exitf
'z steht auf 1.Befehl des zu bersetzenden Netzwerks
DO ' #### bersetze awl ####
banz = 0
b = RTRIM(MID(Befehlsfeld(z), 1, 6))
evar = 0
SELECT CASE LEFT(Befehlsfeld(z), 2)
CASE "U ","UN","O ","ON": evar = 1
END SELECT
IF evar = 1 THEN ' ######### wenn eingang verknpfung #############
DO
b = RTRIM(MID(Befehlsfeld(z), 1, 6))
O = MID(Befehlsfeld(z), 7, 2) + MID(Befehlsfeld(z), 9, 4)
IF klammerauf = 1 THEN
banz = banz + 1: neg(banz) = statusselect(z - 2)
eintr(banz) = ""
banz = banz + 1: neg(banz) = "Ù ³": eintr(banz) = "":
klammerauf = 0: klammer bk,b,z,zoffset,zf,banz,neg() ,eintr() ,zalt,sp,O,klammerauf
END IF
IF MID(b, 2, 1) = "(" THEN
IF LEFT(b, 1) = LEFT(balt, 1) THEN klammer bk,b,z,zoffset,zf,banz,neg() ,eintr() ,zalt,sp,O,klammerauf ELSE klammerauf = 1
END IF ' ######## Klammer auf #######
z = z + 1: banz = banz + 1
IF banz = 1 AND ersterkasten = 0 THEN
neg(banz) = statusselect(z - 2)
eintr(banz) = "": banz = banz + 1
neg(banz) = "Ù ³": eintr(banz) = "": banz = banz + 1:
END IF
IF status > 0 THEN
SELECT CASE MID(assfeld(z - 1), 2, 2)
CASE "HH"
IF MID(b, 2, 1) = "N" THEN neg(banz) = "=o´" ELSE neg(banz) = "==´"
CASE "HL"
IF MID(b, 2, 1) = "N" THEN neg(banz) = "=o\" ELSE neg(banz) = "==\"
CASE "LH"
IF MID(b, 2, 1) = "N" THEN neg(banz) = "-o´" ELSE neg(banz) = "--´"
CASE "LL"
IF MID(b, 2, 1) = "N" THEN neg(banz) = "-o\" ELSE neg(banz) = "--\"
CASE ELSE
IF MID(b, 2, 1) = "N" THEN neg(banz) = "-o+" ELSE neg(banz) = "--+"
END SELECT
ELSE
IF MID(b, 2, 1) = "N" THEN neg(banz) = "Äo´" ELSE neg(banz) = "ÄÄ´"
END IF
eintr(banz) = O: cufeld(z - zoffset - 1).culin = zf - 1 + banz: cufeld(z - zoffset - 1).cupos = sp
LOOP UNTIL LEFT(b, 1) <> LEFT(balt, 1)
ersterkasten = 0
SELECT CASE balt
CASE "U(": in = " & "
CASE "U": in = " & "
CASE "O(": in = ">=1"
CASE "O": in = ">=1"
CASE "UN": in = " & "
CASE "ON": in = ">=1"
'CASE "!=F": in = "!=F"
'CASE "> F": in = "> F"
'CASE "< F": in = "< F"
CASE "UBD0": in = "UB0"
CASE "UBD1": in = "UB1"
END SELECT
IF zf + banz - 2 > 59 THEN errbld = 1: GOTO exitf
evar = 1: z = z - 1
IF balt <> "***" AND evar = 1 THEN VKKasten sp, zf, eintr() , neg() , banz - 1, in, z
zf = zf + banz - 2: sp = sp + 6
IF zf > 56 THEN sgrenze = 1
ELSE ' ############## wenn ausgangs verknpfung #############
sp = sp - 6
IF LEFT(Befehlsfeld(z), 3) = "***" THEN KeinAusgang = 0 ELSE KeinAusgang = 1
DO
b = RTRIM(MID(Befehlsfeld(z), 1, 6))
O = MID(Befehlsfeld(z), 7, 6)
z = z + 1
cufeld(z - zoffset - 1).culin = zf + banz * 3: cufeld(z - zoffset - 1).cupos = sp + 23
banz = banz + 1
evar = 0
SELECT CASE LEN(b)
CASE 0: ou(banz) = "NOP 0"
CASE 1: ou(banz) = " " + b + " "
CASE 2: ou(banz) = " " + b + " "
CASE 3: ou(banz) = " " + b + " "
CASE 4: ou(banz) = " " + b
CASE ELSE: ou(banz) = b
END SELECT
eintr(banz) = O
IF zf + banz * 3 > 56 THEN sgrenze = 1
IF zf + banz * 3 > 59 THEN errbld = 1
LOOP UNTIL LEFT(b, 3) = "***" OR errbld = 1
IF errbld = 1 THEN GOTO exitf
IF LEFT(balt, 3) <> "***" THEN AGKasten sp + 14, zf, banz - 1, eintr() , ou() , z
evar = 0
END IF
balt = b
LOOP UNTIL LEFT(b, 3) = "***" OR b = "BE" OR errbld = 1
Letztepos = z - zoffset - (1 * KeinAusgang)
cufeld(Letztepos).culin = fmax: cufeld(Letztepos).cupos = sp + 23
MID(fupf(fmax + 1), sp + 23, 3) = "***"
IF sp + 23 - spmin > 70 THEN wgrenze = 1
IF sp + 23 - spmin > 76 THEN errbld = 1: GOTO exitf
grenze = wgrenze OR sgrenze
EXIT SUB
exitf:
loescheFup
IF errbld = 1 THEN nachricht "Netzwerk wegen BLD-Grenze nicht bersetzbar !!"
IF Nende = 1 THEN EXIT SUB
IF keinNetzwerk = 1 THEN Nos = 0: EXIT SUB
IF Nos > 0 THEN Nos = Nos - 1 ELSE Nos = 0
END SUB
sub klammer(bk as STRING,b as STRING,z AS INTEGER,zoffset AS INTEGER,zf AS INTEGER,banz AS INTEGER,neg() as STRING,eintr() as STRING,zalt AS INTEGER,sp AS INTEGER,O as STRING,klammerauf AS INTEGER)
bk = b
DO
cufeld(z - zoffset).culin = zf + banz: cufeld(z - zoffset).cupos = sp - 6
banz = banz + 1: neg(banz) = "¿ ³": eintr(banz) = "":
zalt = z: sp = sp - 6
eingang z, sp, zf + banz
DO UNTIL zalt >= z - 3
banz = banz + 1: neg(banz) = "³ ³": eintr(banz) = "":
zalt = zalt + 1
LOOP
banz = banz + 1: neg(banz) = statusselect(z - 2): eintr(banz) = "":
banz = banz + 1: neg(banz) = "Ù ³": eintr(banz) = "":
b = RTRIM(MID(Befehlsfeld(z), 1, 6))
O = MID(Befehlsfeld(z), 7, 2) + MID(Befehlsfeld(z), 9, 4)
LOOP UNTIL MID(b, 1, 2) <> MID(bk, 1, 2)
IF MID(b, 2, 1) = "(" THEN klammerauf = 1
end sub
sub loescheFup ()
dim lfup AS INTEGER
FOR lfup = 0 TO 64' ##### l”sche alten Feldinhalt #####
fupf(lfup) = ""
cufeld(lfup).culin = 0
cufeld(lfup).cupos = 0
NEXT
end sub
SUB Uebernehme (zeile2, topline2)
DIM Kommentar AS STRING, zeileALT as INTEGER, cursoraltpos as INTEGER, Zeichenpos as INTEGER, Befehlzeile AS STRING
DIM Ostringhin AS STRING, Ostrrueck AS STRING, alt AS STRING, brueck AS STRING
dim Befehlzeilealt as STRING
DIM z as INTEGER
Kommentar = ""': speicher = FRE("")
zeileALT = CSRLIN: cursoraltpos = POS(0): LOCATE , , 0
FOR Zeichenpos = 14 TO 32
z=(SCREEN(zeile2, Zeichenpos))
if z=0 then z=32
Befehlzeilealt = Befehlzeilealt +chr(z)
NEXT
IF INSTR(Befehlzeilealt,":") = 0 THEN
Befehlzeile = UCASE(Befehlzeilealt)
' If LEFT(Befehlzeile,3)="SZP" or LEFT(Befehlzeile,4)="ZEIT" THEN
' Format Befehlzeile, brueck
' ELSE
select case LEFT(Befehlzeile,3)
case "LPD","SPB"
brueck = UCASE(LEFT(Befehlzeilealt,4))+ MID(Befehlzeilealt,5,14)
case "SZP"
Format Befehlzeile, brueck
' brueck = UCASE(LEFT(Befehlzeilealt,4))+ MID(Befehlzeilealt,5,14)
case "ZEI"
' brueck = UCASE(LEFT(Befehlzeilealt,5))+ MID(Befehlzeilealt,5,14)
Format Befehlzeile, brueck
'IF LEFT(Befehlzeile,4)<>"LPDI" and LEFT(Befehlzeile,3)<>"SPB" THEN
case ELSE
Format Befehlzeile, brueck
Ostringhin = MID(brueck, 7, 6)
Operantenformat Ostringhin, Ostrrueck, alt
brueck = LEFT(brueck, 6) + RTRIM(Ostrrueck)
END select
' END IF
else
brueck = Befehlzeilealt 'Bei Zeile mit doppelpunkt alles lassen
END IF
FOR Zeichenpos = 40 TO 78
Kommentar = Kommentar + CHR(SCREEN(zeile2, Zeichenpos))
NEXT
IF zeile2 >= (Pufferbeginn - topline + 2) AND zeile2 <= (Pufferende - topline + 2) THEN COLOR GrundfarbeH, GrundfarbeV ELSE COLOR GrundfarbeV, GrundfarbeH
Kommentar = RTRIM(Kommentar)
LOCATE zeile2, 40: PRINT Kommentar + SPACE(38 - LEN(Kommentar))
brueck = brueck + SPACE(19 - LEN(brueck))
LOCATE zeile2, 14: PRINT brueck;
Befehlsfeld(zeile2 + topline2 - 3) = brueck + Kommentar
LOCATE zeileALT, cursoraltpos, 1
END SUB
SUB Uebertrage()
DIM ub, ack,ero,erolin,t,uebpos,uebzeil
InCodeSetzen ero,erolin ' ##### Text wird assembliert #####
IF ero = 1 THEN nachricht "Fehler in Zeile " + Str(erolin): EXIT SUB
OPEN COM "COM1:19200,N,8,1,CS0,DS0,CD0,BIN" FOR RANDOM AS #3
PRINT #3, CHR(1); 'Kommando 1=stop senden
t = TIMER
DO
IF TIMER - t > 1 THEN GOTO uebtrtimeout
LOOP UNTIL LOC(3)
ack = ASC(INPUT(1, #3))
uebzeil=csrlin:uebpos=pos()
FOR ub = 0 TO feldend
PRINT #3, CHR(2); 'Kommando 2 senden
t = TIMER
DO
IF TIMER - t > 1 THEN GOTO uebtrtimeout
LOOP UNTIL LOC(3)
ack = ASC(INPUT(1, #3))
PRINT #3, CHR(ub \ 256); ' High adr Byte senden
t = TIMER
DO
IF TIMER - t > 1 THEN GOTO uebtrtimeout
LOOP UNTIL LOC(3)
ack = ASC(INPUT(1, #3))
PRINT #3, CHR(ub AND &HFF); 'Low adr Byte senden
t = TIMER
DO
IF TIMER - t > 1 THEN GOTO uebtrtimeout
LOOP UNTIL LOC(3)
ack = ASC(INPUT(1, #3))
PRINT #3, CHR(feld(ub)); 'codeByte senden
t = TIMER
DO
IF TIMER - t > 1 THEN GOTO uebtrtimeout
LOOP UNTIL LOC(3)
ack = ASC(INPUT(1, #3))
locate 25,1:print str(int(ub/feldend*100))+"% bertragen ";
NEXT ub
locate 25,1:print" ";
't = TIMER
'DO
'IF TIMER - t > .01 THEN GOTO uebtrtimeout
'LOOP UNTIL LOC(3)
'ack = ASC(INPUT(1, #3))
t = TIMER
DO: LOOP UNTIL TIMER > (t+0.2)
PRINT #3, CHR(0);
CLOSE
locate uebzeil,uebpos
EXIT SUB
uebtrtimeout:
locate 25,1
PRINT "šbertragung-timeout";
sleep 1000
PRINT #3, CHR(0);
CLOSE
locate uebzeil,uebpos
END SUB
SUB VKKasten (x as INTEGER, y as INTEGER, eintr() as STRING, neg() as STRING, banz as INTEGER, in as STRING, stsz as INTEGER)
DIM banz2
IF x < spmin THEN spmin = x' ###### spalte minimum festhalten ######
MID(fupf(y), x + 8, 5) = "ÚÄÄÄ¿"
IF eintr(1) > "" THEN
MID(fupf(y + 1), x, 13) = eintr(1) + neg(1) + in + "³"
ELSE
MID(fupf(y + 1), x + 6, 8) = neg(1) + in + "³"
END IF
banz2 = 2
DO UNTIL banz2 > banz
IF eintr(banz2) > "" THEN
MID(fupf(y + banz2), x, 13) = eintr(banz2) + neg(banz2) + " ³"
ELSE
MID(fupf(y + banz2), x + 6, 8) = neg(banz2) + " ³"
END IF
banz2 = banz2 + 1
LOOP
MID(fupf(y + banz), x + 12, 3) = statusselect(stsz - banz + banz2 - 2)
MID(fupf(y + banz + 1), x + 8, 5) = "ÀÄÄÄÙ"
END SUB
SUB zeichnrahmen (SeiteOben as INTEGER, SeiteUnten as INTEGER, SeiteLinks as INTEGER, SeiteRechts as INTEGER) STATIC
CONST OLINKS = 201, ORECHTS = 187, ULINKS = 200, URECHTS = 188
CONST VERTIKAL = 186, Horizontal = 205
DIM Rahmenbreit as Integer, Zeil as Integer
Rahmenbreit = SeiteRechts - SeiteLinks - 1
LOCATE SeiteOben, SeiteLinks: COLOR RahmenfarbeV, RahmenfarbeH
PRINT CHR(OLINKS); STRING(Rahmenbreit, Horizontal); CHR(ORECHTS);
FOR Zeil = SeiteOben + 1 TO SeiteUnten - 1
LOCATE Zeil, SeiteLinks
PRINT CHR(VERTIKAL); SPACE(Rahmenbreit); CHR(VERTIKAL);
NEXT Zeil
LOCATE SeiteUnten, SeiteLinks
PRINT CHR(ULINKS); STRING(Rahmenbreit, Horizontal); CHR(URECHTS);
COLOR GrundfarbeV, GrundfarbeH
END SUB
SUB Zeigmenu (max as INTEGER, wahl as INTEGER, locsp as INTEGER, Bu1 as STRING, Rest as STRING)
DIM laenge as INTEGER, mfeld as INTEGER
laenge = LEN(Rest) \ max
FOR mfeld = 1 TO max
IF mfeld = wahl THEN COLOR Menufeld1invertfarbeV, Menufeld1invertfarbeH ELSE COLOR Menufeld1farbeV, Menufeld1farbeH
LOCATE mfeld + 2, locsp
PRINT " "; MID(Bu1, mfeld, 1);
IF mfeld = wahl THEN COLOR MenufeldinvertfarbeV, MenufeldinvertfarbeH ELSE COLOR MenufeldfarbeV, MenufeldfarbeH
LOCATE mfeld + 2, locsp + 2
PRINT MID(Rest, mfeld * laenge - laenge + 1, laenge);
NEXT
END SUB
SUB Zeileeinfuegen (lz as INTEGER)
DIM TRF as INTEGER
IF zmax < ElNr THEN zmax = zmax + 1
FOR TRF = zmax TO lz + 1 STEP -1
Befehlsfeld(TRF) = Befehlsfeld(TRF - 1)
NEXT TRF
Befehlsfeld(lz) = ""
'feld(lz) = 0
END SUB
SUB Zeileloeschen (lz as INTEGER)
DIM TRF as INTEGER
IF zmax > 0 THEN zmax = zmax - 1
FOR TRF = lz TO zmax
Befehlsfeld(TRF) = Befehlsfeld(TRF + 1)
feld(TRF) = feld(TRF + 1)
NEXT TRF
Befehlsfeld(zmax + 1) = ""
'feld(zmax + 1) = 0
END SUB
FUNCTION FStr(Zahl)as String ' setzt Zahlenformat ##
DIM ZAHLstr as String
if Zahl > -10 AND Zahl < 10 then
Zahlstr = "0"+STR(Zahl)
else
Zahlstr = STR(Zahl)
end if
FStr = Zahlstr
END Function
FUNCTION Zeitformat (urstring as STRING) as STRING 'Zahlenformat ##-##-##
DIM x as INTEGER, teilstrNR as INTEGER
DIM Zeitstr(2) as STRING,zfbu as STRING
teilstrNR=0:
if instr(urstring,"-")=0 then Zeitformat="hh-mm-ss !":exit FUNCTION
FOR x = 1 TO 8
zfbu = MID(urstring,x,1)
IF zfbu="-" THEN
SELECT case teilstrNR
case 0
if val(Zeitstr(teilstrNR))>23 THEN
Zeitstr(teilstrNR)="!!-"
ELSE
Zeitstr(teilstrNR)=FStr(VAL(Zeitstr(teilstrNR)))+"-"
END IF
case 1
if val(Zeitstr(teilstrNR))>59 THEN
Zeitstr(teilstrNR)="!!-"
ELSE
Zeitstr(teilstrNR)=FStr(VAL(Zeitstr(teilstrNR)))+"-"
END IF
END SELECT
teilstrNR = teilstrNR + 1
ELSE
Zeitstr(teilstrNR)=Zeitstr(teilstrNR)+zfbu
END IF
NEXT
if val(Zeitstr(2))>59 THEN
Zeitstr(2)="!!"
ELSE
Zeitstr(2)=FStr(VAL(Zeitstr(2)))
END IF
Zeitformat=Zeitstr(0)+Zeitstr(1)+Zeitstr(2)
END FUNCTION