Frage deutsch
~~~~~~~~~~~~
Wie kann ich Tastatureingaben fester Länge programmieren?
(Ersatz des INPUT-Befehls)
 

Question English
~~~~~~~~~~~~~~
How To Do Controlled Text Input in QBasic with Limited Length?
 

Antwort 1
~~~~~~~~~
[ von Thomas Antoni, 1999 - 4.5.2002 ]
Ob Du es glaubst oder nicht, dies ist eine der am allermeisten zu QBasic gestellten Fragen! Mit den Sprachmitteln von QBasic kann man nicht direkt eine auf eine bestimmte Anzahl von Zeichen beschränkte Eingabe realisieren. Dazu muss man sich selber eine nette kleine Eingaberoutine basteln und statt des INPUT-Befehl verwenden.
• Mein untenstehendes Programm INTEXT2.BAS zeigt ganz gut das Prinzip auf. Es ist leicht nachzuvollziehen, aber relativ unkomfortabel.
• Mein zweites, ebenfalls unten aufgeführtes Program INTEXT.BAS ist eine komfortablere, flexibel zu verwendende Eingaberoutine.
• EditLine von Pawel Kazakow ist wohl die komfortabelste Eingaberoutine in QBasic, aber auch sehr komplex. EditLine steht auf Pawels Homepage http://www.pkworld.de zum Herunterladen bereit.
• Das unten in "Answer 2" aufgeführte sehr gute Programm SHOPLIST.BAS demonstriert, wie man Datenbankeingaben in feste Felder eines Bildschirmformulars realisieren kann
 
*** Programm INTEXT2.BAS von Thomas Antoni
Die SUB intext$ kann anstelle des INPUT-Befehls verwendet werden. Der Übergabeparameter length% legt die Länge des Eingabefeldes fest. Das aufrufende Programm ist dafür verantwortlich, den Cursor an die Eingabestelle zu setzen und die Farbe des Eingabefeldes zu definieren.
 
Zurückgeliefert wird der eingegebene Text als String. Zahlenwerte lassen sich durch VAL(intext$) aus dem String ableiten, z.B. VAL("3.2") = 3.2 .
 
Die Funktion intext$ gestattet über die Zurück-Taste (Backspace) das Löschen des zuletzt eingegebenen Zeichens und mit Esc das Löschen des gesamten Eingabefeldes. Außerdem wird durch die "1" im Befehl LOCATE y, x, 1 der Cursor jeweils an die richtige Eingabestelle gesetzt. Weitere Editierfunktionen gibt es nicht. Damit ist INTEXT2.BAS aber schon wesentlich leistungsfähiger als die meisten in den Foren kursierenden Programmvorschläge.
 
