|
Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
Autor |
Nachricht |
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 24.01.2012, 22:29 Titel: fehler bei exe erstellen |
|
|
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 |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005 Beiträge: 2624 Wohnort: Machteburch
|
Verfasst am: 24.01.2012, 22:42 Titel: |
|
|
42 _________________
v1ctor hat Folgendes geschrieben: | Yeah, i like INPUT$(n) as much as PRINT USING.. | ..also ungefähr so, wie ich GOTO.. |
|
Nach oben |
|
|
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 24.01.2012, 22:51 Titel: |
|
|
sorry aber was meinst du mit 42 |
|
Nach oben |
|
|
Jojo alter Rang
Anmeldungsdatum: 12.02.2005 Beiträge: 9736 Wohnort: Neben der Festplatte
|
Verfasst am: 24.01.2012, 22:57 Titel: |
|
|
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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 24.01.2012, 23:07 Titel: |
|
|
[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 |
|
|
Jojo alter Rang
Anmeldungsdatum: 12.02.2005 Beiträge: 9736 Wohnort: Neben der Festplatte
|
Verfasst am: 24.01.2012, 23:11 Titel: |
|
|
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 |
|
|
MisterD
Anmeldungsdatum: 10.09.2004 Beiträge: 3071 Wohnort: bei Darmstadt
|
Verfasst am: 24.01.2012, 23:12 Titel: |
|
|
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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 24.01.2012, 23:21 Titel: |
|
|
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 |
|
|
HorstD
Anmeldungsdatum: 01.11.2007 Beiträge: 110
|
Verfasst am: 24.01.2012, 23:35 Titel: |
|
|
Zitat: | Wo könnt ich denn den Code mal hochladen? |
Versuch's mal bei Megaupload.
|
|
Nach oben |
|
|
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
|
Nach oben |
|
|
Sebastian Administrator
Anmeldungsdatum: 10.09.2004 Beiträge: 5969 Wohnort: Deutschland
|
Verfasst am: 24.01.2012, 23:44 Titel: |
|
|
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.
Viele Grüße!
Sebastian _________________
Die gefährlichsten Familienclans | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen! |
|
Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005 Beiträge: 2624 Wohnort: Machteburch
|
Verfasst am: 25.01.2012, 00:46 Titel: |
|
|
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
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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 25.01.2012, 09:28 Titel: |
|
|
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 |
|
|
Sebastian Administrator
Anmeldungsdatum: 10.09.2004 Beiträge: 5969 Wohnort: Deutschland
|
|
Nach oben |
|
|
Kernelpanic
Anmeldungsdatum: 25.01.2012 Beiträge: 16
|
Verfasst am: 25.01.2012, 19:20 Titel: |
|
|
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 |
|
|
Jojo alter Rang
Anmeldungsdatum: 12.02.2005 Beiträge: 9736 Wohnort: Neben der Festplatte
|
Verfasst am: 25.01.2012, 20:20 Titel: |
|
|
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 |
|
|
Kernelpanic
Anmeldungsdatum: 25.01.2012 Beiträge: 16
|
Verfasst am: 25.01.2012, 20:55 Titel: |
|
|
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 |
|
|
dreael Administrator
Anmeldungsdatum: 10.09.2004 Beiträge: 2511 Wohnort: Hofen SH (Schweiz)
|
Verfasst am: 26.01.2012, 14:00 Titel: |
|
|
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 |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005 Beiträge: 2624 Wohnort: Machteburch
|
Verfasst am: 26.01.2012, 20:58 Titel: |
|
|
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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 31.01.2012, 19:29 Titel: |
|
|
@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 |
|
|
|
|
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.
|
|