Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Eingabe in QB -alt-
| Uploader: |  Neuling |
| Datum/Zeit: | 30.09.2013 16:46:36 |
' ***** Eingabe-Routine als SUB-Prozedur
#Lang "qb"
DEFINT A-V
DEFSTR W-Z
Declare SUB Eingabe (a, b, c0, e, f, f0, i, w, c, h, g)
'
SUB Eingabe (a, b, c0, e, f, f0, i, w, c, h, g)
j = 1: k = 0: h = f AND 7: b = b - 1
E1:
LOCATE a, b + j, 1, 12 - (j > e) - k, 13
E2:
X = INKEY$
IF X = "" THEN ON UP GOTO E5: GOTO E2
D = ASC(X)
IF D THEN
GOTO E3
ELSE
D = ASC(MID$(X, 2))
IF D < 59 AND D <> 15 OR D = 69 OR D = 70 OR D = 74 OR D = 76 OR D = 78 OR D = 114 OR D > 119 AND D <> 132 GOTO E45
END IF
i = 1 - (D > 58) - (D > 70) - (D > 71) - (D > 72) - (D > 74) - (D > 76) - (D > 78) - (D > 79)
i = i - (D > 80) - (D > 81) - (D > 82) - (D > 83) - (D > 93) - (D > 103) - (D > 114) - (D > 115)
i = i - (D > 116) - (D > 117) - (D > 118) - (D > 131)
ON i GOTO E27, E34, E20, E14, E16, E25, E22, E21, E15, E17
ON i - 10 GOTO E44, E38, E35, E36, E37, E29, E28, E32, E19, E30, E18
E3:
ON -(D = 8) - 2 * (D = 9) - 3 * (D = 10) - 4 * (D = 13) - 5 * (D = 27) GOTO E42, E26, E33, E8, E43
IF D < 32 AND D <> 21 OR D > 154 AND D <> 225 GOTO E45
IF h = 0 THEN
IF (f AND 8192) = 0 THEN
GOTO E4
ELSE
IF D > 64 AND D < 91 OR D = 32 OR D = 38 OR D > 43 AND D < 48 THEN
GOTO E4
ELSE
IF D > 96 AND D < 123 THEN
D = D - 32: X = CHR$(D): GOTO E4
ELSE
GOTO E45
END IF
END IF
END IF
END IF
IF D <> 74 AND D <> 106 AND D <> 78 AND D <> 110 AND D <> 69 AND D <> 101 THEN
ON h GOTO E6, E6, E7, E7, E45
END IF
'-- J,N,E --
c = 0
IF (D = 74 OR D = 106) AND (f AND 16) THEN PRINT "J"; : D = 0: i = 1: EXIT SUB
IF (D = 78 OR D = 110) AND (f AND 32) THEN PRINT "N"; : D = 0: i = 2: EXIT SUB
IF (D = 69 OR D = 101) AND (f AND 64) THEN D = 0: i = 3: EXIT SUB
GOTO E45
E4: ' -- a-num. --
IF j > e THEN
GOTO E45
ELSE
PRINT X;
IF j > g THEN g = g + 1: MID$(w, g) = X: GOTO E5
END IF
IF k THEN
PRINT MID$(w, j, g - j - (g < e));
MID$(w, j + 1) = MID$(w, j): MID$(w, j) = X: k = -(j < e)
j = j + 1: g = g - (g < e): GOTO E1
ELSE
MID$(w, j) = X
END IF
E5:
j = j + 1: GOTO E1
E6: '-- 0...9 --
IF D < 48 - (h = 2) OR D > 48 + i THEN
GOTO E45
ELSE
PRINT X; : LOCATE , , 0: c = 0: h = D - 48: D = 0: i = 0: EXIT SUB
END IF
E7: '-- numer.--
IF D > 47 AND D < 58 OR D = 32 OR D = 45 AND h = 4 OR (D = 44 OR D = 46) AND (f AND 512) THEN
GOTO E4
ELSE
GOTO E45
END IF
E8: '-- Enter --
c = 1
E9:
IF (c0 AND 2 ^ (c - 1)) = 0 GOTO E45
E10:
LOCATE , , 0
ON h GOTO E11, E13, E12, E12, E13
E11:
IF g = 0 THEN
EXIT SUB
ELSE
IF MID$(w, g, 1) = " " THEN
g = g - 1: GOTO E11
ELSE
EXIT SUB
END IF
END IF
E12:
h = -VAL(w) * (ABS(VAL(w)) < 32767)
E13:
EXIT SUB
E14: '-- Cu up --
c = 2: GOTO E9
E15: '-- Cu dn --
c = 3: GOTO E9
E16: '-- Pg up --
c = 4: GOTO E9
E17: '-- Pg dn --
c = 5: GOTO E9
E18: '-- C Pup --
c = 6: GOTO E9
E19: '-- C Pdn --
c = 7: GOTO E9
E20: '-- Home --
IF h = 0 THEN j = 1: k = 0: GOTO E1 ELSE c = 8: GOTO E9
E21: '--- End ---
IF h = 0 THEN j = g - (g < e): k = 0: GOTO E1 ELSE c = 9: GOTO E9
E22: '-- Cr re --
IF h = 0 THEN j = j + (j <= g) * (j < e): GOTO E23 ELSE c = 10: GOTO E9
E23:
LOCATE a, b + j, 1, 12 - (j > e), 13: k = 0: i = 0
E24:
X = INKEY$
IF X = "" THEN
i = i + 1
IF i < 5 GOTO E24 ELSE GOTO E2
END IF
IF X = CHR$(0) + "M" GOTO E22
IF X = CHR$(0) + "K" GOTO E25 ELSE GOTO E2
E25: '-- Cr li --
IF h = 0 THEN j = j + (j > 1): GOTO E23 ELSE c = 11: GOTO E9
E26: '-- Tab r --
c = 12: GOTO E9
E27: '-- Tab l --
c = 13: GOTO E9
E28: '-- C Cre --
c = 14: GOTO E9
E29: '-- C Cli --
c = 15: GOTO E9
E30: '-- C Home--
c = 16
E31:
IF (f AND 2 ^ (c - 6)) GOTO E10 ELSE GOTO E45
E32: '-- C End --
IF h = 0 THEN
PRINT SPC(g - j - (j <= e)); : g = j - 1: k = 0
w = LEFT$(w, g): GOTO E1
ELSE
c = 17: GOTO E31
END IF
E33: '-- C Entr--
c = 18: GOTO E31
E34: '-- F.. --
D = D - 58: IF (f0 AND 2 ^ (D - 1)) = 0 GOTO E45 ELSE c = 0: GOTO E10
E35:
D = D - 83: IF (F1 AND 2 ^ (D - 1)) = 0 GOTO E45 ELSE c = 0: GOTO E10
E36:
D = D - 93: IF (F2 AND 2 ^ (D - 1)) = 0 GOTO E45 ELSE c = 0: GOTO E10
E37:
D = D - 103: IF (F3 AND 2 ^ (D - 1)) = 0 GOTO E45 ELSE c = 0: GOTO E10
E38: '-- Del --
IF j < g THEN
LOCATE , , 0
PRINT MID$(w, j + 1, g - j); " "; : MID$(w, j) = MID$(w, j + 1)
LOCATE a, b + j, 1
MID$(w, g) = " ": g = g - 1
IF INKEY$ = XS THEN X = INKEY$: X = INKEY$: GOTO E38 ELSE GOTO E41
END IF
E39:
IF g = 0 GOTO E45
IF g = j THEN LOCATE a, b + g: PRINT " "; : k = 0: GOTO E40
LOCATE a, b + g: PRINT " "; : j = j - 1
E40:
LOCATE a, b + j, 1, 12 - k, 13: MID$(w, g) = " ": g = g - 1: i = 0
E41:
X = INKEY$
IF X = "" THEN i = i + 1: IF i < 5 GOTO E41 ELSE GOTO E2
IF X = XS GOTO E38
IF X = CHR$(8) GOTO E42
GOTO E2
E42: '-- <== --
IF j = 1 GOTO E45
LOCATE , , 0
IF j <= g THEN
X = INKEY$: LOCATE a, b + j - 1
PRINT MID$(w, j, g - j + 1); " "; : MID$(w, j - 1) = MID$(w, j)
j = j - 1: GOTO E40
END IF
GOTO E39
E43: '-- Esc --
IF g = 0 GOTO E45
LOCATE a, b + 1: PRINT SPC(g); : w = "": g = 0: j = 1: k = 0: GOTO E1
E44: '-- Ins --
IF h OR j > g GOTO E45 ELSE k = -(k = 0): GOTO E1
X = INKEY$: X = INKEY$
E45:
Beep: GOTO E2
E50:
EinFehler% = 1
END SUB