'****************************************************************************
' INTEXT2.BAS = QBasic-Function zur Tasteneingabe definierter Laenge
' =====================================================================
' Ersetzt den INPUT-Befehl. An die FUNCTION intext$() wird die Laenge
' des Eingabefeldes uebergeben. intext$() realisiert dann eine auf diese
' Laenge begrenzte Tastatureingabe. Mit der Backspace-Taste laesst sich der
' Eingabtext editieren. Esc loescht das Eingabefenster.
'
' \ (c) Thomas Antoni, 4.5.02 - 5.11.02
' \ /\ Mailto:thomas@antonis.de
' ( ) http://www.antonis.de
' .( o ).
' ----==== Hottest QBasic Stuff on Earth !!! ====----
'
'****************************************************************************
DECLARE FUNCTION intext$ (length%)
DO
CLS
PRINT "Gib einen max. 12 Zeichen langen Text ein :": PRINT
COLOR 11
t$ = intext$(12)
COLOR 7
LOCATE 5: PRINT "Du hast " + t$ + " eingegeben"
PRINT : PRINT " <wiederholen mit beliebiger Taste | Abbruch mit Esc >"
DO: key$ = INKEY$: LOOP WHILE key$ = ""
IF key$ = CHR$(27) THEN END
LOOP
'
FUNCTION intext$ (length%)
column% = POS(0) 'Cursor-Spaltenposition sichern
text$ = "": key$ = ""
PRINT "[" + SPACE$(length%) + "]"; 'Eingabefeld anzeigen
DO
SELECT CASE key$
CASE CHR$(13): EXIT DO 'Eingabetaste -> Ende der Eingabe
CASE CHR$(27): text$ = "" 'Esc -> Text loeschen
CASE CHR$(8) 'Backspace-Taste
IF LEN(text$) > 0 THEN 'Falls Textlaenge > 0 ...
text$ = LEFT$(text$, LEN(text$) - 1) '... Text um 1 Zeichen kuerzen
END IF
CASE CHR$(29) TO CHR$(255) 'alfanumerisches Zeichen?
IF LEN(text$) = length% THEN 'hat Text schon die volle Laenge
text$ = LEFT$(text$, LEN(text$) - 1) + key$ 'letztes Zeichen austauschen
ELSE
text$ = text$ + key$ 'ansonsten Tastenzeichen anfuegen
END IF
END SELECT
LOCATE , column% + 1: PRINT SPACE$(length%); 'altem Text loeschen
LOCATE , column% + 1: PRINT text$; 'Neuen Text anzeigen
x% = LEN(text$) 'relative Cursorposition
IF x% = length% THEN x% = x% - 1 'Eingabefeld voll-> Cursor aufs letzte Zeichen
LOCATE , column% + x% + 1, 1 'Cursor anzeigen
DO: key$ = INKEY$: LOOP WHILE key$ = "" 'Warten bis Taste betaetigt
LOOP
intext$ = text$
END FUNCTION
 
Das obige Programm steht im Verzeichnis Progs\ zur Verfügung sowie online unter www.antonis.de/faq/progs/intext2.bas .
 
*** Programm INTEXT.BAS von Thomas Antoni
Dies Programm ist wesentlich komfortabler und ansprechender gestaltet als Intext2:
 
