home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 11 / einsteig / toolshft.bas < prev    next >
Encoding:
BASIC Source File  |  1990-10-05  |  7.4 KB  |  222 lines
  1. ' *********************************************************
  2. '                 Toolshft.Bas für Quick Basic
  3. '              (c) 1990 Th.Frins/W.Kehr & toolbox
  4. '              enthält diverse SUBs und Functions
  5. '        --   mehr dazu auf den DATABOX-Disketten:   --
  6. ' die mit ' auskommentierten Funktionen und Unterprogramme
  7. ' sind bei der DATABOX-Version im Quellcode enthalten.
  8. ' Sie stellen weitere interessante Routinen zur Verfügung.
  9. ' *********************************************************
  10.  
  11. DECLARE SUB Normal ()
  12. DECLARE SUB Invers ()
  13. DECLARE SUB Warten (ZeilenNr%)
  14. DECLARE SUB Fehlmeld (ZeilenNr%, Fehlertext$)
  15. DECLARE SUB HellBlinken ()
  16. DECLARE SUB Unterstrichen ()
  17. DECLARE SUB Hell ()
  18. DECLARE SUB Blinken ()
  19. DECLARE SUB BildLoeschen (ZeileLinksOben%, SpalteLinksOben%,
  20.             ZeileRechtsUnten%, SpalteRechtsUnten%,
  21.             LoeschZeichen$)
  22. DECLARE SUB Rahmen (ZeileLinksOben%, SpalteLinksOben%,
  23.             ZeileRechtsUnten%, SpalteRechtsUnten%,
  24.             RahmenZeichen$)
  25. ' DECLARE SUB Pruefuebergabe (zeile%, spalte%, typ$,
  26. '             laenge%, nachkomma%, gueltig$, vorgabe$,
  27. '             vorzeichen%, komma%, fehler%)
  28. ' DECLARE SUB Numerisch (komma%, vorzeichen%, einfmerker%,
  29. '             eingabe$, laenge%, position%, v$)
  30. ' DECLARE SUB Zeichen (einfmerker%, eingabe$, laenge%,
  31. '             position%, v$)
  32. ' DECLARE SUB Sonder (typ$, vorzeichen%, komma%, cursor%,
  33. '             einfmerker%, eingabe$, laenge%, position%, v$)
  34. ' DECLARE FUNCTION BalkenMenue% (ZeilenNr%, SpaltenNr%,
  35. '             Elemente%, ErsteWahl%, abstand%, Optionen$())
  36. ' DECLARE FUNCTION ZeilenMenue% (ZeilenNr%, SpaltenNr%,
  37. '             Elemente%, ErsteWahl%, Optionen$())
  38.  
  39. ' *********************************************************
  40. ' Beispiel für eine Funktion
  41. ' FUNCTION BalkenMenue% (ZeilenNr%, SpaltenNr%, Elemente%,
  42. '                        ErsteWahl%, abstand%, Optionen$())
  43. '   FOR I% = 1 TO Elemente%
  44. '       differenz% = abstand% * (I% - 1)
  45. '       LOCATE ZeilenNr% + differenz%, SpaltenNr%, 0
  46. '       IF I% = ErsteWahl% THEN
  47. '           Invers
  48. '           PRINT "["; I%; "]"; SPACE$(3);
  49. '                  Optionen$(I% - 1); " ";
  50. '           Normal
  51. '           ...
  52. '           ...
  53. '   IF Taste$ = CHR$(27) THEN
  54. '      BalkenMenue% = Elemente%
  55. '   ELSE
  56. '      BalkenMenue% = ErsteWahl%
  57. '   END IF
  58. ' END FUNCTION
  59. ' *********************************************************
  60. DIM I AS INTEGER
  61.  
  62. ALLE$ = ""
  63. FOR I = 1 TO 255
  64.     IF I <> 13 AND I <> 27 THEN ALLE$ = ALLE$ + CHR$(I)
  65. NEXT I
  66. ' ************* Testen der Attribut-Prozeduren ************
  67. CLS
  68. PRINT "Ein Normaler Text"
  69. CALL Hell
  70. PRINT "Jetzt wirds Hell"
  71. CALL Normal
  72. PRINT "Zurück zur Normalität"
  73. CALL Blinken
  74. PRINT "Blinken geht auf den Geist"
  75. HellBlinken
  76. PRINT "Hellblinken noch mehr"
  77. Normal
  78. PRINT "Normalität ist nicht immer das Schlechteste"
  79. Unterstrichen
  80. PRINT "Unterstrichenes wirkt hervorgehoben"
  81. PRINT
  82. Invers
  83. PRINT "Invers - auch Revers genannt - braucht man oft"
  84. Normal
  85. PRINT "Schluß mit dem Zauber"
  86.  
  87. Warten (24)
  88. ' **** Test der Rahmen- und BildLoeschen - Prozeduren ****
  89. CLS
  90. CALL Fehlmeld(24, "Rahmen-Test läuft.....")
  91. FOR I = 1 TO 22
  92.     IF wert% < 176 THEN wert% = 179
  93.     IF I < 23 - I THEN
  94.         Rahmen I, I, 23 - I, 80 - I, CHR$(wert%)
  95.     ELSE
  96.         Rahmen 23 - I, I, I, 80 - I, CHR$(wert%)
  97.     END IF
  98.     wert% = wert% - 1
  99.     Warten (24)
  100. NEXT I
  101. CALL Fehlmeld(24, "BildLoeschen-Test läuft.....")
  102. wert2% = 32
  103. wert% = 219
  104. FOR I = 1 TO 11
  105.     SWAP wert2%, wert%
  106.     CALL BildLoeschen(I, I, 23 - I, 80 - I, CHR$(wert2%))
  107.     Warten (24)
  108. NEXT I
  109. ' *********************************************************
  110. SUB BildLoeschen (ZeileLinksOben%, SpalteLinksOben%,
  111.                   ZeileRechtsUnten%, SpalteRechtsUnten%,
  112.                   LoeschZeichen$)
  113.     IF LoeschZeichen$ = "" THEN LoeschZeichen$ = " "
  114.     FOR I% = ZeileLinksOben% TO ZeileRechtsUnten%
  115.         LOCATE I%, SpalteLinksOben%
  116.         PRINT STRING$(SpalteRechtsUnten% - SpalteLinksOben%
  117.         + 1, LoeschZeichen$);
  118.     NEXT I%
  119.     LOCATE 1, 1, 0
  120. END SUB
  121. ' *********************************************************
  122. SUB Blinken
  123.     COLOR 18, 0
  124. END SUB
  125. ' *********************************************************
  126. SUB Fehlmeld (ZeilenNr%, Fehlertext$)
  127.     LOCATE ZeilenNr%, 2, 0
  128.     PRINT Fehlertext$;
  129.     IF LEN(Fehlertext$) > 50 THEN
  130.         CALL Warten(ZeilenNr% + 1)
  131.     ELSE
  132.         CALL Warten(ZeilenNr%)
  133.     END IF
  134. END SUB
  135. ' *********************************************************
  136. SUB Hell
  137.     COLOR 10, 0
  138. END SUB
  139. ' *********************************************************
  140. SUB HellBlinken
  141.     COLOR 26, 0
  142. END SUB
  143. ' *********************************************************
  144. SUB Invers
  145.     COLOR 0, 7
  146. END SUB
  147. ' *********************************************************
  148. SUB Normal
  149.     COLOR 7, 0
  150. END SUB
  151. ' *********************************************************
  152. SUB Rahmen (ZeileLinksOben%, SpalteLinksOben%,
  153. ZeileRechtsUnten%, SpalteRechtsUnten%, RahmenZeichen$)
  154.     SELECT CASE RahmenZeichen$
  155.         CASE CHR$(201)
  156.             ZeichenLinksOben$ = CHR$(201)
  157.             ZeichenLinksUnten$ = CHR$(200)
  158.             ZeichenRechtsOben$ = CHR$(187)
  159.             ZeichenRechtsUnten$ = CHR$(188)
  160.             ZeichenWaagrecht$ = CHR$(205)
  161.             ZeichenSenkrecht$ = CHR$(186)
  162.         CASE CHR$(218)
  163.             ZeichenLinksOben$ = CHR$(218)
  164.             ZeichenLinksUnten$ = CHR$(192)
  165.             ZeichenRechtsOben$ = CHR$(191)
  166.             ZeichenRechtsUnten$ = CHR$(217)
  167.             ZeichenWaagrecht$ = CHR$(196)
  168.             ZeichenSenkrecht$ = CHR$(179)
  169.         CASE CHR$(213)
  170.             ZeichenLinksOben$ = CHR$(213)
  171.             ZeichenLinksUnten$ = CHR$(212)
  172.             ZeichenRechtsOben$ = CHR$(184)
  173.             ZeichenRechtsUnten$ = CHR$(190)
  174.             ZeichenWaagrecht$ = CHR$(205)
  175.             ZeichenSenkrecht$ = CHR$(179)
  176.         CASE CHR$(214)
  177.             ZeichenLinksOben$ = CHR$(214)
  178.             ZeichenLinksUnten$ = CHR$(211)
  179.             ZeichenRechtsOben$ = CHR$(183)
  180.             ZeichenRechtsUnten$ = CHR$(189)
  181.             ZeichenWaagrecht$ = CHR$(196)
  182.             ZeichenSenkrecht$ = CHR$(186)
  183.         CASE ELSE
  184.             ZeichenLinksOben$ = RahmenZeichen$
  185.             ZeichenLinksUnten$ = RahmenZeichen$
  186.             ZeichenRechtsOben$ = RahmenZeichen$
  187.             ZeichenRechtsUnten$ = RahmenZeichen$
  188.             ZeichenWaagrecht$ = RahmenZeichen$
  189.             ZeichenSenkrecht$ = RahmenZeichen$
  190.     END SELECT
  191.     LOCATE ZeileLinksOben%, SpalteLinksOben%
  192.     PRINT ZeichenLinksOben$; STRING$(SpalteRechtsUnten% -
  193.     SpalteLinksOben% - 1, ZeichenWaagrecht$);
  194.     ZeichenRechtsOben$;
  195.     FOR I% = ZeileLinksOben% + 1 TO ZeileRechtsUnten% - 1
  196.         LOCATE I%, SpalteLinksOben%
  197.         PRINT ZeichenSenkrecht$;
  198.         LOCATE I%, SpalteRechtsUnten%
  199.         PRINT ZeichenSenkrecht$;
  200.     NEXT I%
  201.     LOCATE ZeileRechtsUnten%, SpalteLinksOben%
  202.     PRINT ZeichenLinksUnten$; STRING$(SpalteRechtsUnten% -
  203.     SpalteLinksOben% - 1, ZeichenWaagrecht$);
  204.     ZeichenRechtsUnten$;
  205. END SUB
  206. ' *********************************************************
  207. SUB Unterstrichen
  208.     COLOR 1, 0
  209. END SUB
  210. ' *********************************************************
  211. SUB Warten (ZeilenNr%)
  212.     LOCATE ZeilenNr%, 55, 0
  213.     PRINT " Weiter mit ";
  214.     Invers
  215.     PRINT "<TASTE>";
  216.     Normal
  217.     dummy$ = INPUT$(1)
  218.     LOCATE ZeilenNr%, 2, 0
  219.     PRINT SPACE$(78);
  220. END SUB
  221. ' **************** Ende Toolshft.Bas **********************
  222.