Code-Beispiel

InputUsing: erweiterte Eingabemaske

Lizenz:	Erster Autor:	Letzte Bearbeitung:
FBPSL	nemored	15.12.2013

Ein Nachbau des Befehls INPUT USING von OMIKRON BASIC: Der Befehl ermöglicht es, bei der Eingabe gezielt bestimmte Werte zuzulassen, Zeichen automatisch zu ersetzen sowie verschiedene Abbruchbedingungen auszuwerten.

function inputUsing (y as integer = 0, x as integer = 0, _

                 text as string = "", value as string = "", control as string = "0a%", _

                 byref retvar as string = chr(13), length as integer = 255, _

                 fill as string = "_", byref cursor as integer = 0) as string

  /' Parameter:

     'y', 'x':  Startposition; bei Angaben < 1 wird die aktuelle Cursorposition verwendet

     'text':    zuvor ausgegebener Aufforderungstext

     'value':   Vorbelegung des Eingabestrings

     'control': erlaubte Zeichen und Kontrollstrukturen

                0    Ziffern 0-9 erlauben

                a    Buchstaben a-z und A-Z erlauben (keine Umlaute)

                %    Sonderzeichen erlauben (einschliesslich Umlaute)

                +n   zusaetzlich das Zeichen n erlauben

                -n   Zeichen n ausschliessen

                cmn  Zeichen m (zulassen und) waehrend der Eingabe durch n ersetzen

                u    Kleinbuchstaben a-z durch Grossbuchstaben ersetzen (keine Umlaute)

                l    Grossbuchstaben a-z durch Kleinbuchstaben ersetzen (keine Umlaute)

                xn   Eingabe verlassen mit Ascii-Code n

                sn   Eingabe verlassen mit Scancode n

                >    Eingabe verlassen bei rechter Randueberschreitung

                <    Eingabe verlassen bei linker Randueberschreitung

                Gross-/Kleinschreibung der Kontrollzeichen wird ignoriert.

                Unabhaengig von xn und sn wird die Eingabe immer mit CHR(13) verlassen.

     'retvar':  Taste, mit der die Eingabe verlassen wurde

                Sonderfaelle: CHR(0) bei Randueberschreitung (siehe auch 'cursor')

     'length':  maximale Laenge des Eingabestrings

     'fill':    Fuellzeichen; nur das erste angegebene Zeichen wird verwendet

     'cursor':  Eingabe: Cursor-Position zu Beginn; Rueckgabe: Curserposition beim Verlassen

  '/



  ' Startposition ermitteln, Starttext und Vorgabewert ausgeben

  dim as integer startX = iif(x < 1, pos, x), startY = iif(y < 1, csrlin, y), visible = hiword(locate)

  dim as string rueckgabe = left(value, length), ausgabe = rueckgabe & string(length-len(value), fill)

  dim as integer bgcolor = hiword(color), fgcolor = loword(color)

  locate starty, startx

  print text;

  startX = pos

  startY = csrlin

  print ausgabe;

  locate starty, startx, 1

  if cursor < 1 or cursor > len(rueckgabe) then cursor = len(rueckgabe) + 1

  print left(ausgabe, cursor-1);



  ' Steuerzeichen parsen

  dim as string inputchar, exitchar = chr(13), exitscan = "", ersetzeVon = "", ersetzeZu = ""

  dim as integer updown = 0, leftright = 0, i = 0

  do while i < len(control)

    select case control[i]

      case 65, 97  ' Buchstaben

        for k as integer = 65 to 90

          inputchar &= chr(k) & chr(k+32)

        next

      case 48      ' Zahlen

        for k as integer = 48 to 57

          inputchar &= chr(k)

        next

      case 37      ' Sonderzeichen = -1

        for k as integer = 32 to 47

          inputchar &= chr(k)

        next

        for k as integer = 58 to 64

          inputchar &= chr(k)

        next

        for k as integer = 91 to 96

          inputchar &= chr(k)

        next

        for k as integer = 123 to 254

          inputchar &= chr(k)

        next

      case 76, 108 : updown = 1  ' lower case

      case 85, 117 : updown = 2  ' upper case

      case 43      ' Taste hinzufuegen

        if i = len(control) - 1 then error 1 : retvar = "" : return value

        i += 1

        inputchar &= chr(control[i])

      case 45

        if i = len(control) - 1 then error 1 : retvar = "" : return value

        i += 1

        dim as integer k = 0

        do while k < len(inputchar)

          if inputchar[k] = control[i] then

            inputchar = left(inputchar, k) & mid(inputchar, k + 2)

          else

            k += 1

          end if

        loop

      case 88, 120 ' Exit-Asciicode hinzufuegen

        if i = len(control) - 1 then error 1 : retvar = "" : return value

        i += 1

        exitchar &= chr(control[i])

      case 83, 115 ' Exit-Scancode hinzufuegen

        if i = len(control) - 1 then error 1 : retvar = "" : return value

        i += 1

        exitscan &= chr(control[i])

      case 62      : leftright or= 1  ' Verlassen bei rechter Ueberschreitung

      case 60      : leftright or= 2  ' Verlassen bei linker Ueberschreitung

      case 67, 99  ' Zeichenersetzung

        if i > len(control) - 3 then error 1 : retvar = "" : return value

        ersetzeVon &= chr(control[i+1])

        ersetzeZu  &= chr(control[i+2])

        i += 2

    end select

    i += 1

  loop

  ' Eingaberoutine

  dim taste as string, such as integer

  do

    do

      taste = inkey

      if screenptr andalso cursor <= len(ausgabe) then

        ' Cursor

        if frac(timer) > .5 then           ' Blinkfrequenz 1/2 Sekunde

          color bgcolor, fgcolor           ' invertierte Schrift

        end if

        locate starty, startx + cursor - 1 ' Bildschirmposition des Textcursors

        print chr(ausgabe[cursor-1]);     ' Zeichen an Cursorposition auf aktuelle Farbe setzen

        color fgcolor, bgcolor             ' normale Farbe

      end if

      sleep 1

    loop until len(taste)

    ' Exit-Taste

    if taste[0] = 255 andalso instr(exitScan, mid(taste, 2)) then

      retvar = taste

      exit do

    elseif instr(exitchar, taste) then

      retvar = taste

      exit do

    end if

    if taste = chr(255, 75) then

      ' Pfeiltaste links

      if cursor > 0 then cursor -= 1

    elseif taste = chr(255, 77) then

      ' Pfeiltaste rechts

      if cursor <= len(rueckgabe) then cursor += 1

    elseif taste = chr(8) then

      ' Backspace-Taste

      if cursor > 1 then

        rueckgabe = left(rueckgabe, cursor-2) & mid(rueckgabe, cursor)

        cursor -= 1

      end if

    elseif taste = chr(255, 83) then

      ' Delete-Taste

      if cursor < length then rueckgabe = left(rueckgabe, cursor-1) & mid(rueckgabe, cursor+1)

    elseif len(rueckgabe) < length then

      ' Taste einfuegen

      such = instr(ersetzeVon, taste)

      if such then

        ' zu ersetzendes Zeichen

        rueckgabe = left(rueckgabe, cursor-1) & chr(ersetzeZu[such-1]) & mid(rueckgabe, cursor)

        cursor += 1

      elseif instr(inputchar, taste) then

        ' normales Zeichen

        select case updown

          case 1 : taste = lcase(taste)

          case 2 : taste = ucase(taste)

        end select

        rueckgabe = left(rueckgabe, cursor-1) & taste & mid(rueckgabe, cursor)

        cursor += 1

      end if

    end if



    ' Text anzeigen

    rueckgabe = left(rueckgabe, length)

    ausgabe = rueckgabe & string(length-len(rueckgabe), fill)

    locate starty, startx

    print ausgabe;

    locate starty, startx

    ' rechts / links verlassen

    if leftright and 1 andalso cursor > length then retvar = chr(0) : exit do

    if leftright and 2 andalso cursor < 1 then retvar = chr(0) : exit do

    ' Cursor anpassen

    cursor = iif(cursor < 1, 1, iif(cursor > len(rueckgabe)+1, len(rueckgabe)+1, cursor))

    print left(ausgabe, cursor-1);

  loop

  ' beenden

  ausgabe = rueckgabe

  if fill <> "" then ausgabe &= string(length-len(rueckgabe), 32)

  locate starty, startx, visible

  print ausgabe

  return rueckgabe