'****************************************************************************
' INTEXT.BAS = QBasic-Function zur Tasteneingabe definierter Laenge
' =====================================================================
' Die eigentliche Funktionalität ist in der FUNCTION Intext$ hinterlegt.
' Das Hauptprogramm ist eine kleine Demo für Intext$ .
'
' \ (c) Thomas Antoni, 12.07.99 - 18.2.04
' \ /\ Mailto:thomas@antonis.de
' ( ) http://www.antonis.de
' .( o ).
' ----==== Hottest QBasic Stuff on Earth !!! ====----
'
'
'****************************************************************************
DECLARE FUNCTION Intext$ (length%)
'
DO
CLS
LOCATE 4
PRINT " -----===== Willkommen zu Intext$! =====-----"
PRINT
PRINT " Gib einen 14 Zeichen langen Text ein:"
LOCATE 10, 8
'-------------------------
eingabe$ = Intext$(14)
'-------------------------
COLOR 15, 0 'Farbe wieder Weiss auf Schwarz
LOCATE 15, 2
IF eingabe$ = CHR$(27) THEN
PRINT "Du hast die Eingabe mit Esc abgebrochen,";
PRINT "und es wurde CHR(27) zurueckgeliefert"
ELSE
PRINT "Du hast folgendes eingegeben:"
LOCATE 17, 8
PRINT eingabe$
END IF
LOCATE 20, 2
PRINT "Wiederholung mit beliebiger Taste, Abbruch mit Esc"
DO: taste$ = INKEY$
LOOP WHILE taste$ = ""
LOOP WHILE taste$ <> CHR$(27)
CLS
LOCATE 12, 8
PRINT "Danke, dass Du Intext$ ausprobiert hast!"
SLEEP 1
END
FUNCTION Intext$ (length%)
'*****************************************************************************
' Intext$ (length%) - QBasic Funktion zur Tastatureingabe begrenzter Laenge
' ============================================================================
' Diese Funktion ersetzt den INPUT-Befehl und ermoeglicht Tastatur-Eingaben
' definierter Laenge.
' Die Funktion liefert maximal length% alphanumerische Text-Zeichen zurueck,
' die �ber die Tastatur eingeben werden koennen. Die Tastatureingabe wird
' mit der Enter-Taste abgeschlossen. Ein Editieren des Eingabetextes ist
' mit der Backspace-Taste moeglich. šber die Esc-Taste laesst sich eine
' Eingabe abbrechen; in diesem Falle liefert Intext den Wert CHR(27) zurueck
' (ASCII- Code von Esc).
' Die Cursortasten sowie Delete, Home und End werden nicht ausgewertet.
' Das Eingabefeld erscheint als blauer Kasten auf den Bildschirm. Das Echo
' der eingegebenen Zeichen erfolgt in gelb.
'
' Das aufrufende Programm ist dafuer verantwortlich
' - den Cursor vor dem Aufruf richtig zu setzen (z.B. mit LOCATE)
' - nach Abschluss der Funktion die alten Bildschirmfarben wiederher-
' zustellen
' - den Abbruch der Eingabe durch die Esc-Taste zu bearbeiten (in diesem
' Fall ist der Ruecklieferwert CHR$(27) ).
'
' (c) Thomas Antoni, 12.07.99 - 5.11.02
'****************************************************************************
COLOR 14, 3 'gelb auf cyan
begin% = POS(0): row% = CSRLIN 'Cursorposition Spalte/Zeile sichern
text$ = "": key$ = ""
DO
'------------------ Enter- und Esc-Taste bearbeiten -------------------------
IF key$ = CHR$(13) THEN EXIT DO 'Ende wenn Enter betaetigt
IF key$ = CHR$(27) THEN 'bei Abbruch ASCII-Zeichen von Esc
text$ = CHR$(27) 'zurueckliefern
EXIT DO
END IF
'------------------------ Backspace-Taste bearbeiten ------------------------
IF key$ = CHR$(8) AND LEN(text$) > 0 THEN 'Backspace und Textlaenge > 0 ?
text$ = LEFT$(text$, LEN(text$) - 1) 'Text um 1 Zeichen kuerzen
'-------------------------- andere Tasten bearbeiten ------------------------
ELSEIF key$ > CHR$(29) AND key$ < CHR$(255) THEN 'alfanum. Taste?
IF LEN(text$) = length% THEN 'Text hat schon die volle Laenge
text$ = LEFT$(text$, LEN(text$) - 1) + key$ 'letztes Zeichen austauschen
ELSE
text$ = text$ + key$ 'ansonsten Tastenzeichen anfuegen
END IF
END IF
'--------------- text$ und Cursor auf Bildschirm ausgeben -------------------
LOCATE row%, begin%: PRINT SPACE$(length%); 'Eingabefeld loeschen/blau faerben
LOCATE , begin%: PRINT text$; 'Text ausgeben
IF LEN(text$) < length% THEN csrpos% = POS(0) ELSE csrpos% = POS(0) - 1
LOCATE row%, csrpos%, 1, 1 'Cursor ausgeben
DO: key$ = INKEY$: LOOP WHILE key$ = "" 'warten bis Taste betaetigt
LOOP
LOCATE , , 0 'Cursor wieder deaktivieren
Intext$ = text$
END FUNCTION
 
 
Das obige Programm steht im Verzeichnis Progs\ zur Verfügung sowie online unter www.antonis.de/faq/progs/intext.bas .

 

Answer 2
~~~~~~~~
[ by Wouter Bergmann Tiest W.M.BergmannTiest*fys.ruu.nl 8th December 1995]
 
Below please find the program SHOPLIST.BAS which demonstrates how to realize limited-length keyboard inputs in several fields on the sreen, e.g. in a database input sheet.
 
In many situations, the standard input statements INPUT$ or LINE INPUT$ are not adequate. The length of the text cannot be limited, so your screen layout may become cluttered. Also, the program only continues when the Enter-key is pressed, and in many situations, it can be useful to be able to react to other keypresses as well.
 
The EDIT-function enables you to control the length of the input field, provide a default text and react to arrow keys, PgUp, PgDn, function keys, Esc and Enter. For the user, it gives full text editing possibilities, including Insert/Typeover switching with Insert and character erasing with Backspace and Delete.
 
