home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 06_07 / poptest.bas < prev    next >
Encoding:
BASIC Source File  |  1988-03-28  |  2.8 KB  |  102 lines
  1. '********************************************************
  2. '*                    POPTEST.BAS
  3. '* Demonstration der PopUp-Menue-Routine für Turbo Basic
  4.  
  5. DIM S$(5)
  6. S$(1) = "Erster Punkt" : S$(2) = "Zweiter Punkt"
  7. S$(3) = "Dritter" : S$(4) = "" : S$(5) = "Letzter"
  8. CLS
  9. FOR i% = 0 to 1999 : PRINT "X"; : NEXT i% 'Schirm füllen
  10. CALL PopUpMenue(20,3,S$(),5,0,Res%,Res$)
  11. WHILE INKEY$ = "" : WEND 'Warte auf Tastendruck
  12. PRINT Res%,Res$
  13. END
  14.  
  15. '***** PopUp-Menue Routine ******************************
  16.  
  17. SUB PopUpMenue(X%,Y%,Texte$(1),NrItems%,Mono%,Res%,Res$)
  18.  
  19. LOCAL MaxLen%, i%, j%, k%
  20. LOCAL Zeile%, AlteZeile%, Wahl$, Buffer%()
  21. DIM Buffer%(4000)
  22.  
  23. MaxLen% = 0
  24. FOR i% = 1 to NrItems%  '** Max. Textlänge ermitteln **
  25.   IF (Len(Texte$(i%)) > MaxLen%) THEN
  26.     MaxLen% = Len(Texte$(i%))
  27.   END IF
  28. NEXT i%
  29. '** Paßt das Menue auf den Bildschirm ? **
  30. IF ((X%+MaxLen%+1)<=80) AND ((Y%+NrItems%+1)<=25) THEN
  31.   ' Segment für Bildschirmspeicher
  32.   IF Mono% THEN DEF SEG = &HB000 ELSE DEF SEG = &HB800
  33.   '** Hintergrund retten **
  34.   FOR i% = 0 TO 3999
  35.     Buffer%(i%) = PEEK(i%)
  36.   NEXT i%
  37.   '** Rahmen malen **
  38.   LOCATE Y%,X%
  39.   PRINT "╔";
  40.   FOR i% = 1 TO MaxLen% : PRINT "═"; : NEXT i%
  41.   PRINT "╗";
  42.   FOR i% = 1 TO NrItems%
  43.     LOCATE(Y%+i%),X%
  44.     PRINT "║";
  45.     Call PrintLine(Texte$(i%),MaxLen%)
  46.     PRINT "║";
  47.   NEXT i%
  48.   LOCATE(Y%+NrItems%+1),X%
  49.   PRINT "╚";
  50.   FOR i% = 1 TO MaxLen% : PRINT "═"; : NEXT i%
  51.   PRINT "╝";
  52.  
  53.   '** Benutzerauswahl **
  54.   Zeile% = 1 : AlteZeile% = NrItems% : Wahl$ = CHR$(0)
  55.   '** Warte bis Benutzer gewählt hat **
  56.   WHILE Wahl$ <> CHR$(13)
  57.     '** Hat sich was geändert ? **
  58.     IF Zeile% <> AlteZeile% THEN
  59.       Locate Y%+AlteZeile%,X%+1
  60.       COLOR 7,0
  61.       CALL PrintLine(Texte$(AlteZeile%),MaxLen%)
  62.       Locate Y%+Zeile%,X%+1
  63.       COLOR 0,7  ' Invers
  64.       CALL PrintLine(Texte$(Zeile%),MaxLen%)
  65.     END IF
  66.     Wahl$ = INKEY$
  67.     '** Cursor-Tasten in ^E/^X wandeln **
  68.     IF LEN(Wahl$)=2 THEN
  69.       IF RIGHT$(Wahl$,1) = CHR$(72) THEN
  70.         Wahl$ = CHR$(5)
  71.       ELSE
  72.         IF RIGHT$(Wahl$,1) = CHR$(80) THEN
  73.           Wahl$ = CHR$(24)
  74.         END IF
  75.       END IF
  76.     END IF
  77.     IF Wahl$ = CHR$(5) THEN '** Balken rauf **
  78.       AlteZeile% = Zeile% : Zeile% = (Zeile% - 1)
  79.       IF Zeile% = 0 THEN Zeile% = NrItems%
  80.     END IF
  81.     IF Wahl$ = CHR$(24) THEN '** Balken runter **
  82.       AlteZeile% = Zeile% :  Zeile% = (Zeile% + 1)
  83.       IF Zeile% > NrItems% THEN Zeile% = 1
  84.     END IF
  85.   WEND
  86.   Res% = Zeile%
  87.   Res$=Texte$(Zeile%)
  88.   '** Bildschirm restaurieren **
  89.   FOR i% = 0 TO 3999
  90.     POKE i%,Buffer%(i%)
  91.   NEXT i%
  92. END IF
  93. END SUB
  94.  
  95. '**** Hilfsroutine ****
  96. SUB PrintLine(S$,MaxLen%)
  97. LOCAL i%
  98. PRINT S$;
  99. FOR i% = 1 TO MaxLen%-Len(S$) : PRINT " "; : NEXT i%
  100. END SUB
  101.  
  102. '****** Ende PopUpMenue ********************************