Turbo Toolbox/Turbo_Toolbox.iso/1989/02/heimwerk/makemenu.bas

BASIC Source File | 1988-11-11 | 5.7 KB | 190 lines

REM * ---------------------------------------------------- *
REM *                 MAKEMENU.BAS                         *
REM *      Menuegenerator für Turbo/Quick Basic            *
REM *               (c) 1988  TOOLBOX                      *
REM * ---------------------------------------------------- *

DEF FNPrintLine$ (S$, Max%)
  LOCAL j%, Zeile$              ' (Für Quick Basic: STATIC)

  Zeile$ = S$
  FOR j% = 1 TO Max% - Len(S$)
    Zeile$ = Zeile$ + " "
  NEXT j%
  FNPrintLine$ = Zeile$

END DEF


CLS
COLOR 15, 1
LOCATE 1,30 : PRINT "Menuegenerator"
LOCATE 4,10 : PRINT "Wieviele Punkte soll das Menue haben ";
CALL Eingabe(2, 50, 4, "w", antwort$)
pkte% = VAL(antwort$)

DIM menue$(pkte%)

LOCATE 6,10 : PRINT "Bitte geben Sie die Stichworte ein: ";
LOCATE 8,10 : PRINT "Punkt ";
FOR i% = 1 TO pkte%
  LOCATE 8,16: PRINT i%; ": "
  CALL Eingabe(40, 20, 8, "t", antwort$)
  menue$(i%) = antwort$
NEXT i%
CLS
LOCATE 1,30 : PRINT "Menuegenerator"
LOCATE 4,10 : PRINT "Koordinaten der linken oberen Ecke ?";
LOCATE 6,10 : PRINT "x: ";
CALL Eingabe(2, 13, 6, "w", antwort$)
ox% = VAL(antwort$)
LOCATE 7,10 : PRINT "y: ";
CALL Eingabe(2, 13, 7, "w", antwort$)
oy% = VAL(antwort$)
LOCATE 9,10 : PRINT "Wie soll die Datei heißen ? "
CALL Eingabe(11, 38, 9, "t", antwort$)
Dateiname$ = antwort$
LOCATE 10,10 : PRINT "Und das Menue ? "
CALL Eingabe(10, 38, 10, "t", antwort$)
Menuename$ = antwort$ + "$"

OPEN Dateiname$ FOR OUTPUT AS #1
  REM PRINT #1, "DECLARE SUB PopUpMenue (x%, y%, Texte$(1)";
  REM PRINT #1, ", Items%, Mono%, Res%, Res$)"
  PRINT #1, "DIM ";Menuename$;" (";pkte%;")"
  FOR i% = 1 TO pkte%
    PRINT #1, Menuename$; "(" ; i%; ") = "; CHR$(34);
    PRINT #1, menue$(i%); CHR$(34)
  NEXT i%
  PRINT #1, CHR$(13)
  PRINT #1, "CALL PopUpMenue(";ox%;",";oy%;",";Menuename$;
  PRINT #1, "(),";pkte%;",0,Res%,Res$)"
  PRINT #1, "REM Das Ergebnis steht jetzt in a% und a$"
  OPEN "POPUP.INC" FOR INPUT AS #2
    WHILE NOT EOF(2)
      LINE INPUT #2, Prozedurzeile$
      PRINT #1, Prozedurzeile$
    WEND
  CLOSE #2
CLOSE #1
LOCATE 12,10: PRINT "Okay, das war's..."
END