The Edit-function is included in a demonstration program, SHOPLIST.BAS, which clearly illustrates the use of the function. The arguments of the function are three integers: the screen row and column of the first character of the input field, and the length of the input field. The fourth argument should be a string variable of sufficient length to hold the text. Note that the function changes the contents of this variable to the text put in. The return value is the ASCII-value or the scan code of the key that was used to end the input. Use the constants that are defined at the start of the program to compare the return value with, as shown in SHOPLIST.BAS. FgCol and BgCol are constants defining the foreground and background colors.
 
*** Program SHOPLIST.BAS
 
'***************************************************************************
' SHOPLIST.BAS Demo fuer laengenbegrenzte Tastatureingaben in Tabellenfelder
' ============
' Edit function for easy input of strings.
'
' (c) Wouter Bergmann Tiest <W.M.BergmannTiest*fys.ruu.nl>
' 8th December 1995
'***************************************************************************
'To use this function, replace the code between the dashed lines with your
'own.
'
DEFINT A-Z
DECLARE FUNCTION Edit (Column, Row, Length, Text$)
'
'Colours (light grey and blue) and ASCII or scan codes of keys
CONST FgCol = 7, BgCol = 1, Enter = 13, Escape = 27, UpArrow = 72
CONST DownArrow = 80, LeftArrow = 75, RightArrow = 77, Home = 71
CONST EndKey = 79, Ins = 82, Del = 83, Backspace = 8
'
'----------------------------------------------------------------------------
'The following code is an example of the use of the Edit function.
'It is an input routine for a shopping list, with two fields:
'Item and Price. After input, the list is printed on screen.
'
'The dimensions of the shopping list
CONST ItemLength = 20, PriceLength = 10, NumberOfItems = 10
CONST FirstRow = 5, ItemColumn = 5, PriceColumn = ItemColumn + ItemLength + 2
CONST NumberOfFields = 2, ItemField = 1, PriceField = 2
'
'The items and prices are stored in two arrays
DIM Item$(1 TO NumberOfItems), Price$(1 TO NumberOfItems)
'
'The screen is set up
COLOR FgCol, BgCol
CLS
PRINT "Please enter your shopping list below."
PRINT "Use arrow keys, Enter, Ins, Del, Home, End and BackSpace for editing."
PRINT "Press Escape when ready."
LOCATE FirstRow, ItemColumn
PRINT "Item"
LOCATE FirstRow, PriceColumn
PRINT "Price"
FOR Counter = 1 TO NumberOfItems
LOCATE Counter + FirstRow, 1
PRINT USING "##."; Counter
NEXT Counter
'
'Initial values
FieldCounter = ItemField
ItemCounter = 1
'
'Main loop of input routine
DO
SELECT CASE FieldCounter
CASE ItemField
KeyPressed = Edit(ItemColumn, ItemCounter + FirstRow, ItemLength, Item$(ItemCounter))
CASE PriceField
KeyPressed = Edit(PriceColumn, ItemCounter + FirstRow, PriceLength, Price$(ItemCounter))
END SELECT
SELECT CASE KeyPressed
CASE UpArrow
ItemCounter = ItemCounter - 1
IF ItemCounter < 1 THEN ItemCounter = NumberOfItems
CASE DownArrow
ItemCounter = ItemCounter + 1
IF ItemCounter > NumberOfItems THEN ItemCounter = 1
CASE Enter
FieldCounter = FieldCounter + 1
IF FieldCounter > NumberOfFields THEN
FieldCounter = 1
ItemCounter = ItemCounter + 1
IF ItemCounter > NumberOfItems THEN ItemCounter = 1
END IF
END SELECT
LOOP UNTIL KeyPressed = Escape
'
'Printing the data
CLS
PRINT "This is your shopping list:"
PRINT
FOR Counter = 1 TO NumberOfItems
PRINT USING "##."; Counter;
LOCATE , ItemColumn
PRINT Item$(Counter);
LOCATE , PriceColumn
PRINT Price$(Counter)
NEXT Counter
'
END
'----------------------------------------------------------------------------
FUNCTION Edit (Column, Row, Length, Text$)
'This function takes two screen coordinates (Row, Column) and paints an
'edit field in reverse video of length Length with Text$ as default value.
'The text can be edited using the left and right arrow keys, Home, End, Del
'and Backspace. Ins switches between insert mode (default) and typeover mode.
'On completion, the parameter Text$ contains the edited string.
'The function returns the ASCII or scan code of the key that was used to
'end the editing (can be up or down arrow, Enter or Escape).
'
'Initial values
KeyPressed = 0
InsertSwitch = -1 'True
COLOR BgCol, FgCol
Position = LEN(Text$)
'
'Main loop
DO
LOCATE Row, Column, 0
PRINT Text$; SPACE$(Length - LEN(Text$));
IF InsertSwitch = -1 THEN
LOCATE Row, Position + Column, 1, 7, 8 'Line cursor
ELSE
LOCATE Row, Position + Column, 1, 0, 8 'Block cursor
END IF
DO
Key$ = INKEY$
LOOP WHILE Key$ = ""
SELECT CASE ASC(Key$)
CASE Escape
KeyPressed = Escape
CASE Enter
KeyPressed = Enter
CASE Backspace
IF Position > 0 THEN
Text$ = LEFT$(Text$, Position - 1) + RIGHT$(Text$, LEN(Text$) - Position)
Position = Position - 1
END IF
CASE 0 'Extended codes
SELECT CASE ASC(RIGHT$(Key$, 1))
CASE Home
Position = 0
CASE LeftArrow
IF Position > 0 THEN Position = Position - 1
CASE RightArrow
IF Position < LEN(Text$) THEN Position = Position + 1
CASE EndKey
Position = LEN(Text$)
CASE Del
IF Position < LEN(Text$) THEN Text$ = LEFT$(Text$, Position) + RIGHT$(Text$, LEN(Text$) - Position - 1)
CASE Ins
InsertSwitch = -1 - InsertSwitch
CASE UpArrow
KeyPressed = UpArrow
CASE DownArrow
KeyPressed = DownArrow
END SELECT
CASE IS >= 32 'Normal characters
IF InsertSwitch = -1 THEN
IF LEN(Text$) < Length THEN
Text$ = LEFT$(Text$, Position) + Key$ + RIGHT$(Text$, LEN(Text$) - Position)
Position = Position + 1
END IF
ELSEIF Position < Length THEN
IF Position = LEN(Text$) THEN
Text$ = Text$ + Key$
ELSE
MID$(Text$, Position + 1, 1) = Key$
END IF
Position = Position + 1
END IF
END SELECT
LOOP UNTIL KeyPressed > 0
LOCATE Row, Column, 0
COLOR FgCol, BgCol
PRINT Text$; SPACE$(Length - LEN(Text$));
Edit = KeyPressed
END FUNCTION
 