end function

Beispiele für den Einsatz:
1) 20 Zeichen, nur Buchstaben, Ziffern und Leerzeichen sind erlaubt. Die Eingabe kann zusätzlich mit Escape ("x" & CHR(27)) beendet werden; dann wird auf den Anfangswert zurückgesetzt.

dim as string vorgabe = "Vorgabetext", retvar, eingabe

eingabe = inputUsing (,, "Text eingeben: ", vorgabe, "a0+ x" & chr(27), retvar, 20)

if retvar = chr(27) then eingabe = vorgabe

print "Gespeicherter Wert: " & eingabe

2) Datumseingabe, nur Ziffern. Die Eingabe erfolgt in drei getrennten Schritten Tag/Monat/Jahr, wobei fließend zwischen den drei Eingabemasken gewechselt werden kann ("<" bzw. ">"). Die Steuerung ist hier noch nicht optimal, kann aber als Anregung dienen.

dim as string tag = "", monat = "", jahr = "", retvar

dim as integer cursor = 1    ' Cursorposition vor bzw. nach der Eingabe

dim as integer eingabe = 1   ' aktuelle Eingabe (Tag, Monat oder Jahr)

cls

print "Datum eingeben: __.__.____"

do

  select case eingabe

    case 1

      tag = inputUsing(1, 17,, tag, "0>", retvar, 2,, cursor)

      locate 1, 17

      print tag & string(2-len(tag), "_")

    case 2

      monat = inputUsing(1, 20,, monat, "0<>", retvar, 2,, cursor)

      locate 1, 20

      print monat & string(2-len(monat), "_")

    case 3

      jahr = inputUsing(1, 23,, jahr, "0<>", retvar, 4,, cursor)

      locate 1, 23

      print jahr & string(4-len(jahr), "_")

  end select

  ' Nur das Verlassen links/rechts wird ausgewertet:

  ' bei Return wird in derselben Spalte fortgesetzt.

  if retvar = chr(0) then

    if cursor = 0 then   ' Verlassen über die linke Begrenzung:

      eingabe -= 1       ' zurück zur vorigen Spalte

      cursor = 3

    else                 ' Verlassen über die rechte Begrenzung:

      eingabe += 1       ' weiter zur nächsten Spalte

      cursor = 1

    end if

  end if

loop until eingabe = 4   ' Jahr wurde vollständig eingegeben

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 06.05.2012 von nemored angelegt.
Die aktuellste Version wurde am 15.12.2013 von nemored gespeichert.

Bearbeiten

Versionen