SUB Eingabe(feldlen%, spos%, zpos%, vartyp$, antwort$)

  LOCAL sammel$       'sammelt die geprüften Zeichen
  LOCAL taste$        'für das letzte eingegebene Zeichen
  LOCAL dezimal%      'Schalter für Dezimalpunkt
  LOCAL muell$        'Dummy zum Löschen des Tastaturpuffers
  LOCAL punkte%       'zum Aufbau des Eingabefeldes
  LOCAL punkte$, schleife%

  REM In Quick Basic müssen die LOCAL-Deklarationen
  REM wegfallen, weil die Variablen in einer Prozedur
  REM per Default Lokal sind

  taste$ = CHR$(1)            'Einstieg in die Hauptschleife
  IF zpos% < 1 OR zpos% > 25 THEN GOSUB Fehler
  IF spos% < 1 OR spos% > 80 THEN GOSUB Fehler
  IF feldlen% < 1 OR feldlen% > (79 - spos%) THEN
    GOSUB Fehler
  END IF
  IF vartyp$ <> "t" AND vartyp$ <> "w" THEN GOSUB Fehler

  LOCATE zpos%, spos%
  PRINT CHR$(242);               'Zeichen für den Prompt "≥"
  PRINT STRING$(feldlen%, "_");

  WHILE taste$ <> CHR$(13)         'Verlassen mit < RETURN >
    taste$ = ""
    WHILE taste$ = ""
      taste$ = INKEY$         'Warte und hole erstes Zeichen
    WEND
    muell$ = INKEY$
    IF muell$ = "" THEN GOSUB Abfrage  'Tastaturpuffer  leer
    WHILE muell$ <> ""
      muell$ = INKEY$                'Löschen Tastaturpuffer
    WEND
  WEND
  antwort$ = sammel$                 'Ergebnis bereitstellen
  GOTO Feierabend                    'Unterprogramme werden
                                     'übersprungen

REM * ---------------------------------------------------- *
Abfrage:
  DO
    IF ASC(taste$)=27 OR ASC(taste$)=13 THEN GOTO ExitLoop
    IF ASC(taste$)<13 AND ASC(taste$)<>8 THEN GOTO ExitLoop
    IF ASC(taste$) = 8 AND sammel$ = "" THEN GOTO ExitLoop
    IF ASC(taste$) = 8 AND RIGHT$(sammel$, 1) = "." THEN
      dezimal% = 0
    END IF
    IF ASC(taste$) = 8 THEN
      GOSUB Backspace
      GOTO Update
    END IF

    IF LEN(sammel$) = feldlen% THEN GOTO ExitLoop

    schleife% = -1
    WHILE vartyp$ = "w" AND schleife% = -1

      IF taste$ = "," THEN taste$ = "."      'Komma -> Punkt

      IF dezimal% = 0 AND ASC(taste$) = 46 THEN
        dezimal% = 1               'Dezimalflag setzen
        GOTO EndWhile
      END IF

      IF dezimal% = 1 AND ASC(taste$) = 46 THEN
        taste$ = ""
        GOTO EndWhile
      END IF

      IF taste$ = "-" AND sammel$ = "" THEN GOTO EndWhile
                                         'erstes zeichen "-"

      IF ASC(taste$) > 47 AND ASC(taste$) < 58 THEN
        GOTO EndWhile
      END IF                          'nur Ziffern zulassen

      taste$ = ""               'Falsche Eingabe, ignorieren
      EndWhile:
      schleife% = 0
    WEND

    sammel$ = sammel$ + taste$
                              'Anfügen des gültigen Zeichens
Update:
    taste$ = ""
    punkte% = feldlen% - LEN(sammel$)  'Update Eingabefeldes
    IF punkte% <= 0 THEN                     '...am Feldende
      punkte$ = ""
    ELSE
      punkte$ = STRING$(punkte% - 1, "_")
    END IF
    LOCATE zpos%, spos%
    PRINT sammel$;                     '...bisherige Eingabe
    PRINT CHR$(242);                   '...Prompt "≥"
    PRINT punkte$; " ";                '...Unterstriche
  LOOP UNTIL 1 = 1             'Bedingung für Endlosschleife
  ExitLoop:
RETURN

REM * ---------------------------------------------------- *
Backspace:
  sammel$ = LEFT$(sammel$, LEN(sammel$) - 1)
RETURN

Fehler:
  LOCATE 25, 2
  BEEP: BEEP: BEEP
  PRINT "Fehlerhafte Parameterübergabe, Programmabbruch"
  END
RETURN

Feierabend:
  END SUB

REM * ---------------------------------------------------- *