This programm is available in the Progs\ directory and online under www.antonis.de/faq/progs/shoplist.bas .
 
 

Answer 3
~~~~~~~~~~~~
[ KELLY MUNDELL, July 29, 1993 ]
 
Following is a full line-editing subroutine that myself and programming partner James Parchen developed and refined over the last couple of years:
 

'***********************************************************************
' INTEXT5.BAS = Full Line-Editing Routine
' =========== Komfortable Eingaberoutine, ersetzt den INPUT-Befehl
'
' Deutsche Beschreibung
' ---------------------
' (von Thomas Antoni, 12.3.2006)
' Dieses Q(uick)Basic-Programm enthaelt eine komfortable Eingaberoutine,
' die den INPUT-Befehl ersetzt. Es ermoeglich eine Tastatureingabe mit
' definierter Laenge. Folgende Editeirtasten werden unterstuetzt:
' Cursor rechts/links, Backspace, Entf, Einfg, Esc und Eingabetaste.
' Den Sinn des Parameters Mask$ habe ich nicht verstanden :))
'
' English Description
' -------------------
' Following is a full line-editing subroutine that myself and
' programming partner James Parchen developed and refined over the
' last couple of years.
'
' (c) KELLY MUNDELL, July 29, 1993 - Released into public domain
'************************************************************************
'
DECLARE SUB KeyIn (Ver$, Ln$, Mask$, Fg%, Bg%, p%)
'
CLS
LOCATE 2, 2
CALL KeyIn("ALL", SPACE$(22), "", 0, 15, 0)
'22 Zeichen langes Eingabefeld mit schwarzer Schrift (0) auf weissem
'Hintergrund (15)
'
COLOR 7, 0
LOCATE 10, 2
PRINT "Your input was: "
LOCATE 11, 2
PRINT text$
SLEEP
END
DEFINT A-Z
'
'
SUB KeyIn (Ver$, Ln$, Mask$, Fg, Bg, p)
SHARED text$
'
'----------------------------------------------------------------------
' Parameters:
' Ver$ = "ALL" All Characters
' Ver$ = "a-z" Alpha Lower Case
' Ver$ = "A-Z" Alpha Upper Case
' Ver$ = "a-Z" Alpha Case off
' Ver$ = "#'s" Numbers Only
' Ln$ = SPACE$(Number of Characters to accept; max 79)
' Mask$ = "" i.e. To Enter DOB Mask$ would be " / / "
' Fg/Bg ForeGround Color/Background Color
' p Screen Page Number
'-----------------------------------------------------------------------
DIM Chk(10)
IF Mask$ <> "" THEN
Ln$ = Mask$
FOR Chk = 1 TO LEN(Mask$)
IF MID$(Mask$, Chk, 1) <> " " THEN Temp$ = Temp$ + STR$(Chk)
NEXT Chk
Mask$ = Temp$
END IF
S = POS(0): L = LEN(Ln$): COLOR Fg, Bg: PRINT Ln$; : IF p = 0 THEN p = 1
IF p > L THEN p = L + 1
LOCATE , S + p - 1, 1, 7, 7: Temp$ = ""
Alpha$ = " abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Num$ = " 0123456789"
IF UCASE$(LEFT$(Ver$, 4)) = "A-Z#" THEN Ver$ = Alpha$ + Num$ + MID$(Ver$, 5)
SELECT CASE LEFT$(Ver$, 3)
CASE "ALL": Caps = 0: Ver$ = Alpha$ + Num$ + "!@#$%^&*()-_+=\[]{};':,./<>? "
CASE "A-Z": Caps = 1: Ver$ = Alpha$ + MID$(Ver$, 4)
CASE "a-z": Caps = 2: Ver$ = Alpha$ + MID$(Ver$, 4)
CASE "a-Z": Caps = 0: Ver$ = Alpha$ + MID$(Ver$, 4)
CASE "#'s": Caps = 0: Ver$ = Num$ + MID$(Ver$, 4)
CASE ELSE: Caps = 0
END SELECT
a = 0: e = 0
WHILE a <> 13 AND a <> 27 AND a <> 10
DO
IF Caps = 0 THEN a$ = INKEY$
IF Caps = 1 THEN a$ = UCASE$(INKEY$)
IF Caps = 2 THEN a$ = LCASE$(INKEY$)
LOOP UNTIL a$ <> ""
a = ASC(a$): IF a = 0 THEN a = ASC(RIGHT$(a$, 1)) * -1
p = POS(0) - S + 1: R = POS(0)
'SCREEN , , 0, 0: COLOR 7, 0: CLS : PRINT a: END
'
SELECT CASE a
CASE -32 ' ALT-D For Dos Shell
SCREEN , , 0, 0: CLS
SHELL "Type EXIT [ENTER] To Return To Program"
SHELL
CASE -77: IF p < L + 1 THEN PRINT CHR$(28); ELSE BEEP ' Right arrow
CASE -75: IF p <> 1 THEN PRINT CHR$(29); ' Left arrow
CASE -71: LOCATE , S ' <Home>
CASE -119 ' <Ctrl+Home>
LOCATE , S: Ln$ = SPACE$(L): PRINT Ln$; : LOCATE , S
CASE -79
LOCATE , LEN(RTRIM$(Ln$)) + S ' <End>
CASE -117 ' <Ctrl+End>
Ln$ = LEFT$(Ln$, p - 1) + SPACE$(L - p + 1)
LOCATE , S, 0: PRINT Ln$; : LOCATE , R, 1
CASE -116 ' <Ctrl+RightArrow>
IF p <= L THEN
Chk = INSTR(p, Ln$, " ")
IF Chk <> 0 THEN
Temp$ = LEFT$(LTRIM$(MID$(Ln$, Chk)), 1)
IF Temp$ <> "" THEN LOCATE , S - 1 + INSTR(Chk, Ln$, Temp$), 1
ELSE
LOCATE , LEN(RTRIM$(Ln$)) + S
END IF
END IF
CASE -115 ' <Ctrl+LeftArrow>
Temp$ = RTRIM$(LEFT$(Ln$, p - 1))
IF INSTR(Temp$, " ") THEN
DO WHILE INSTR(Temp$, " ")
Chk = INSTR(Temp$, " "): MID$(Temp$, Chk, 1) = "X"
LOOP
LOCATE , Chk + S, 1
ELSE
LOCATE , S
END IF
CASE 8 ' <BackSpace>
IF p <> 1 THEN
Ln$ = LEFT$(Ln$, p - 2) + MID$(Ln$, p) + " "
LOCATE , S, 0: PRINT Ln$; : LOCATE , R - 1, 1
ELSE
Ln$ = RIGHT$(Ln$, L - 1) + " ": LOCATE , S, 0: PRINT Ln$;
LOCATE , p + S - 1, 1
END IF
CASE 127 '<Ctrl+ BckSpc>
IF p > L THEN p = L
Ln$ = SPACE$(p) + MID$(Ln$, p + 1)
LOCATE , S, 0: PRINT Ln$; : LOCATE , R, 1
CASE -83 '<Delete>
IF p <= L THEN
Ln$ = LEFT$(Ln$, p - 1) + MID$(Ln$, p + 1) + " "
LOCATE , S, 0: PRINT Ln$; : LOCATE , R, 1
END IF
CASE -82 '<Insert>
IF insert = 0 THEN insert = 1 ELSE insert = 0
IF insert = 0 THEN LOCATE , , 1, 7, 7
IF insert = 1 THEN LOCATE , , 1, 4, 7
CASE ELSE
IF INSTR(Ver$, a$) AND p <= L THEN 'Print Character
IF insert = 1 THEN
Ln$ = LEFT$(Ln$, p - 1) + a$ + MID$(Ln$, p, L - p + 1)
LOCATE , , 0: PRINT MID$(Ln$, p, L - p + 1); : LOCATE , R + 1, 1
ELSE
PRINT a$; : MID$(Ln$, p, 1) = a$
END IF
IF INSTR(Mask$, STR$(p + 1)) THEN PRINT MID$(Ln$, p + 1, 1);
ELSE IF a <> 13 AND a <> 27 THEN BEEP
END IF
END SELECT
WEND
'
IF a = 27 THEN Ln$ = SPACE$(L)
EndKeyIn:
Ln$ = RTRIM$(Ln$)
text$ = Ln$
END SUB
 
