Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

fehler bei exe erstellen
Gehe zu Seite 1, 2  Weiter
 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu QBasic.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 24.01.2012, 21:29    Titel: fehler bei exe erstellen Antworten mit Zitat

Hi Leute,

beim versuch eine exe zu erstellen hab ich folgende Meldungen

BC C:\......BAS/E/X/O/T/C:512;
Microsoft...... version 4.50
Copyright.......

3988 009E 0
^doppelte Marke
06D6 009E
^überlauf des Programmspeichers

43709 Bytes verfügbar
3048 Bytes frei

0 Warnungen
2 schwere Fehler

kann mir jemand sagen wo das Problem liegt bzw wie es beheben kann?
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 24.01.2012, 21:42    Titel: Antworten mit Zitat

42
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 24.01.2012, 21:51    Titel: Antworten mit Zitat

sorry aber was meinst du mit 42
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

BeitragVerfasst am: 24.01.2012, 21:57    Titel: Antworten mit Zitat

Dass man aus deiner Problembeschreibung absolut gar nichts ableiten kann. Wenn du uns deinen Code, mit dem das passiert, nicht zeigen möchtest, können wir auch nicht weiterhelfen (außer sagen: "Verwende FreeBASIC statt QuickBasic").
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 24.01.2012, 22:07    Titel: Antworten mit Zitat