Das obige Programm steht im Verzeichnis Progs\ zur Verfügung sowie online unter www.antonis.de/faq/progs/intext5.bas .
 
 

Answer 4
~~~~~~~~~~~~~~~~~~
[ by BRIAN MCLAUGHLIN, Dec. 2, 1993 ]
 
'***************************************************************
' INTEXT6.BAS = Line Editor with adjustable input length
' =========== Eingaberoutine - Zeileneditor mit einstellbarer
' Eingabelaenge
'
' (c) by BRIAN MCLAUGHLIN, Dec. 2, 1993
'****************************************************************
DECLARE FUNCTION LineEdit$ (Row%, Col%, EntryLen%, Prompt$)
Row% = 4: Col% = 4
EntryLen% = 55 'number of spaces the entry can occupy
Prompt$ = "Write here: "
CLS
OutString$ = LineEdit$(Row%, Col%, EntryLen%, Prompt$)
LOCATE CSRLIN + 2, 4
PRINT "You said: "; OutString$
END
'====================================================
FUNCTION LineEdit$ (Row%, Col%, EntryLen%, Prompt$)
'====================================================
'
CONST TRUE = -1, FALSE = 0
'
DO: LOOP WHILE LEN(INKEY$) 'clears any impending keys
LOCATE Row%, Col%
'
PRINT Prompt$;
Col% = POS(0)
AllLength% = Col% + EntryLen%
IF AllLength% > 79 THEN EntryLen% = EntryLen% - (AllLength% - 80)
'
SHOW$ = STRING$(EntryLen%, CHR$(176)) 'use squares
PRINT SHOW$;
LOCATE Row%, Col%, 1, 7, 1 'a big cursor
'
' -----------------------------
' START OF MAIN PROCEDURE LOOP
' -----------------------------
'
DO 'it keeps going and going and going
DO
Akey$ = INKEY$ ' wait for some kind of input
LOOP UNTIL LEN(Akey$)
IF LEN(Akey$) = 1 THEN
Ky% = ASC(Akey$)
ELSE 'it must be an extended key like F1
Char2$ = RIGHT$(Akey$, 1)
Ky% = ASC(Char2$) * -1 'convert the keycode to a negative number
END IF
SELECT CASE Ky%
CASE 13 'on ENTER break out of LOOP
EXIT DO
CASE -75 ' on LEFT ARROW move left one position
IF (Cpos% > 0) THEN
Cpos% = Cpos% - 1
LOCATE Row%, Col% + Cpos%
END IF
CASE -77 ' on RIGHT ARROW move right
IF (Cpos% < length%) THEN
Cpos% = Cpos% + 1
LOCATE Row%, Col% + Cpos%
END IF
CASE -79 ' on END go to end of line
Cpos% = length%
LOCATE Row%, Col% + Cpos%
CASE -71 ' on HOME go to start of line
Cpos% = 0
LOCATE Row%, Col% + Cpos%
CASE -83 ' on a DEL keypress
IF (length% > 0) AND (Cpos% < length%) THEN
Temp1$ = LEFT$(OutPut$, Cpos%)
Temp2$ = RIGHT$(OutPut$, length% - Cpos% - 1)
OutPut$ = Temp1$ + Temp2$
length% = length% - 1
LOCATE Row%, Col%
PRINT OutPut$ + CHR$(176);
LOCATE Row%, Col% + Cpos%
END IF
CASE 8 ' on BACKSPACE
IF (length% > 0) AND (Cpos% > 0) THEN
Temp1$ = LEFT$(OutPut$, Cpos% - 1)
Temp2$ = RIGHT$(OutPut$, (length% - Cpos%))
OutPut$ = Temp1$ + Temp2$
length% = length% - 1
Cpos% = Cpos% - 1
LOCATE Row%, Col%
PRINT OutPut$ + CHR$(176);
LOCATE Row%, Col% + Cpos%
END IF
CASE 32 TO 126 'our "printable" characters
IF (length% < EntryLen%) THEN
Temp1$ = LEFT$(OutPut$, Cpos%)
Temp2$ = RIGHT$(OutPut$, length% - Cpos%)
OutPut$ = Temp1$ + CHR$(Ky%) + Temp2$
length% = length% + 1
Cpos% = Cpos% + 1
LOCATE Row%, Col%
PRINT OutPut$;
LOCATE Row%, Col% + Cpos%
END IF
END SELECT
LOOP
'
LOCATE , , 0 'turns the cursor off
LineEdit$ = OutPut$
END FUNCTION
 
Das obige Programm steht im Verzeichnis Progs\ zur Verfügung sowie online unter www.antonis.de/faq/progs/intext6.bas .

[ The QBasic-MonsterFAQ --- Start Page: www.antonis.de/faq ]