[code:1:66db5ffe83]
DECLARE FUNCTION MouseInit% ()
DECLARE FUNCTION DateiExistiert% (d$)
DECLARE SUB MouseStatus (Lb%, Rb%, xMouse%, yMouse%)
DECLARE SUB MouseRange (X1%, Y1%, x2%, Y2%)
DECLARE SUB MousePut (x%, y%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
DECLARE SUB MouseShow ()
DECLARE SUB sequenz1 ()
DECLARE SUB laufini ()
DECLARE SUB schrift (ze%, sp%, bust$)
DECLARE SUB autowrite (c%, ze%, sp%, wort$)
DECLARE SUB Hallo (mClick$, phatlw$, phatprog$)
DECLARE SUB opti ()
DECLARE SUB kalender (wochentag$)
DECLARE SUB tour1 (phatprog$)
DECLARE SUB button (cb1%, cb2%, ze%, sp%, c%, wort$)
DECLARE SUB InText
CLEAR , , 2000
DEFINT A-Z: DEF SEG = &HA000:

DIM Tour AS STRING

DIM SHARED mouse$: mouse$ = SPACE$(57)
CLS
SCREEN 9
FOR m% = 1 TO 57: READ A$: H$ = CHR$(VAL("&H" + A$))
MID$(mouse$, m%, 1) = H$: NEXT m%
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00
CONST esc = 27
RESTORE
ms% = MouseInit%
IF NOT ms% THEN
PRINT "Mouse not found"
END
END IF
LOCATE 2, 30
PRINT "Mouse Control in QBasic"
MouseShow
MouseRange 401, 241, 629, 339

sequ1:
CALL sequenz1


CLOSE : OPEN "R", #1, "C:\mytourop.dat", 5
FIELD #1, 3 AS LWB$, 2 AS mxkl$
GET #1, 111: laufw1$ = LWB$
IF laufw1$ <> "xxx" THEN CALL laufini

CLOSE : OPEN "R", #1, "C:\mytourop.dat", 5
FIELD #1, 3 AS LWB$, 2 AS mxkl$
teil% = 1: GET #1, teil%: LWBU$ = LWB$

phatlw$ = LWBU$
phatprog$ = phatlw$ + "mytour\" '( c:\mytour\ ) Programm Ordner

menu1:
CALL Hallo(mClick$, phatlw$, phatprog$)





CLS
END



'
Fehler:
ex% = 0
RESUME NEXT

fehler2:
zahl = ERR
IF zahl = 53 THEN
CALL autowrite(4, 138, 15, "error: beim versuch die tmp-Datei zu l”schen wurde festgestellt das sie nicht existiert."):
SLEEP 3
END IF
RESUME NEXT

fehler3:
zahl = ERR
IF zahl = 53 THEN
CALL autowrite(c, 138, 15, "error: beim versuch die tour zu l”schen wurde festgestellt das sie nicht existiert."):
SLEEP 3
END IF
RESUME NEXT

fehler4:
OPEN "R", #2, phatprog$ + "tmp.dat", 255
FIELD #2, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$
RESUME NEXT

SUB autowrite (c, ze%, sp%, wort$)

COLOR c
FOR i = 1 TO LEN(wort$)
bust$ = MID$(wort$, i, 1)

IF bust$ = "a" OR bust$ = "A" THEN PSET (sp%, ze% + 4): DRAW "u3 e1 r2 d4 u2 l3": sp% = sp% + 6: GOTO awende 'A
IF bust$ = "„" OR bust$ = "Ž" THEN PSET (sp%, ze% + 4): DRAW "u2 e2 f2 d2 u2 l4 bu3 u0 br4 d0": sp% = sp% + 7: GOTO awende'Ž
IF bust$ = "b" OR bust$ = "B" THEN PSET (sp%, ze%): DRAW "d4 r2 e1 f-1 l1 r1 e1 f-1 l2": sp% = sp% + 6: GOTO awende 'B
IF bust$ = "c" OR bust$ = "C" THEN PSET (sp% + 3, ze%): DRAW "l2 g1 d2 f1 r2": sp% = sp% + 6: GOTO awende 'C
IF bust$ = "d" OR bust$ = "D" THEN PSET (sp%, ze%): DRAW "d4 r2 e1 u2 h1 l2": sp% = sp% + 6: GOTO awende 'D
IF bust$ = "e" OR bust$ = "E" THEN PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2 r3": sp% = sp% + 6: GOTO awende 'E
IF bust$ = "f" OR bust$ = "F" THEN PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2": sp% = sp% + 6: GOTO awende 'F
IF bust$ = "g" OR bust$ = "G" THEN PSET (sp% + 3, ze%): DRAW "l2 g1 d2 f1 r2 u2 l1": sp% = sp% + 6: GOTO awende 'G
IF bust$ = "h" OR bust$ = "H" THEN PSET (sp%, ze%): DRAW "d4 u2 r3 u2 d4": sp% = sp% + 6: GOTO awende 'H
IF bust$ = "i" OR bust$ = "I" THEN PSET (sp% + 2, ze%): DRAW "d4": sp% = sp% + 6: GOTO awende 'I
IF bust$ = "j" OR bust$ = "J" THEN PSET (sp%, ze%): DRAW "r3 d3 g1 l1 h1": sp% = sp% + 6: GOTO awende 'J
IF bust$ = "k" OR bust$ = "K" THEN PSET (sp%, ze%): DRAW "d4 u2 r1 e2 g2 f2": sp% = sp% + 6: GOTO awende 'K
IF bust$ = "l" OR bust$ = "L" THEN PSET (sp%, ze%): DRAW "d4 r3": sp% = sp% + 6: GOTO awende 'L
IF bust$ = "m" OR bust$ = "M" THEN PSET (sp%, ze% + 4): DRAW "u4 f2 e2 d4": sp% = sp% + 6: GOTO awende 'M
IF bust$ = "n" OR bust$ = "N" THEN PSET (sp%, ze% + 4): DRAW "u4 f4 u4": sp% = sp% + 6: GOTO awende 'N
IF bust$ = "o" OR bust$ = "O" THEN PSET (sp%, ze% + 1): DRAW "d2 f1 r1 e1 u2 h1 l1": sp% = sp% + 6: GOTO awende 'O
IF bust$ = "p" OR bust$ = "P" THEN PSET (sp%, ze% + 4): DRAW "u4 r2 f1 g1 l1": sp% = sp% + 6: GOTO awende 'P
IF bust$ = "q" OR bust$ = "Q" THEN PSET (sp%, ze% + 1): DRAW "d2 f1 r1 e1 f1 h1 u2 h1 l1": sp% = sp% + 7: GOTO awende 'Q
IF bust$ = "r" OR bust$ = "R" THEN PSET (sp%, ze% + 4): DRAW "u4 r2 f1 e-1 l1 f2": sp% = sp% + 6: GOTO awende 'R
IF bust$ = "s" OR bust$ = "S" THEN PSET (sp%, ze% + 4): DRAW "r2 e1 f-1 l1 f-1 e1 r2": sp% = sp% + 6: GOTO awende 'S
IF bust$ = "t" OR bust$ = "T" THEN PSET (sp%, ze%): DRAW "r2 d4 u4 r2": sp% = sp% + 6: GOTO awende 'T
IF bust$ = "u" OR bust$ = "U" THEN PSET (sp%, ze%): DRAW "d4 r3 u4": sp% = sp% + 6: GOTO awende 'U
IF bust$ = "" OR bust$ = "š" THEN PSET (sp%, ze% - 1): DRAW "bd2 d3 r3 u3 bu2 u0": sp% = sp% + 6: GOTO awende 'U
IF bust$ = "v" OR bust$ = "V" THEN PSET (sp%, ze%): DRAW "d2 f2 e2 u2": sp% = sp% + 7: GOTO awende 'V
IF bust$ = "w" OR bust$ = "W" THEN PSET (sp%, ze%): DRAW "d4 e2 f2 u4": sp% = sp% + 6: GOTO awende 'W
IF bust$ = "x" OR bust$ = "X" THEN PSET (sp%, ze%): DRAW "f4 h2 g2 e4": sp% = sp% + 6: GOTO awende 'X
IF bust$ = "y" OR bust$ = "Y" THEN PSET (sp%, ze%): DRAW "d2 r3 u2 d4 l2": sp% = sp% + 6: GOTO awende 'Y
IF bust$ = "z" OR bust$ = "Z" THEN PSET (sp%, ze% + 1): DRAW "u1 r3 g3 d1 r3 u1": sp% = sp% + 6: GOTO awende 'Z

IF bust$ = "0" THEN PSET (sp%, ze% + 1): DRAW "d2 f1 r2 e1 u2 h1 l2": sp% = sp% + 6: GOTO awende '0
IF bust$ = "1" THEN PSET (sp% + 2, ze% + 4): DRAW "u4 g2": sp% = sp% + 6: GOTO awende 'I
IF bust$ = "2" THEN PSET (sp%, ze% + 1): DRAW "e1 r1 f1 g3 r3": sp% = sp% + 6: GOTO awende '2
IF bust$ = "3" THEN PSET (sp%, ze% + 4): DRAW "r2 e1 f-1 l1 r1 e1 f-1 l2": sp% = sp% + 6: GOTO awende '3
IF bust$ = "4" THEN PSET (sp% + 2, ze% + 4): DRAW "u4 g2 d1 r3": sp% = sp% + 6: GOTO awende '4
IF bust$ = "5" THEN PSET (sp%, ze% + 4): DRAW "r2 e1 h1 l2 u2 r3": sp% = sp% + 6: GOTO awende '5
IF bust$ = "6" THEN PSET (sp% + 2, ze%): DRAW "l1 g1 d2 f1 r1 e1 h1 l1": sp% = sp% + 6: GOTO awende '6
IF bust$ = "7" THEN PSET (sp%, ze% + 1): DRAW "u1 r3 d1 g3": sp% = sp% + 6: GOTO awende '7
IF bust$ = "8" THEN PSET (sp%, ze% + 1): DRAW "f1 g1 f1 r1 e1 h1 e1 h1 l1": sp% = sp% + 6: GOTO awende '8
IF bust$ = "9" THEN PSET (sp% + 2, ze% + 2): DRAW "l1 h1 e1 r1 f1 d2 g1 l1": sp% = sp% + 6: GOTO awende '9

IF bust$ = "%" THEN PSET (sp%, ze%): PSET (sp% + 4, ze% + 4): PSET (sp%, ze% + 4): DRAW "e4": sp% = sp% + 8: GOTO awende '%
IF bust$ = ">" THEN PSET (sp% + 1, ze% + 4): DRAW "e2 h2": sp% = sp% + 6: GOTO awende'>
IF bust$ = "<" THEN PSET (sp% + 4, ze% + 4): DRAW "h2 e2": sp% = sp% + 6: GOTO awende'>
IF bust$ = "/" THEN PSET (sp% + 1, ze% + 4): DRAW "u1 e2 u1": sp% = sp% + 6: GOTO awende '/
IF bust$ = "\" THEN PSET (sp% + 3, ze% + 4): DRAW "u1 h2 u1": sp% = sp% + 6: GOTO awende '/
IF bust$ = "_" THEN PSET (sp%, ze% + 4): DRAW "r4": sp% = sp% + 6: GOTO awende '_
IF bust$ = "+" THEN PSET (sp% + 1, ze% + 2): DRAW "r2 l1 u1 d2": sp% = sp% + 6: GOTO awende '+
IF bust$ = "-" THEN PSET (sp% + 1, ze% + 2): DRAW "r2": sp% = sp% + 6: GOTO awende '-
IF bust$ = "." THEN PSET (sp% + 2, ze% + 4): DRAW "": sp% = sp% + 6: GOTO awende '.
IF bust$ = "," THEN PSET (sp% + 2, ze% + 4): DRAW "g1": sp% = sp% + 6: GOTO awende ',
IF bust$ = ":" THEN PSET (sp% + 2, ze% + 4): PSET (sp% + 2, ze% + 2): sp% = sp% + 6: GOTO awende ':
IF bust$ = " " THEN sp% = sp% + 6: GOTO awende 'leer

PSET (sp%, ze% + 4): DRAW "r4": sp% = sp% + 6
awende:

NEXT i


END SUB

SUB button (cb1%, cb2%, ze%, sp%, c%, wort$)


LINE (sp%, ze%)-STEP(80, 10), cb1%, BF
LINE (sp% + 1, ze% + 1)-STEP(80, 10), cb2%, BF
halbewortlaenge = LEN(wort$) * 6 / 2
sp% = sp% + 42 - halbewortlaenge
CALL autowrite(c%, ze% + 4, sp%, wort$)

END SUB

DEFSNG A-Z
'
FUNCTION DateiExistiert% (d$)
SHARED ex%
'
ex% = -1
ON ERROR GOTO Fehler
OPEN d$ FOR INPUT AS 1
CLOSE 1
ON ERROR GOTO 0
DateiExistiert% = ex%
END FUNCTION

DEFINT A-Z
SUB Hallo (mClick$, phatlw$, phatprog$)
oben:
CLS 'R A H M E N U N D S c h a l t e r


COLOR 4
LOCATE 9, 41: PRINT "M y T o u r"
sp% = 300: ze% = 124: CALL autowrite(15, ze%, sp%, "by braesident")

LINE (430, 280)-(510, 290), 7, BF 'Tour '
LINE (431, 281)-(511, 291), 9, BF 'Tour '
LINE (540, 280)-(620, 290), 7, BF 'Lager '
LINE (541, 281)-(621, 291), 9, BF 'Lager '
' Schaltfl„chen
LINE (430, 305)-(510, 315), 7, BF 'Option '
LINE (431, 306)-(511, 316), 9, BF 'Option '
LINE (540, 305)-(620, 315), 7, BF 'Exit '
LINE (541, 306)-(621, 316), 9, BF 'Exit '

'______________ B E S C H R I F T U N G __________________________
' -----------------------
sp% = 459: ze% = 284: CALL autowrite(1, ze%, sp%, "tour")
sp% = 567: ze% = 284: CALL autowrite(1, ze%, sp%, "lager")
sp% = 454: ze% = 309: CALL autowrite(1, ze%, sp%, "option")

sp% = 565: ze% = 309
COLOR 7
PSET (sp%, ze% + 5): DRAW "r3 u6 r5 d6 r30": sp% = sp% + 4
COLOR 2
PSET (sp%, ze% + 5): DRAW "u5 r1 d5 r1 u5 r1 d5": sp% = sp% + 8

CALL autowrite(1, ze%, sp%, "exit")

DO 'Maus WarteSchleife
MouseStatus Lb%, Rb%, x, y
LOCATE 1, 1: PRINT x; y
LINE (400, 240)-(630, 340), , B
IF INKEY$ = CHR$(esc) THEN END
SELECT CASE Lb%
CASE -1: GOTO coord1:
END SELECT
SELECT CASE Rb%
CASE -1: END
END SELECT
LOOP

coord1: 'M A U S-Auswertung
LINE (400, 240)-(630, 340), 0, BF
IF x > 230 AND x < 311 AND y > 165 AND y < 176 THEN CALL opti
IF x > 430 AND x < 511 AND y > 280 AND y < 291 THEN CALL tour1(phatprog$)

IF x > 340 AND x < 421 AND y > 140 AND y < 151 THEN 'Lager
COLOR 4: LOCATE 1, 1: PRINT "ACHTUNG Programm hier nicht weiter berarbeitet - ENDE": SLEEP 2: END
END IF
IF x > 340 AND x < 421 AND y > 165 AND y < 176 THEN GOTO unten
SLEEP 1: GOTO oben



unten:
SLEEP 1
END SUB

SUB kalender (wochentag$)
am% = VAL(MID$(DATE$, 1, 2)) 'zieht den monat
AT% = VAL(MID$(DATE$, 4, 2)) 'zieht den tag
aj! = VAL(MID$(DATE$, 8, 3)) 'zieht das jahr ohne 2000
vj! = aj! 'zieht das aktuelle jahr ab
schjahr! = vj! / 4 + 1 'errechnet d. schaltjahre incl. dem 2000er
schjahr% = schjahr!
schjahr2! = schjahr! - schjahr%
IF schjahr2! = -.25 THEN
schjahr% = schjahr% - 1
END IF
IF schjahr2! = 0 THEN schjahr% = schjahr% - 1
'--------------------------------------------------------
'monate und tage (aktuelles jahr)
IF schjahr2! = 0 THEN GOTO akttage: ELSE am2% = 0
goback:
am% = am% - 1
IF am% = 0 THEN am% = 0
IF am% = 1 THEN am% = 31
IF am% = 2 THEN am% = 59
IF am% = 3 THEN am% = 90
IF am% = 4 THEN am% = 120
IF am% = 5 THEN am% = 151
IF am% = 6 THEN am% = 181
IF am% = 7 THEN am% = 212
IF am% = 8 THEN am% = 243
IF am% = 9 THEN am% = 273
IF am% = 10 THEN am% = 304
IF am% = 11 THEN am% = 334
aktage% = am% + AT% + am2%
vj! = vj! - schjahr%
vjt% = vj! * 365
vscht% = schjahr% * 366
alletage% = aktage% + vjt% + vscht%
alletage! = alletage%
allet! = alletage! / 7
allet% = allet!
allet2! = allet! - allet%
IF allet2! < 0 THEN
allet% = allet% - 1
END IF
kalschl:
IF alletage% > 7 THEN alletage% = alletage% - allet%: GOTO kalschl:
IF alletage% = 0 THEN wochentag$ = "Freitag"
IF alletage% = 1 THEN wochentag$ = "Samstag"
IF alletage% = 2 THEN wochentag$ = "Sonntag"
IF alletage% = 3 THEN wochentag$ = "Montag"
IF alletage% = 4 THEN wochentag$ = "Dienstag"
IF alletage% = 5 THEN wochentag$ = "Mittwoch"
IF alletage% = 6 THEN wochentag$ = "Donnerstag"

GOTO kalende:
akttage:
IF am% > 2 THEN am2% = 1 ELSE am2% = 0
GOTO goback:
kalende:
END SUB

SUB laufini

COLOR 4
LINE (201, 180)-(449, 180)
LOCATE 9, 31: PRINT "- - M y T o u r - -"
COLOR 15
sp% = 330: ze% = 122
PSET (sp%, ze%): DRAW "d4 r2 e1 f-1 l1 r1 e1 f-1 l2": sp% = sp% + 6 'B
PSET (sp%, ze%): DRAW "d2 r3 u2 d4 l2": sp% = sp% + 6 'Y
sp% = sp% + 6
PSET (sp%, ze%): DRAW "d4 r2 e1 f-1 l1 r1 e1 f-1 l2": sp% = sp% + 6 'B
PSET (sp%, ze% + 4): DRAW "u4 r2 f1 e-1 l1 f2": sp% = sp% + 6 'R
PSET (sp%, ze% + 4): DRAW "u3 e1 r2 d4 u2 l3": sp% = sp% + 6 'A
PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2 r3": sp% = sp% + 6 'E
PSET (sp%, ze% + 4): DRAW "r2 e1 f-1 l1 f-1 e1 r2": sp% = sp% + 6 'S
PSET (sp% + 2, ze%): DRAW "d4": sp% = sp% + 6 'I
PSET (sp%, ze%): DRAW "d4 r2 e1 u2 h1 l2": sp% = sp% + 6 'D
PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2 r3": sp% = sp% + 6 'E
PSET (sp%, ze% + 4): DRAW "u4 f4 u4": sp% = sp% + 6 'N
PSET (sp%, ze%): DRAW "r2 d4 u4 r2": sp% = sp% + 6 'T

sp% = 248: ze% = 144
PSET (sp%, ze%): DRAW "d4 r3": sp% = sp% + 6 'L
PSET (sp%, ze% + 4): DRAW "u3 e1 r2 d4 u2 l3": sp% = sp% + 6 'A
PSET (sp%, ze%): DRAW "d4 r3 u4": sp% = sp% + 6 'U
PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2": sp% = sp% + 6 'F
PSET (sp%, ze%): DRAW "d4 e2 f2 u4": sp% = sp% + 6 'W
PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2 r3": sp% = sp% + 6 'E
PSET (sp%, ze% + 4): DRAW "u4 r2 f1 e-1 l1 f2": sp% = sp% + 6 'R
PSET (sp%, ze%): DRAW "d4 u2 r1 e2 g2 f2": sp% = sp% + 6 'K

lwin:
CLOSE : OPEN "R", #1, "C:\mytourop.dat", 5
FIELD #1, 3 AS LWB$, 2 AS mxkl$

COLOR 8
teil% = 1
GET #1, teil%
LOCATE 14, 27: PRINT "z.B:c:\", LWB$

COLOR 3
LOCATE 14, 34: INPUT "", katlaufw$

IF katlaufw$ = "" AND LWB$ = "" THEN GOTO lwin

IF katlaufw$ = "" THEN katlaufw$ = LWB$

LSET LWB$ = katlaufw$
PUT #1, teil%

teil% = 111
GET #1, teil%
lwok$ = "xxx"
LSET LWB$ = lwok$
PUT #1, teil%



END SUB

DEFLNG A-Z
SUB MouseDriver (ax%, bx%, cx%, dx%)
DEF SEG = VARSEG(mouse$)
mouse% = SADD(mouse$)
CALL Absolute(ax%, bx%, cx%, dx%, mouse%)
END SUB

SUB MouseHide
ax% = 2
MouseDriver ax%, 0, 0, 0
END SUB

FUNCTION MouseInit%
ax% = 0
MouseDriver ax%, 0, 0, 0
MouseInit% = ax%
END FUNCTION

SUB MousePut (x%, y%)
ax% = 4
cx% = x%
dx% = y%
MouseDriver ax%, 0, cx%, dx%
END SUB

SUB MouseRange (X1%, Y1%, x2%, Y2%)
ax% = 7
cx% = X1%
dx% = x2%
MouseDriver ax%, 0, cx%, dx%
ax% = 8
cx% = Y1%
dx% = Y2%
MouseDriver ax%, 0, cx%, dx%
END SUB

SUB MouseShow
ax% = 1
MouseDriver ax%, 0, 0, 0
END SUB

SUB MouseStatus (Lb%, Rb%, xMouse%, yMouse%)
ax% = 3
MouseDriver ax%, bx%, cx%, dx%
Lb% = ((bx% AND 1) <> 0)
Rb% = ((bx% AND 2) <> 0)
xMouse% = cx%
yMouse% = dx%
END SUB

DEFINT A-Z
SUB opti
SLEEP 1

CLOSE : OPEN "R", #1, "C:\optishop.dat", 3
FIELD #1, 1 AS LWB$, 2 AS PANZ$
teil% = 1: GET #1, teil%: LWBU$ = LWB$

phat1$ = LWBU$ + ":\TSLshop\option.dat"


opti1: CLS
SCREEN 9: COLOR 6
MouseRange 201, 101, 449, 199
ausw = 1

LINE (230, 140)-(310, 150), 7, BF 'Laufwerk
LINE (231, 141)-(311, 151), 9, BF 'Laufwerk
LINE (340, 140)-(420, 150), 7, BF 'Suchen
LINE (341, 141)-(421, 151), 9, BF 'Suchen

LINE (230, 165)-(310, 175), 7, BF 'Option
LINE (231, 166)-(311, 176), 9, BF 'Option
LINE (340, 165)-(420, 175), 7, BF 'Exit
LINE (341, 166)-(421, 176), 9, BF 'Exit
COLOR 4
LINE (201, 180)-(449, 180)
LOCATE 9, 31: PRINT "TSL - G e t r „ n k e"
COLOR 15
sp% = 330: ze% = 122
PSET (sp%, ze%): DRAW "d4 r2 e1 f-1 l1 r1 e1 f-1 l2": sp% = sp% + 6 'B
PSET (sp%, ze%): DRAW "d2 r3 u2 d4 l2": sp% = sp% + 6 'Y
sp% = sp% + 6
PSET (sp%, ze%): DRAW "d4 r2 e1 f-1 l1 r1 e1 f-1 l2": sp% = sp% + 6 'B
PSET (sp%, ze% + 4): DRAW "u4 r2 f1 e-1 l1 f2": sp% = sp% + 6 'R
PSET (sp%, ze% + 4): DRAW "u3 e1 r2 d4 u2 l3": sp% = sp% + 6 'A
PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2 r3": sp% = sp% + 6 'E
PSET (sp%, ze% + 4): DRAW "r2 e1 f-1 l1 f-1 e1 r2": sp% = sp% + 6 'S
PSET (sp% + 2, ze%): DRAW "d4": sp% = sp% + 6 'I
PSET (sp%, ze%): DRAW "d4 r2 e1 u2 h1 l2": sp% = sp% + 6 'D
PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2 r3": sp% = sp% + 6 'E
PSET (sp%, ze% + 4): DRAW "u4 f4 u4": sp% = sp% + 6 'N
PSET (sp%, ze%): DRAW "r2 d4 u4 r2": sp% = sp% + 6 'T
DO
MouseStatus Lb%, Rb%, x, y

COLOR 1

sp% = 248: ze% = 144
PSET (sp%, ze%): DRAW "d4 r3": sp% = sp% + 6 'L
PSET (sp%, ze% + 4): DRAW "u3 e1 r2 d4 u2 l3": sp% = sp% + 6 'A
PSET (sp%, ze%): DRAW "d4 r3 u4": sp% = sp% + 6 'U
PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2": sp% = sp% + 6 'F
PSET (sp%, ze%): DRAW "d4 e2 f2 u4": sp% = sp% + 6 'W
PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2 r3": sp% = sp% + 6 'E
PSET (sp%, ze% + 4): DRAW "u4 r2 f1 e-1 l1 f2": sp% = sp% + 6 'R
PSET (sp%, ze%): DRAW "d4 u2 r1 e2 g2 f2": sp% = sp% + 6 'K


LINE (200, 100)-(450, 200), , B
IF INKEY$ = CHR$(esc) THEN GOTO endopti:
SELECT CASE Lb%
CASE -1:
IF x > 230 AND x < 311 AND y > 140 AND y < 151 THEN CALL laufini 'laufwerk

GOTO opti1:

END SELECT
SELECT CASE Rb%
CASE -1: END
END SELECT

LOOP


endopti:
SLEEP 1
END SUB

SUB schrift (ze%, sp%, bust$)
IF bust$ = "a" OR bust$ = "A" THEN PSET (sp%, ze% + 4): DRAW "u3 e1 r2 d4 u2 l3": sp% = sp% + 6: GOTO schriftende 'A
IF bust$ = "b" OR bust$ = "B" THEN PSET (sp%, ze%): DRAW "d4 r2 e1 f-1 l1 r1 e1 f-1 l2": sp% = sp% + 6: GOTO schriftende 'B
IF bust$ = "c" OR bust$ = "C" THEN PSET (sp% + 3, ze%): DRAW "l2 g1 d2 f1 r2": sp% = sp% + 6: GOTO schriftende 'C
IF bust$ = "d" OR bust$ = "D" THEN PSET (sp%, ze%): DRAW "d4 r2 e1 u2 h1 l2": sp% = sp% + 6: GOTO schriftende 'D
IF bust$ = "e" OR bust$ = "E" THEN PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2 r3": sp% = sp% + 6: GOTO schriftende 'E
IF bust$ = "f" OR bust$ = "F" THEN PSET (sp% + 3, ze%): DRAW "l3 d2 r2 l2 d2": sp% = sp% + 6: GOTO schriftende 'F
IF bust$ = "g" OR bust$ = "G" THEN PSET (sp% + 3, ze%): DRAW "l2 g1 d2 f1 r2 u2 l1": sp% = sp% + 6: GOTO schriftende 'G
IF bust$ = "h" OR bust$ = "H" THEN PSET (sp%, ze%): DRAW "d4 u2 r3 u2 d4": sp% = sp% + 6: GOTO schriftende 'H
IF bust$ = "i" OR bust$ = "I" THEN PSET (sp% + 2, ze%): DRAW "d4": sp% = sp% + 6: GOTO schriftende 'I
IF bust$ = "j" OR bust$ = "J" THEN PSET (sp%, ze%): DRAW "r3 d3 g1 l1 h1": sp% = sp% + 6: GOTO schriftende 'J
IF bust$ = "k" OR bust$ = "K" THEN PSET (sp%, ze%): DRAW "d4 u2 r1 e2 g2 f2": sp% = sp% + 6: GOTO schriftende 'K
IF bust$ = "l" OR bust$ = "L" THEN PSET (sp%, ze%): DRAW "d4 r3": sp% = sp% + 6: GOTO schriftende 'L
IF bust$ = "m" OR bust$ = "M" THEN PSET (sp%, ze% + 4): DRAW "u4 f2 e2 d4": sp% = sp% + 6: GOTO schriftende 'M
IF bust$ = "n" OR bust$ = "N" THEN PSET (sp%, ze% + 4): DRAW "u4 f4 u4": sp% = sp% + 6: GOTO schriftende 'N
IF bust$ = "o" OR bust$ = "O" THEN PSET (sp%, ze% + 1): DRAW "d2 f1 r1 e1 u2 h1 l1": sp% = sp% + 6: GOTO schriftende 'O
IF bust$ = "p" OR bust$ = "P" THEN PSET (sp%, ze% + 4): DRAW "u4 r2 f1 g1 l1": sp% = sp% + 6: GOTO schriftende 'P
IF bust$ = "q" OR bust$ = "Q" THEN PSET (sp%, ze% + 1): DRAW "d2 f1 r1 e1 f1 h1 u2 h1 l1": sp% = sp% + 7: GOTO schriftende 'Q
IF bust$ = "r" OR bust$ = "R" THEN PSET (sp%, ze% + 4): DRAW "u4 r2 f1 e-1 l1 f2": sp% = sp% + 6: GOTO schriftende 'R
IF bust$ = "s" OR bust$ = "S" THEN PSET (sp%, ze% + 4): DRAW "r2 e1 f-1 l1 f-1 e1 r2": sp% = sp% + 6: GOTO schriftende 'S
IF bust$ = "t" OR bust$ = "T" THEN PSET (sp%, ze%): DRAW "r2 d4 u4 r2": sp% = sp% + 6: GOTO schriftende 'T
IF bust$ = "u" OR bust$ = "U" THEN PSET (sp%, ze%): DRAW "d4 r3 u4": sp% = sp% + 6: GOTO schriftende 'U
IF bust$ = "v" OR bust$ = "V" THEN PSET (sp%, ze%): DRAW "d2 f2 e2 u2": sp% = sp% + 7: GOTO schriftende 'V
IF bust$ = "w" OR bust$ = "W" THEN PSET (sp%, ze%): DRAW "d4 e2 f2 u4": sp% = sp% + 6: GOTO schriftende 'W
IF bust$ = "x" OR bust$ = "X" THEN PSET (sp%, ze%): DRAW "f4 h2 g2 e4": sp% = sp% + 6: GOTO schriftende 'X
IF bust$ = "y" OR bust$ = "Y" THEN PSET (sp%, ze%): DRAW "d2 r3 u2 d4 l2": sp% = sp% + 6: GOTO schriftende 'Y
IF bust$ = "z" OR bust$ = "Z" THEN PSET (sp%, ze% + 1): DRAW "u1 r3 g3 d1 r3 u1": sp% = sp% + 6: GOTO schriftende 'Z

IF bust$ = "0" THEN PSET (sp%, ze% + 1): DRAW "d2 f1 r2 e1 u2 h1 l2": sp% = sp% + 6: GOTO schriftende '0
IF bust$ = "1" THEN PSET (sp% + 2, ze% + 4): DRAW "u4 g2": sp% = sp% + 6: GOTO schriftende 'I
IF bust$ = "2" THEN PSET (sp%, ze% + 1): DRAW "e1 r1 f1 g3 r3": sp% = sp% + 6: GOTO schriftende '2
IF bust$ = "3" THEN PSET (sp%, ze% + 4): DRAW "r2 e1 f-1 l1 r1 e1 f-1 l2": sp% = sp% + 6: GOTO schriftende '3
IF bust$ = "4" THEN PSET (sp% + 2, ze% + 4): DRAW "u4 g2 d1 r3": sp% = sp% + 6: GOTO schriftende '4
IF bust$ = "5" THEN PSET (sp%, ze% + 4): DRAW "r2 e1 h1 l2 u2 r3": sp% = sp% + 6: GOTO schriftende '5
IF bust$ = "6" THEN PSET (sp% + 2, ze%): DRAW "l1 g1 d2 f1 r1 e1 h1 l1": sp% = sp% + 6: GOTO schriftende '6
IF bust$ = "7" THEN PSET (sp%, ze% + 1): DRAW "u1 r3 d1 g3": sp% = sp% + 6: GOTO schriftende '7
IF bust$ = "8" THEN PSET (sp%, ze% + 1): DRAW "f1 g1 f1 r1 e1 h1 e1 h1 l1": sp% = sp% + 6: GOTO schriftende '8
IF bust$ = "9" THEN PSET (sp% + 2, ze% + 2): DRAW "l1 h1 e1 r1 f1 d2 g1 l1": sp% = sp% + 6: GOTO schriftende '9

IF bust$ = "%" THEN PSET (sp%, ze%): PSET (sp% + 4, ze% + 4): PSET (sp%, ze% + 4): DRAW "e4": sp% = sp% + 8: GOTO schriftende '%
IF bust$ = ">" THEN PSET (sp%, ze%): DRAW "e2 f2": sp% = sp% + 6 '>
IF bust$ = "/" THEN PSET (sp% + 1, ze% + 4): DRAW "u1 e2 u1": sp% = sp% + 6: GOTO schriftende '/
IF bust$ = "\" THEN PSET (sp% + 4, ze% + 4): DRAW "u1 f2 u1": sp% = sp% + 6: GOTO schriftende '/
IF bust$ = "_" THEN PSET (sp%, ze% + 4): DRAW "r4": sp% = sp% + 6: GOTO schriftende '_
IF bust$ = "+" THEN PSET (sp% + 1, ze% + 2): DRAW "r2 l1 u1 d2": sp% = sp% + 6: GOTO schriftende '+
IF bust$ = "-" THEN PSET (sp% + 1, ze% + 2): DRAW "r2": sp% = sp% + 6: GOTO schriftende '-
IF bust$ = "." THEN PSET (sp% + 2, ze% + 4): DRAW "": sp% = sp% + 6: GOTO schriftende '.
IF bust$ = "," THEN PSET (sp% + 2, ze% + 4): DRAW "g1": sp% = sp% + 6: GOTO schriftende ',
IF bust$ = ":" THEN PSET (sp% + 2, ze% + 4): PSET (sp% + 2, ze% + 2): sp% = sp% + 6: GOTO schriftende ':
IF bust$ = " " THEN sp% = sp% + 6: GOTO schriftende 'leer

PSET (sp%, ze% + 4): DRAW "r4": sp% = sp% + 6
schriftende:
END SUB

SUB sequenz1
S% = 1
0
CLS : COLOR 4
SOUND 32767, 10
r:
LOCATE 9, S%: PRINT " r": S% = S% + 1: SOUND 32767, .1
IF S% = 51 THEN S% = 1: GOTO ur: ELSE GOTO r:

ur:
LOCATE 9, S%: PRINT " u": S% = S% + 1: SOUND 32767, .1
IF S% = 49 THEN S% = 1: GOTO our: ELSE GOTO ur:

our:
LOCATE 9, S%: PRINT " o": S% = S% + 1: SOUND 32767, .1
IF S% = 47 THEN S% = 1: GOTO Tour: ELSE GOTO our:

Tour:
LOCATE 9, S%: PRINT " T": S% = S% + 1: SOUND 32767, .1
IF S% = 45 THEN S% = 1: GOTO ytour: ELSE GOTO Tour:

ytour:
LOCATE 9, S%: PRINT " y": S% = S% + 1: SOUND 32767, .1
IF S% = 43 THEN S% = 1: GOTO mytour: ELSE GOTO ytour:

mytour:
LOCATE 9, S%: PRINT " M": S% = S% + 1: SOUND 32767, .1
IF S% = 41 THEN S% = 1: GOTO 1: ELSE GOTO mytour:



1
S% = 240
SLEEP 1

END SUB

SUB tour1 (phatprog$)
MouseRange 5, 5, 635, 345
DIM Tour AS STRING

'initialisierung + Werte und Einstellungen bernehmen
'Ordner in MyTour
'----------------

phatOT$ = phatprog$ + "downtour\" '(C:\mytour\downtour\) Original aus FTP... Unterordner
phatsave$ = phatprog$ + "Save\" '(C:\mytour\save\) gespeicherte Tour
phatalter$ = phatprog$ + "SavePlus\" '(C:\mytour\saveplus\) fr alternativ adressen
phattmp$ = phatprog$ + "tmp.dat" '(C:\mytour\tmp.dat) zwischenspeicher
phatex$ = phatprog$ + "excel\" '(C:\mytour\excel\)

maxkdlen = 180 'max. kundenanzahl in gespeicherter tour

CLOSE : OPEN "R", #1, phatprog$ + "exist.dat", 3
FIELD #1, 3 AS T$
GET #1, 31: Tist$ = T$ '

IF Tist$ = "neu" THEN '
GOTO tour1start '
ELSE ' Initiiert Liste
FOR i = 2 TO 30 '
Tist$ = "---" '
LSET T$ = Tist$ '
PUT #1, i '
NEXT i '
Tist$ = "neu" ' falls n”tig
LSET T$ = Tist$ '
PUT #1, 31: PUT #1, 1 '
END IF '

tour1start:

CLS : COLOR 4
CLOSE : OPEN "R", #1, phatprog$ + "exist.dat", 3
FIELD #1, 3 AS T$

ze% = 12

FOR i = 1 TO 30
ii$ = STR$(i)
GET #1, i


IF i < 10 THEN iT$ = " " + ii$ + " " + T$ ELSE iT$ = ii$ + " " + T$
CALL autowrite(14, ze%, 10, iT$)
ze% = ze% + 10
NEXT i

t1smaus:

DO 'Maus WarteSchleife
MouseStatus Lb%, Rb%, x, y '------------------
IF INKEY$ = CHR$(esc) THEN END
SELECT CASE Lb%
CASE -1: 'Auswahl Linke Taste
'-------------------
IF y < 10 OR x < 16 OR x > 49 OR y > 309 THEN GOTO t1smaus
IF y < 100 THEN leer$ = " " ELSE leer$ = ""
tourliste$ = leer$ + STR$(y): tourliste$ = MID$(tourliste$, 1, 3)
TLwahl = VAL(tourliste$)


CLOSE : OPEN "R", #1, phatprog$ + "exist.dat", 3
FIELD #1, 3 AS T$

GET #1, TLwahl: Tist$ = T$ '
IF Tist$ = "---" THEN '
LOCATE 15, 36: PRINT "Ungltig": SLEEP 2: '
LOCATE 15, 36: PRINT " ": GOTO t1smaus '
END IF '
IF Tist$ = "neu" THEN '
GOTO tour1neu ' entscheidung
ELSE ' NEU oder VORHANDEN
GOTO tour1open ' -----------------------
END IF '
END SELECT
SELECT CASE Rb%
CASE -1: END
END SELECT
LOOP

tour1neu:
CLS 'Neue Tour einlesen
'------------------

banz = 0: wort$ = ""

CALL autowrite(15, 118, 15, "gib die neue 3 stellige Tourennummer ein:")

DO
DO: taste$ = INKEY$
LOCATE 9, 34: PRINT wort$
LOOP WHILE taste$ = ""
IF LEN(taste$) = 1 THEN
SELECT CASE ASC(taste$)
CASE IS = 8 'backspace
IF banz < 1 THEN banz = 1
banz = banz - 1
wort$ = MID$(wort$, 1, banz)
LOCATE 9, 34: PRINT " "

CASE IS = 13 'enter
CLOSE

d$ = phatsave$ + wort$ + ".dat"
IF DateiExistiert(d$) THEN
CALL autowrite(2, 128, 15, d$ + " existiert schon."):
SLEEP 3: GOTO tour1start
END IF

d$ = phatOT$ + wort$ + ".txt"
IF DateiExistiert(d$) THEN
CALL autowrite(2, 128, 15, d$ + " existiert."):
GOTO t1nLesen
ELSE
CALL autowrite(6, 128, 15, d$ + " gibt es nicht."):
SLEEP 3: GOTO tour1neu
END IF
SLEEP: END

CASE IS = 27
GOTO tour1start

CASE 48 TO 57 'zahlen 0-9
wort$ = wort$ + taste$
banz = banz + 1
CASE 97 TO 122 'a-z
wort$ = wort$ + taste$
banz = banz + 1
END SELECT

END IF
LOOP


t1nLesen:

'TOUR ™FFNEN UND EINLESEN
'------------------------
phat1$ = d$

CALL autowrite(15, 138, 15, "Kundenanzahl wird ermittelt:")

CLOSE : OPEN phat1$ FOR INPUT AS #1: linecount = 0 '
DO WHILE NOT EOF(1) '
LINE INPUT #1, Tour: linecount = linecount + 1 ' Z„hlt zeilen(kunden)
LOOP ' in ausgangsdatei
lc$ = STR$(linecount): CALL autowrite(2, 138, 180, lc$)
CLOSE '

CALL autowrite(15, 148, 15, "filtere stammdatei und erzeuge bearbeitbare tour % fertig")

OPEN "R", #2, phatsave$ + wort$ + ".dat", 255
FIELD #2, 12 AS KD$, 4 AS OB$, 5 AS RY$, 5 AS MG$, 30 AS NN$, 30 AS VN$, 10 AS NT$, 61 AS IF1$, 4 AS IF2$, 6 AS IF3$, 25 AS ST$, 3 AS HN$, 1 AS HNZ$, 5 AS PZ$, 18 AS STTD$, 18 AS BZ$, 18 AS OT$
z = 1 'zeile der tmp datei
sz = 0

OPEN phat1$ FOR INPUT AS #1 'variablen werden LEER erstellt
DO WHILE NOT EOF(1) '------------------------------

kundennr$ = "": objekt$ = "": rytmus$ = "": menge$ = "": nachname$ = ""
vorname$ = "": nametitel$ = "": infoeins$ = "": infozwei$ = ""
infodrei$ = "": strasse$ = "": hausnummer$ = "": hausnrABC$ = ""
postleitz$ = "": stadt$ = "": bezirk$ = "": ortsteil$ = "": stand$ = ""

LINE INPUT #1, Tour

FOR i = 1 TO LEN(Tour)
plus$ = MID$(Tour, i, 1)
IF plus$ = "," THEN plus$ = "."
IF plus$ = ";" THEN sz = sz + 1
IF sz = 0 THEN kundennr$ = kundennr$ + plus$
IF sz = 1 AND plus$ <> ";" THEN objekt$ = objekt$ + plus$
IF sz = 5 AND plus$ <> ";" THEN rytmus$ = rytmus$ + plus$
IF sz = 6 AND plus$ <> ";" THEN menge$ = menge$ + plus$
IF sz = 7 AND plus$ <> ";" THEN nachname$ = nachname$ + plus$
IF sz = 8 AND plus$ <> ";" THEN vorname$ = vorname$ + plus$
IF sz = 9 AND plus$ <> ";" THEN nametitel$ = nametitel$ + plus$
IF sz = 10 AND plus$ <> ";" THEN infoeins$ = infoeins$ + plus$
IF sz = 11 AND plus$ <> ";" THEN infozwei$ = infozwei$ + plus$
IF sz = 12 AND plus$ <> ";" THEN infodrei$ = infodrei$ + plus$
IF sz = 13 AND plus$ <> ";" THEN strasse$ = strasse$ + plus$
IF sz = 14 AND plus$ <> ";" THEN hausnummer$ = hausnummer$ + plus$
IF sz = 15 AND plus$ <> ";" THEN hausnrABC$ = hausnrABC$ + plus$
IF sz = 18 AND plus$ <> ";" THEN postleitz$ = postleitz$ + plus$
IF sz = 19 AND plus$ <> ";" THEN stadt$ = stadt$ + plus$
IF sz = 20 AND plus$ <> ";" THEN bezirk$ = bezirk$ + plus$
IF sz = 21 AND plus$ <> ";" THEN ortsteil$ = ortsteil$ + plus$
IF sz = 26 AND plus$ <> ";" THEN stand$ = stand$ + plus$
NEXT i

infoeins$ = infoeins$ + "//" + infozwei$ + "//" + infodrei$
infozwei$ = "": infodrei$ = ""

LSET KD$ = kundennr$: LSET OB$ = objekt$: LSET RY$ = rytmus$
LSET MG$ = menge$: LSET NN$ = nachname$: LSET VN$ = vorname$
LSET NT$ = nametitel$: LSET IF1$ = infoeins$: LSET IF2$ = infozwei$
LSET IF3$ = infodrei$: LSET ST$ = strasse$: LSET HN$ = hausnummer$
LSET HNZ$ = hausnrABC$: LSET PZ$ = postleitz$: LSET STTD$ = stadt$
LSET BZ$ = bezirk$: LSET OT$ = ortsteil$
PUT #2, z

CALL autowrite(0, 148, 300, ftg$)

z = z + 1: fertig% = 100 / linecount * z
ftg$ = STR$(fertig%)

CALL autowrite(15, 148, 300, ftg$)

sz = 0
LOOP

LSET NT$ = stand$: PUT #2, 999

CLOSE : OPEN "R", #1, phatprog$ + "exist.dat", 3
FIELD #1, 3 AS T$
GET #1, TLwahl: LSET T$ = wort$: PUT #1, TLwahl
TLwahl = TLwahl + 1
GET #1, TLwahl: LSET T$ = "neu": PUT #1, TLwahl

CLOSE : GOTO tour1start


tour1open: CLS : LOCATE 1, 69: PRINT "Tour: "; Tist$


CALL button(7, 9, 180, 540, 1, "export")
CALL button(7, 9, 230, 540, 1, "refresh")
CALL button(7, 9, 255, 540, 1, "bearbeiten")
CALL button(7, 9, 280, 540, 4, "tour entf.")
CALL button(7, 9, 305, 540, 1, "< < < < <")


kiltun$ = "n": timedif = -1


t1oMaus:
DO 'Maus WarteSchleife
MouseStatus Lb%, Rb%, x, y '------------------

sec$ = MID$(TIME$, 7, 2)
IF kiltun$ = "j" AND wartetimer$ <> sec$ THEN
timedif = timedif - 1
LOCATE 21, 52: PRINT timedif
END IF

wartetimer$ = sec$

IF timedif = 0 THEN
timedif = -1
kiltun$ = "n"
GOTO tour1open
END IF

IF INKEY$ = CHR$(esc) THEN END
SELECT CASE Lb%
CASE -1: 'Auswahl Linke Taste
'-------------------
IF x < 541 OR x > 621 THEN GOTO t1oMaus
IF y > 280 AND y < 292 THEN 'l”schtaste
kiltun$ = "j": '----------
LINE (541, 306)-(621, 316), 9, BF 'Exit
timedif = 10
CALL autowrite(4, 309, 561, " OK")
CALL autowrite(4, 309, 270, "zum loeschen der tour mit ok bestaetigen")
GOTO t1oMaus
END IF

IF y > 305 AND y < 317 THEN 'EXIT / OK Taste
IF kiltun$ = "j" THEN '---------------
CLOSE : OPEN "R", #1, phatprog$ + "exist.dat", 3
FIELD #1, 3 AS T$

FOR i = 1 TO 30
GET #1, i: t2$ = T$
IF t2$ = Tist$ THEN
FOR I2 = i TO 30
GET #1, I2 + 1: t2$ = T$
LSET T$ = t2$
PUT #1, I2
IF I2 = 29 AND t2$ = "neu" THEN t29$ = "neu"
IF I2 = 29 AND t2$ = "---" THEN t29$ = "---"
IF I2 = 30 AND (t29$ = "neu" OR t29$ = "---") THEN
GET #1, 30
LSET T$ = "---"
PUT #1, 30
END IF
NEXT I2
END IF
NEXT i
ON ERROR GOTO fehler3
KILL phatsave$ + Tist$ + ".dat"

PRINT Tist$, " gel”scht"
SLEEP 3: GOTO tour1start
ELSE
GOTO tour1start
END IF
END IF

IF y > 230 AND y < 242 THEN GOTO t1oRefresh 'Aktuallisieren Taste
IF y > 255 AND y < 267 THEN GOTO t1oSet 'Bearbeiten Taste
IF y > 180 AND y < 192 THEN GOTO t1oExp 'Exportieren Taste

END SELECT
SELECT CASE Rb%
CASE -1: SLEEP 1: GOTO tour1start
END SELECT
LOOP



t1oExp: 'T O U R E N B U C H EXPORTIEREN

'str/hausnr+hnz ; name+vorname ; rythmus ; menge ; objekt ; info2 ; info3
' ;info1;;;;;
' ;;;;;;
gleich$ = ""
jahr$ = MID$(DATE$, 9, 2)
monat$ = MID$(DATE$, 1, 2)
phatexcel$ = phatex$ + Tist$ + "-" + monat$ + jahr$ + ".txt"
linecount = 0
FOR i = 1 TO 999
CLOSE : OPEN "R", #1, phatsave$ + Tist$ + ".dat", 255
FIELD #1, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$
GET #1, i
menge$ = MGE$: valmge = VAL(menge$)
IF valmge < 1 THEN linecount = i - 1: EXIT FOR
NEXT i

FOR i = 1 TO linecount

CLOSE : OPEN "R", #1, phatsave$ + Tist$ + ".dat", 255
FIELD #1, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$

GET #1, i
info13$ = RTRIM$(IN1$): kunde3$ = RTRIM$(KN$): objekt3$ = RTRIM$(OJ$):
rythmus3$ = RTRIM$(RYS$): menge3$ = RTRIM$(MGE$): zuname3$ = RTRIM$(ZN$):
name3$ = RTRIM$(NA$): titel3$ = RTRIM$(NTL$): info23$ = RTRIM$(IN2$):
info33$ = RTRIM$(IN3$): strasse3$ = RTRIM$(ROAD$): hausnr3$ = RTRIM$(HNR$):
hausnrz3$ = RTRIM$(HNRZ$): postlz3$ = RTRIM$(PLZ$): stadt3$ = RTRIM$(STTD2$):
bezirk3$ = RTRIM$(BZ2$): ortsteil3$ = RTRIM$(OT2$):

CLOSE

IF info13$ = "*101*" THEN
exportzeile1$ = strasse3$ + ";;;;;;"
CLOSE : OPEN phatexcel$ FOR APPEND AS #1
PRINT #1, exportzeile1$
ELSE

IF strasse3$ <> gleich$ THEN
exportzeile1$ = strasse3$ + ";;;;;;"
gleich$ = strasse3$
CLOSE : OPEN phatexcel$ FOR APPEND AS #1
PRINT #1, exportzeile1$
END IF

IF strasse3$ = gleich$ THEN
exportzeile1$ = hausnr3$ + hausnrz3$ + ";" + titel3$ + " " + zuname3$
exportzeile1$ = exportzeile1$ + ", " + name3$ + ";" + rythmus3$ + ";"
exportzeile1$ = exportzeile1$ + menge3$ + ";" + objekt3$ + ";" + info23$
exportzeile1$ = exportzeile1$ + ";" + info33$
exportzeile2$ = ";" + info13$ + ";;;;;"
CLOSE : OPEN phatexcel$ FOR APPEND AS #1
PRINT #1, exportzeile1$
PRINT #1, exportzeile2$
PRINT #1, ";;;;;;"
PRINT #1, ";;;;;;"
END IF

END IF
CLOSE
NEXT i
CLOSE
GOTO tour1start


t1oRefresh:

CALL autowrite(15, 138, 15, "Kundenanzahl wird ermittelt:")

CLOSE : OPEN phatOT$ + Tist$ + ".txt" FOR INPUT AS #1: linecount = 0 '
DO WHILE NOT EOF(1) '
LINE INPUT #1, Tour: linecount = linecount + 1 ' Z„hlt zeilen(kunden)
LOOP ' in ausgangsdatei

lc$ = STR$(linecount): CALL autowrite(2, 138, 180, lc$)
CLOSE '
CALL autowrite(15, 148, 15, "filtere stammdatei und erzeuge temp-datei % fertig")

OPEN "R", #2, phattmp$, 255
FIELD #2, 12 AS KD$, 4 AS OB$, 5 AS RY$, 5 AS MG$, 30 AS NN$, 30 AS VN$, 10 AS NT$, 61 AS IF1$, 4 AS IF2$, 6 AS IF3$, 25 AS ST$, 3 AS HN$, 1 AS HNZ$, 5 AS PZ$, 18 AS STTD$, 18 AS BZ$, 18 AS OT$
z = 1 'zeile der tmp datei
sz = 0

OPEN phatOT$ + Tist$ + ".txt" FOR INPUT AS #1 'variablen werden LEER erstellt
DO WHILE NOT EOF(1) '------------------------------

kundennr$ = "": objekt$ = "": rytmus$ = "": menge$ = "": nachname$ = ""
vorname$ = "": nametitel$ = "": infoeins$ = "": infozwei$ = ""
infodrei$ = "": strasse$ = "": hausnummer$ = "": hausnrABC$ = ""
postleitz$ = "": stadt$ = "": bezirk$ = "": ortsteil$ = "": stand$ = ""

LINE INPUT #1, Tour

FOR i = 1 TO LEN(Tour)
plus$ = MID$(Tour, i, 1)
IF plus$ = "," THEN plus$ = "."
IF plus$ = ";" THEN sz = sz + 1
IF sz = 0 THEN kundennr$ = kundennr$ + plus$
IF sz = 1 AND plus$ <> ";" THEN objekt$ = objekt$ + plus$
IF sz = 5 AND plus$ <> ";" THEN rytmus$ = rytmus$ + plus$
IF sz = 6 AND plus$ <> ";" THEN menge$ = menge$ + plus$
IF sz = 7 AND plus$ <> ";" THEN nachname$ = nachname$ + plus$
IF sz = 8 AND plus$ <> ";" THEN vorname$ = vorname$ + plus$
IF sz = 9 AND plus$ <> ";" THEN nametitel$ = nametitel$ + plus$
IF sz = 10 AND plus$ <> ";" THEN infoeins$ = infoeins$ + plus$
IF sz = 11 AND plus$ <> ";" THEN infozwei$ = infozwei$ + plus$
IF sz = 12 AND plus$ <> ";" THEN infodrei$ = infodrei$ + plus$
IF sz = 13 AND plus$ <> ";" THEN strasse$ = strasse$ + plus$
IF sz = 14 AND plus$ <> ";" THEN hausnummer$ = hausnummer$ + plus$
IF sz = 15 AND plus$ <> ";" THEN hausnrABC$ = hausnrABC$ + plus$
IF sz = 18 AND plus$ <> ";" THEN postleitz$ = postleitz$ + plus$
IF sz = 19 AND plus$ <> ";" THEN stadt$ = stadt$ + plus$
IF sz = 20 AND plus$ <> ";" THEN bezirk$ = bezirk$ + plus$
IF sz = 21 AND plus$ <> ";" THEN ortsteil$ = ortsteil$ + plus$
IF sz = 26 AND plus$ <> ";" THEN stand$ = stand$ + plus$
NEXT i

infoeins$ = infoeins$ + "//" + infozwei$ + "//" + infodrei$
infozwei$ = "": infodrei$ = ""

LSET KD$ = kundennr$: LSET OB$ = objekt$: LSET RY$ = rytmus$
LSET MG$ = menge$: LSET NN$ = nachname$: LSET VN$ = vorname$
LSET NT$ = nametitel$: LSET IF1$ = infoeins$: LSET IF2$ = infozwei$
LSET IF3$ = infodrei$: LSET ST$ = strasse$: LSET HN$ = hausnummer$
LSET HNZ$ = hausnrABC$: LSET PZ$ = postleitz$: LSET STTD$ = stadt$
LSET BZ$ = bezirk$: LSET OT$ = ortsteil$
PUT #2, z

CALL autowrite(0, 148, 300, ftg$)

fertig% = 100 / linecount * z
ftg$ = STR$(fertig%)

CALL autowrite(2, 148, 300, ftg$)
z = z + 1: sz = 0
LOOP


' TOUR AUS ZW-SPEICHER šBERNEHEMEN UND AKTUALLISIEREN
' ---------------------------------------------------
CLOSE

OPEN "R", #2, phatsave$ + Tist$ + ".dat", 255
FIELD #2, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$
linecountalt = 0
FOR I2 = 1 TO 999
GET #2, I2
mgeval% = VAL(MGE$)
IF mgeval% < 1 THEN EXIT FOR
linecountalt = linecountalt + 1
NEXT I2
CLOSE

CALL autowrite(15, 158, 15, "Zug„nge werden bercksichtigt ")
FOR I1 = 1 TO linecount
OPEN "R", #1, phattmp$, 255
FIELD #1, 12 AS KD$, 4 AS OB$, 5 AS RY$, 5 AS MG$, 30 AS NN$, 30 AS VN$, 10 AS NT$, 61 AS IF1$, 4 AS IF2$, 6 AS IF3$, 25 AS ST$, 3 AS HN$, 1 AS HNZ$, 5 AS PZ$, 18 AS STTD$, 18 AS BZ$, 18 AS OT$
GET #1, I1
kdnr1$ = RTRIM$(KD$): obj1$ = RTRIM$(OB$)
zugang$ = "j": ffp = 0
CLOSE

FOR I2 = 1 TO linecountalt
OPEN "R", #2, phatsave$ + Tist$ + ".dat", 255
FIELD #2, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$
GET #2, I2
kdnr2$ = RTRIM$(KN$): obj2$ = RTRIM$(OJ$)
mgeval = VAL(MGE$): IF mgeval < 1 AND ffp = 0 THEN ffp = I2 'first free place
IF kdnr1$ = kdnr2$ AND obj1$ = obj2$ THEN zugang$ = "n": EXIT FOR
CLOSE
NEXT I2

IF zugang$ = "j" THEN
OPEN "R", #1, phattmp$, 255
FIELD #1, 12 AS KD$, 4 AS OB$, 5 AS RY$, 5 AS MG$, 30 AS NN$, 30 AS VN$, 10 AS NT$, 61 AS IF1$, 4 AS IF2$, 6 AS IF3$, 25 AS ST$, 3 AS HN$, 1 AS HNZ$, 5 AS PZ$, 18 AS STTD$, 18 AS BZ$, 18 AS OT$
GET #1, I1
kunde$ = KD$: objekt$ = OB$: rythmus$ = RY$: menge$ = MG$: nachname$ = NN$: vorname$ = VN$: nametitel$ = NT$: info1$ = IF1$: info2$ = IF2$: info3$ = IF3$: strasse$ = ST$: hausnr$ = HN$: hausnrzus$ = HNZ$: postlz$ = PZ$
stadt$ = STTD$: bezirk$ = BZ$: ortsteil$ = OT$
CLOSE
OPEN "R", #2, phatsave$ + Tist$ + ".dat", 255
FIELD #2, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$
GET #2, linecountalt + 1
LSET KN$ = kunde$: LSET OJ$ = objekt$: LSET RYS$ = rythmus$: LSET MGE$ = menge$: LSET ZN$ = nachname$: LSET NA$ = vorname$:
LSET NTL$ = nametitel$: LSET IN1$ = info1$: LSET IN2$ = info2$: LSET IN3$ = info3$: LSET ROAD$ = strasse$
LSET HNR$ = hausnr$: LSET HNRZ$ = hausnrzus$: LSET PLZ$ = postlz$: LSET STTD2$ = stadt$: LSET BZ2$ = bezirk$: LSET OT2$ = ortsteil$
PUT #2, linecountalt + 1

linecountalt = linecountalt + 1
END IF
CLOSE

CALL autowrite(0, 158, 300, ftg$)
fertig% = 100 / linecount * I1
ftg$ = STR$(fertig%)
CALL autowrite(2, 158, 300, ftg$)

NEXT I1

CALL autowrite(15, 168, 15, "Abg„nge werden bercksichtigt ")
FOR I3 = 1 TO linecountalt
OPEN "R", #3, phatsave$ + Tist$ + ".dat", 255
FIELD #3, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$
GET #3, I3
kdnr3$ = RTRIM$(KN$): obj3$ = RTRIM$(OJ$): info3$ = RTRIM$(IN1$)
status$ = "kill"
CLOSE

IF info3$ <> "*101*" THEN
FOR i4 = 1 TO 999
OPEN "R", #4, phattmp$, 255
FIELD #4, 12 AS KD$, 4 AS OB$, 5 AS RY$, 5 AS MG$, 30 AS NN$, 30 AS VN$, 10 AS NT$, 61 AS IF1$, 4 AS IF2$, 6 AS IF3$, 25 AS ST$, 3 AS HN$, 1 AS HNZ$, 5 AS PZ$, 18 AS STTD$, 18 AS BZ$, 18 AS OT$
GET #4, i4
kdnr4$ = RTRIM$(KD$): obj4$ = RTRIM$(OB$)
IF kdnr3$ = kdnr4$ AND obj3$ = obj4$ THEN status$ = "save": EXIT FOR
CLOSE
NEXT i4
ELSE
status$ = "save"
END IF

IF status$ = "kill" THEN
OPEN "R", #3, phatsave$ + Tist$ + ".dat", 255
FIELD #3, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$

FOR i5 = I3 TO linecountalt
GET #3, i5 + 1
kunde$ = KN$: objekt$ = OJ$: rythmus$ = RYS$: menge$ = MGE$: nachname$ = ZN$: vorname$ = NA$: nametitel$ = NTL$: info1$ = IN1$: info2$ = IN2$: info3$ = IN3$: strasse$ = ROAD$: hausnr$ = HNR$: hausnrzus$ = HNRZ$: postlz$ = PLZ$
stadt$ = STTD2$: bezirk$ = BZ2$: ortsteil$ = OT2$

LSET KN$ = kunde$: LSET OJ$ = objekt$: LSET RYS$ = rythmus$: LSET MGE$ = menge$: LSET ZN$ = nachname$: LSET NA$ = vorname$:
LSET NTL$ = nametitel$: LSET IN1$ = info1$: LSET IN2$ = info2$: LSET IN3$ = info3$: LSET ROAD$ = strasse$
LSET HNR$ = hausnr$: LSET HNRZ$ = hausnrzus$: LSET PLZ$ = postlz$: LSET STTD2$ = stadt$: LSET BZ2$ = bezirk$: LSET OT2$ = ortsteil$
PUT #3, i5
NEXT i5
linecountalt = linecountalt - 1
END IF

CLOSE
CALL autowrite(0, 168, 300, ftg$)
fertig% = 100 / linecountalt * I3
ftg$ = STR$(fertig%)
CALL autowrite(2, 168, 300, ftg$)

NEXT I3

OPEN "R", #3, phatsave$ + Tist$ + ".dat", 255
FIELD #3, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$
GET #3, 999
LSET NTL$ = stand$: PUT #3, 999
CLOSE

ON ERROR GOTO fehler2
KILL phattmp$
CLOSE : GOTO tour1open

t1oSet: CLS 'TOUR BEARBEITEN
'---------------
CLOSE : OPEN "R", #1, phatsave$ + Tist$ + ".dat", 255
FIELD #1, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$

linecount = 0
FOR I1 = 1 TO 999
GET #1, I1
mgeval% = VAL(MGE$)
IF mgeval% < 1 THEN EXIT FOR
linecount = linecount + 1
NEXT I1

startkl = 1
verschieben$ = "n"
infoSet$ = "n"

t1os1: CLS
CALL button(7, 9, 230, 540, 1, "neuer kunde")
LINE (540, 255)-(620, 265), 7, BF 'entf. '
LINE (541, 256)-(621, 266), 9, BF 'entf. '
LINE (540, 280)-(620, 290), 7, BF 'Info ' Schaltfl„chen
LINE (541, 281)-(621, 291), 9, BF ' '
CALL autowrite(1, 259, 567, "entf")
CALL autowrite(1, 284, 567, "info")

COLOR 1
LOCATE 10, 2: PRINT ""
LOCATE 14, 2: PRINT ""
ze% = 12

CLOSE : OPEN "R", #1, phatsave$ + Tist$ + ".dat", 255
FIELD #1, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$

FOR i = startkl TO startkl + 29
ii$ = STR$(i)
GET #1, i
znkurz$ = MID$(ZN$, 1, 12)
nakurz$ = MID$(NA$, 1, 12)
rokurz$ = MID$(ROAD$, 1, 20)
hnkurz$ = HNR$: hzkurz$ = HNRZ$

iznrhh$ = ii$ + " " + rokurz$ + " " + hnkurz$ + hzkurz$ + " " + znkurz$ + ", " + nakurz$

IF i < 100 THEN iznrhh$ = " " + iznrhh$
IF i < 10 THEN iznrhh$ = " " + iznrhh$
IF i = 16 THEN PRINT i, verschieben$, TLwahl
IF i = vwahl AND verschieben$ = "j" THEN c = 7 ELSE c = 14
CALL autowrite(c, ze%, 10, iznrhh$)
ze% = ze% + 10
IF i = linecount + 1 THEN EXIT FOR
NEXT i

t1os2:

DO 'Maus WarteSchleife
MouseStatus Lb%, Rb%, x, y '------------------
IF INKEY$ = CHR$(esc) THEN GOTO tour1open
taste$ = INKEY$
IF y < 100 THEN leer$ = " " ELSE leer$ = ""
tourliste$ = leer$ + STR$(y): tourliste$ = MID$(tourliste$, 1, 3)
TLwahl = VAL(tourliste$) + startkl - 1
LOCATE 11, 60: PRINT TLwahl
LOCATE 12, 40: PRINT x, y
LOCATE 13, 50: PRINT wort$
SELECT CASE Lb%
CASE -1: 'Auswahl Linke Taste
IF x < 15 AND y > 184 AND y < 195 THEN 'RUNTER
startkl = startkl + 20
IF startkl > linecount THEN startkl = startkl - 20
GOTO t1os1
END IF

IF x < 15 AND y > 127 AND y < 139 THEN 'HOCH
startkl = startkl - 20
IF startkl < 1 THEN startkl = startkl + 20
GOTO t1os1
END IF
'Satz W„hlen
IF y > 9 AND y < 310 AND x > 45 AND x < 370 AND infoSet$ = "n" AND verschieben$ = "n" THEN
IF TLwahl > linecount THEN GOTO t1os2
GET #1, TLwahl
kunde$ = KN$: objekt$ = OJ$: rythmus$ = RYS$: menge$ = MGE$: nachname$ = ZN$: vorname$ = NA$: nametitel$ = NTL$: info1$ = IN1$: info2$ = IN2$: info3$ = IN3$: strasse$ = ROAD$: hausnr$ = HNR$: hausnrzus$ = HNRZ$: postlz$ = PLZ$
stadt$ = STTD2$: bezirk$ = BZ2$: ortsteil$ = OT2$

znkurz$ = MID$(ZN$, 1, 12): nakurz$ = MID$(NA$, 1, 12)
rokurz$ = MID$(ROAD$, 1, 20): hnkurz$ = HNR$: hzkurz$ = HNRZ$
TTLwahl$ = STR$(TLwahl)
iznrhh$ = TTLwahl$ + " " + rokurz$ + " " + hnkurz$ + hzkurz$ + " " + znkurz$ + ", " + nakurz$

IF TLwahl < 100 THEN iznrhh$ = " " + iznrhh$
IF TLwahl < 10 THEN iznrhh$ = " " + iznrhh$

CALL autowrite(15, (TLwahl + 1 - startkl) * 10 + 2, 10, iznrhh$)
verschieben$ = "j": vwahl = TLwahl

OPEN "R", #2, phattmp$, 255
FIELD #2, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$
LSET KN$ = kunde$: LSET OJ$ = objekt$: LSET RYS$ = rythmus$: LSET MGE$ = menge$: LSET ZN$ = nachname$: LSET NA$ = vorname$:
LSET NTL$ = nametitel$: LSET IN1$ = info1$: LSET IN2$ = info2$: LSET IN3$ = info3$: LSET ROAD$ = strasse$
LSET HNR$ = hausnr$: LSET HNRZ$ = hausnrzus$: LSET PLZ$ = postlz$: LSET STTD2$ = stadt$: LSET BZ2$ = bezirk$: LSET OT2$ = ortsteil$
PUT #2, 1
CLOSE #2
END IF
'SATZ EINFGEN
IF y > 9 AND y < 310 AND x > 45 AND x < 370 AND verschieben$ = "j" AND vwahl <> TLwahl THEN
IF TLwahl > linecount THEN GOTO t1os2
GET #1, TLwahl
kunde$ = KN$: objekt$ = OJ$: rythmus$ = RYS$: menge$ = MGE$: nachname$ = ZN$: vorname$ = NA$: nametitel$ = NTL$: info1$ = IN1$: info2$ = IN2$: info3$ = IN3$: strasse$ = ROAD$: hausnr$ = HNR$: hausnrzus$ = HNRZ$: postlz$ = PLZ$
stadt$ = STTD2$: bezirk$ = BZ2$: ortsteil$ = OT2$
LSET KN$ = kunde$: LSET OJ$ = objekt$: LSET RYS$ = rythmus$: LSET MGE$ = menge$: LSET ZN$ = nachname$: LSET NA$ = vorname$:
LSET NTL$ = nametitel$: LSET IN1$ = info1$: LSET IN2$ = info2$: LSET IN3$ = info3$: LSET ROAD$ = strasse$
LSET HNR$ = hausnr$: LSET HNRZ$ = hausnrzus$: LSET PLZ$ = postlz$: LSET STTD2$ = stadt$: LSET BZ2$ = bezirk$: LSET OT2$ = ortsteil$
PUT #1, vwahl

OPEN "R", #2, phattmp$, 255
FIELD #2, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$
GET #2, 1
kunde$ = KN$: objekt$ = OJ$: rythmus$ = RYS$: menge$ = MGE$: nachname$ = ZN$: vorname$ = NA$: nametitel$ = NTL$: info1$ = IN1$: info2$ = IN2$: info3$ = IN3$: strasse$ = ROAD$: hausnr$ = HNR$: hausnrzus$ = HNRZ$: postlz$ = PLZ$
stadt$ = STTD2$: bezirk$ = BZ2$: ortsteil$ = OT2$

CLOSE : OPEN "R", #1, phatsave$ + Tist$ + ".dat", 255
FIELD #1, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$, 30 AS ZN$, 30 AS NA$, 10 AS NTL$, 61 AS IN1$, 4 AS IN2$, 6 AS IN3$, 25 AS ROAD$, 3 AS HNR$, 1 AS HNRZ$, 5 AS PLZ$, 18 AS STTD2$, 18 AS BZ2$, 18 AS OT2$

LSET KN$ = kunde$: LSET OJ$ = objekt$: LSET RYS$ = rythmus$: LSET MGE$ = menge$: LSET ZN$ = nachname$: LSET NA$ = vorname$:
LSET NTL$ = nametitel$: LSET IN1$ = info1$: LSET IN2$ = info2$: LSET IN3$ = info3$: LSET ROAD$ = strasse$
LSET HNR$ = hausnr$: LSET HNRZ$ = hausnrzus$: LSET PLZ$ = postlz$: LSET STTD2$ = stadt$: LSET BZ2$ = bezirk$: LSET OT2$ = ortsteil$
PUT #1, TLwahl

verschieben$ = "n"
CLOSE
ON ERROR GOTO fehler4
KILL phattmp$
GOTO t1os1
END IF

IF y > 9 AND y < 310 AND x > 45 AND x <
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

BeitragVerfasst am: 24.01.2012, 22:11    Titel: Antworten mit Zitat

Der Code ist länger als ein möglicher Forenpost, was schon verrät, dass du ihn mit QB nicht kompilieren kannst. Der Code müsste in mehrere Module aufgespalten werden, oder einfach auf FreeBASIC umgeschrieben werden.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
MisterD



Anmeldungsdatum: 10.09.2004
Beiträge: 3071
Wohnort: bei Darmstadt

BeitragVerfasst am: 24.01.2012, 22:12    Titel: Antworten mit Zitat

lad den code mal irgendwo hoch wo's lesbar ist statt ihn direkt zu posten, dafür ist er viel zu lang.

abgeschnitten bei 50 kilobyte lässt vermuten, dass der original-code schlicht und ergreifend umfangreicher als 64kb ist. Das kann QBasic nicht mehr verarbeiten weil ein gewisser herr gates mal der meinung war, mehr als 64kb ram würde kein rechner jemals brauchen. dein programm ist damit einfach zu umfangreich für so eine veraltete technologie, du wirst umziehen müssen.
_________________
"It is practically impossible to teach good programming to students that have had a prior exposure to BASIC: as potential programmers they are mentally mutilated beyond hope of regeneration."
Edsger W. Dijkstra
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 24.01.2012, 22:21    Titel: Antworten mit Zitat

oje

ok also mehrere Module
wie war das ?
anstelle von CALL Sub... nehm ich run ....EXE ?
und bei END komm ich dann in die vorherige EXE an die letzte stelle zurück?

Wär es denn sehr kompliziert den Code in FreeBasic umzuschreiben?
Wo könnt ich denn den Code mal hochladen?
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
HorstD



Anmeldungsdatum: 01.11.2007
Beiträge: 107

BeitragVerfasst am: 24.01.2012, 22:35    Titel: Antworten mit Zitat

Zitat:
Wo könnt ich denn den Code mal hochladen?


Versuch's mal bei Megaupload.

Zunge rausstrecken
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 24.01.2012, 22:42    Titel: Antworten mit Zitat

ok ich hab die *.bas mal hochgeladen
http://www.file-upload.net/download-4057473/MYTOUR.BAS.html[/url]
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
Sebastian
Administrator


Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland

BeitragVerfasst am: 24.01.2012, 22:44    Titel: Antworten mit Zitat

Hallo!

braesident hat Folgendes geschrieben:
Wär es denn sehr kompliziert den Code in FreeBasic umzuschreiben?

Da gibt es ein paar Dinge, die geändert werden müssten, aber das ist m.E. vor allem ein bisschen "Fleißarbeit" und nicht sonderlich schwierig/kompliziert.

Wenn du in FreeBASIC den "Nostalgie"-Kompatibilitätsmodus -lang qb benutzt, müsstest du sogar noch weniger verändern. Ich würde aber empfehlen, lieber den Standardmodus anzustreben.

Eine wesentliche Veränderung von QB zu FB dürfte in diesem Fall sein, dass es in FreeBASIC fertige Funktionen zum Handlen der Maus gibt. In FreeBASIC kannst du einfach den Befehl GetMouse aufrufen und schon hast du Infos zu Koordinaten, Maustaste(n), ... Eigene Mausroutinen sind da nicht mehr nötig. (Alte QB-Mausroutinen mit Inline-Assembler und Interrupt-Aufrufen funktionieren in FreeBASIC auch nicht mehr.)

Zitat:
Wo könnt ich denn den Code mal hochladen?

Da gibt es verschiedene Dienste: Mediafire, Dropbox, ...

Ich kann dir aber auch gerne kostenlos einen Zugang zu einem von unseren Servern einrichten (fürs Hochladen eigener Programme). Dann könntest du deine Quelltexte usw. unter einer Adresse wie http://users.freebasic-portal.de/braesident/ anbieten (werbefrei und zeitlich nicht beschränkt). Bei Interesse kannst du mir eine PN oder E-Mail schreiben. zwinkern

Viele Grüße!
Sebastian
_________________

Der Markt regelt das! | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 24.01.2012, 23:46    Titel: Antworten mit Zitat

Danke Jojo, du hast treffendst erklärt, was ich mit '42' sagen wollte..
Ich hatte keine Lust auf http://www.gidf.de zu verweisen..
Und ohne weitere Erklärungen wäre dieser dieser Link auch ins Leere gegangen, da er ja auf FreeBasic abzielt, doch es ist ja nicht verkehrt,
die Seite mal durchzulesen, weil es ja auch um die Forenteilnahme geht..
@braesident: siehste, wie einfach das geht, Hilfe zu einem Quelltext zu bekommen?
[Edit]
Den Code hättest du natürlich auch nach porticula hochladen können, doch das nur nebenbei..
QB4.5 kann den Befehl Call Absolute.. nicht erkennen..
QB7.1 dito..
Ein Versuch mit m$-QBasic 1.1 führt das Programm zwar aus,
es funktioniert aber nicht, doch bringt es mich zu der Vermutung, daß
du ein QBasic 1.1-Programm kompilieren willst, daß ist SOOO aber nicht möglich!
Eine direkte Kompilierung mit FB im QB-Modus funktioniert ebenfalls nicht..
Du mußt dir also Gedanken machen(s. Post von Jojo und Sebastian) wie das Programm nach FB zu portieren wäre..
Viel Spaß beim Umstricken DEINES Programmes zwinkern
Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 25.01.2012, 08:28    Titel: Antworten mit Zitat

Zitat:
QB4.5 kann den Befehl Call Absolute.. nicht erkennen..


bei start über qb.exe gibt es dazu eine Fehlermeldung
ich starte aber immer über qb.exe -/L /H
und da läuft das problemlos, zumindest auf programmierebene

ansonsten ersteinmal danke Leute
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
Sebastian
Administrator


Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland

BeitragVerfasst am: 25.01.2012, 12:29    Titel: Antworten mit Zitat

braesident hat Folgendes geschrieben:
und da läuft das problemlos, zumindest auf programmierebene

Übrigens passend zum Thema der Eintrag in der QBasic-MonsterFAQ: QBMonFAQ: Mein Programm lässt sich zwar interpretieren, aber nicht kompilieren!

Diese ganzen Limitationen, was Codelänge, Arraygrößen etc. angeht (vgl. verlinkten FAQ-Eintrag), hast du in FreeBASIC nicht.
(Es hat schon Gründe, wieso sich da Leute sehr viel Arbeit gemacht haben, diesen neuen Compiler als inoffiziellen Nachfolger von QB zu entwickeln. zwinkern )
_________________

Der Markt regelt das! | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Kernelpanic



Anmeldungsdatum: 25.01.2012
Beiträge: 16

BeitragVerfasst am: 25.01.2012, 18:20    Titel: Antworten mit Zitat

ytwinky hat Folgendes geschrieben:
QB4.5 kann den Befehl Call Absolute.. nicht erkennen..

Hallo,

daß ist nicht korrekt, schon QuickBasic 4.01b kannte diesen Befehl.



Gruß
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

BeitragVerfasst am: 25.01.2012, 19:20    Titel: Antworten mit Zitat

Kernelpanic hat Folgendes geschrieben:
daß ist nicht korrekt, schon QuickBasic 4.01b kannte diesen Befehl.
Allerdings nur beim Laden der korreten Bibliothek, ist also kein Standard-Befehl, der zur Sprache selbst gehört.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
Kernelpanic



Anmeldungsdatum: 25.01.2012
Beiträge: 16

BeitragVerfasst am: 25.01.2012, 19:55    Titel: Antworten mit Zitat

Jojo hat Folgendes geschrieben:
Kernelpanic hat Folgendes geschrieben:
daß ist nicht korrekt, schon QuickBasic 4.01b kannte diesen Befehl.
Allerdings nur beim Laden der korreten Bibliothek, ist also kein Standard-Befehl, der zur Sprache selbst gehört.


Ich habe noch mal im Handbuch nachgesehen, und die beiden notwendigen Dateien waren QB.QLB und QB.BI. Beide waren auf der 3. Diskette, und wurden gleich bei der Installation mit installiert; ich glaub man bekam die Frage, ob man diese miterstellen will. An QB.QLB kann ich mich gut erinnern, die waren bei mir von Anfang an im Istallationsverzeichnis.
CALL ist schon ein Standardbefehl gewesen, er nützte nur nichts, wenn man die obigen beiden Dateien nicht mitinstalliert hatte, aus welchem Grund auch immer.

Gruß
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
dreael
Administrator


Anmeldungsdatum: 10.09.2004
Beiträge: 2507
Wohnort: Hofen SH (Schweiz)

BeitragVerfasst am: 26.01.2012, 13:00    Titel: Antworten mit Zitat

Jojo hat Folgendes geschrieben:
Der Code ist länger als ein möglicher Forenpost, was schon verrät, dass du ihn mit QB nicht kompilieren kannst.

...und ziemlich voller typischer Anfängerprobleme, insbesondere Code-Wiederholungen.

Kurz & bündig: Hier steckt viel Verbesserungspotenzial drin. Wie wäre es mit Umplatzieren dieser vielen DRAW-Strings in DATA-Zeilen und Einlesen in ein Array? Dann würde gleich einmal das dauernd wiederholte IF .. THEN in dieser Form entfallen.

Absolute Pfade wie C:\MYTOUR sollten ebenfalls komplett vermieden werden - hier hätte FreeBasic den Vorteil, weil es auch so etwas wie $(dirname $0) bzw. %~dp0 gibt, um alles relativ vom .EXE-Pfad aus zu adressieren.
_________________
Teste die PC-Sicherheit mit www.sec-check.net
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 26.01.2012, 19:58    Titel: Antworten mit Zitat

Kernelpanic hat Folgendes geschrieben:
..daß ist nicht korrekt, schon QuickBasic 4.01b kannte diesen Befehl.
Mein Rechner ist vllt nicht technisch auf dem neuesten Stand, aber das bedeutet nicht, daß ich auch veraltete Software benutzen muß!
Mein installiertes QBasic 4.5 hatte den Fehler gemeldet und es ging mir nur darum zu sehen, was mglw. die Fehlerursache sein könnte und braesident keierlei weitere Angaben gemacht hat, habe ich natürlich auch m$-QBasic 1.1 probiert, um
auszuschließen/herauszufinden, ob er vllt. ein Interpreter-Programm kompilieren wollte..
Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 31.01.2012, 18:29    Titel: Antworten mit Zitat

@dreael
richtig das ist mein erstes größeres projekt

Data Zeilen befinden sich in meinem Code für die Mausroutine, leider bin ich noch nicht dahinter gekommen wie diese Zeilen genau funktionieren.
Hab mich aber auch noch nicht wirklich mit Data beschäftigt da es mir noch zu kompliziert erschien.

Jedenfalls versuch ich mich in FB rein zu fummeln... klappt bis jetzt ganz gut, allerdings scheiterts momentan mit dem Open Befehl

in QB:
Code:
OPEN "R", #1, phatprog$ + "tmp.dat", 255
FIELD #1, 12 AS KN$, 4 AS OJ$, 5 AS RYS$, 5 AS MGE$.....
for i = 1 to ...
get#1,i


und in FB geht das wohl so nicht mehr
ich hab mir die Referenz und die Beispiele angschaut, aber irgendwie machts nicht klick wie ich es schreiben muss um das selbe ergebnis zu bekommen wie in QB
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu QBasic. Alle Zeiten sind GMT + 1 Stunde
Gehe zu Seite 1, 2  Weiter
Seite 1 von 2

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz