home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / heimw_q / machcurs.bas < prev    next >
Encoding:
BASIC Source File  |  1990-10-25  |  6.9 KB  |  250 lines
  1. DEFINT A-Z
  2. '*--------------------------------------------------------*
  3. '*                    MachCurs.Bas                        *
  4. '*  Das Programm benötigt die Mausbibliothek Mauslib.Bas  *
  5. '*          (c) 1991 E. Schütte & toolbox                 *
  6. '*                                                        *
  7. '*  Die Bibliothek 'MausLib' mit QB/Lmauslib einbinden!   *
  8. '*--------------------------------------------------------*
  9.  
  10. DECLARE SUB SetXSub ()
  11. DECLARE SUB SetYSub ()
  12. DECLARE SUB SetDot (setxpos AS INTEGER, setypos AS INTEGER)
  13. DECLARE SUB RemDot (setxpos AS INTEGER, setypos AS INTEGER)
  14. DECLARE SUB DateiMachen ()
  15. DECLARE SUB Schreiben ()
  16.  
  17. '* Prozeduren und Funktionen der Bibliothek 'MAUSLIB':
  18. DECLARE SUB Init ()
  19. DECLARE SUB GCurs (horiz%, vertik%, offset%, segm%)
  20. DECLARE SUB CursAn ()
  21. DECLARE SUB CursAus ()
  22. DECLARE SUB Grenzen (links%, oben%, rechts%, unten%)
  23. DECLARE SUB Geschwindigkeit (horiz%, vertik%)
  24. DECLARE FUNCTION XPos% ()
  25. DECLARE FUNCTION YPos% ()
  26. DECLARE FUNCTION Knopf% ()
  27.  
  28. CONST FALSE = 0, TRUE = -1
  29.  
  30. DIM SHARED restart AS INTEGER
  31. DIM SHARED again AS INTEGER
  32. DIM SHARED setx AS INTEGER, sety AS INTEGER
  33. DIM SHARED includename AS STRING
  34. DIM SHARED tabelle(1 TO 16, 1 TO 16) AS INTEGER
  35. DIM SHARED z1(15, 1) AS INTEGER
  36. '$INCLUDE: 'CURSOR.CUR'
  37.  
  38. RESTORE
  39. FOR i% = 0 TO 15
  40.   READ dummy$:
  41.   z1(i%, 1) = VAL(dummy$): z1(i%, 0) = NOT z1(i%, 1)
  42. NEXT i%
  43.  
  44. ON ERROR GOTO NoEGA
  45. SCREEN 9
  46. ON ERROR GOTO 0
  47.  
  48. Init
  49. Geschwindigkeit 30, 30
  50. GCurs 0, 0, VARPTR(z1(0, 0)), VARSEG(z1(0, 0))
  51. Grenzen 0, 0, 620, 349
  52. PALETTE 0, 7: PALETTE 15, 0: VIEW: CLS : CLEAR
  53. FOR k% = 20 TO 244 STEP 14   '* waagerechte Linien
  54.   LINE (20, k%)-(244, k%)
  55. NEXT k%
  56. FOR k% = 20 TO 244 STEP 14   '* senkrechte Linien
  57.   LINE (k%, 20)-(k%, 244)
  58. NEXT k%
  59. LOCATE 25, 5
  60. PRINT "Punkte setzen mit linker Maustaste, ";
  61. PRINT "Punkte löschen mit rechter Maustaste";
  62. LINE (0, 330)-(640, 330), 1, B
  63. LOCATE 19, 40: PRINT "SICHERN"
  64. LINE (305, 251)-(380, 265), 1, B
  65. LOCATE 21, 40: PRINT "NEUSTART"
  66. LINE (305, 279)-(380, 293), 1, B
  67. LOCATE 23, 42: PRINT "ENDE"
  68. LINE (305, 307)-(380, 321), 1, B
  69. LINE (325, 98)-(348, 119), 2, B  '* kleiner Cursor
  70. CursAn
  71.  
  72. DO
  73.   restart = FALSE
  74.   SetXSub
  75.   IF setx > 21 AND setx < 233 THEN
  76.     IF sety > 21 AND sety < 233 THEN
  77.       kn% = Knopf%
  78.       SELECT CASE kn%
  79.         CASE 1: SetDot setx, sety
  80.         CASE 2: RemDot setx, sety
  81.         CASE ELSE:
  82.       END SELECT
  83.     END IF
  84.   ELSEIF sety > 232 THEN
  85.     IF setx = 350 AND sety = 260 AND Knopf% = 1 THEN
  86.       IF (NOT restart) THEN DateiMachen
  87.     END IF
  88.   END IF
  89.   IF restart THEN RUN
  90. LOOP
  91.  
  92. NoEGA:
  93. PRINT "Dieses Programm benötigt eine EGA- oder VGA-Karte"
  94. END
  95.  
  96. DEFSNG A-Z
  97. SUB DateiMachen
  98. SHARED dec&, bild$, disk$
  99.   CLOSE
  100.   CursAus
  101.   LOCATE 5, 50
  102.   PRINT "Name der Definitions-"
  103.   LOCATE 6, 50
  104.   PRINT "datei: ";
  105.   INPUT "", includename
  106.   LOCATE 5, 50
  107.   PRINT "                     "
  108.   LOCATE 6, 50
  109.   PRINT "                     "
  110.   CursAn
  111.   IF LEN(includename) > 0 THEN
  112.     includename = UCASE$(includename)
  113.     IF INSTR(includename, ".") = 0 THEN
  114.       includename = includename + ".CUR"
  115.     END IF
  116.   ELSE
  117.     EXIT SUB
  118.   END IF
  119.   OPEN "R", 1, includename        '* Nachfrage, wenn Datei
  120.   IF LOF(1) > 0 THEN              '* schon existiert.
  121.     VIEW SCREEN (370, 20)-(620, 240), , 4
  122.     CursAus
  123.     LOCATE 4, 55: PRINT "ACHTUNG !"
  124.     LOCATE 6, 52: PRINT "Die Datei "; includename
  125.     LOCATE 7, 52: PRINT "existiert bereits!"
  126.     LOCATE 8, 52: PRINT "------------------------"
  127.     LOCATE 10, 52: PRINT "Wollen Sie sie wirklich"
  128.     LOCATE 11, 52: PRINT "überschreiben?"
  129.     LOCATE 14, 60: PRINT "ja"
  130.     LOCATE 16, 61: PRINT "nein"
  131.     LINE (468, 178)-(522, 200), 1, B
  132.     LINE (468, 208)-(522, 228), 1, B
  133.     CursAn
  134.     DO
  135.       IF XPos% > 467 AND XPos% < 523 THEN
  136.         IF YPos% > 178 AND YPos% < 201 AND Knopf% = 1 THEN
  137.           Schreiben
  138.         END IF
  139.         IF YPos% > 207 AND YPos% < 229 AND Knopf% = 1 THEN
  140.           CursAus
  141.           VIEW SCREEN (369, 19)-(621, 241)
  142.           CLS : VIEW: CursAn: CLOSE : EXIT SUB
  143.         END IF
  144.       END IF
  145.     LOOP
  146.   ELSE
  147.     Schreiben
  148.   END IF
  149. END SUB
  150.  
  151. SUB RemDot (setxpos AS INTEGER, setypos AS INTEGER)
  152. '* Punkt löschen:
  153.   CursAus
  154.   PAINT (setxpos, setypos), 7, 15            '* großes Bild
  155.   PRESET ((328 + (setxpos - 8) \ 14), (100 + (setypos - 8) \ 14))
  156.                                              '* kleines Bild
  157.   CursAn
  158.   tabelle((setypos - 8) / 14, (setxpos - 8) / 14) = 0
  159. END SUB
  160.  
  161. SUB Schreiben
  162. SHARED dec&, bild$, disk$
  163.   CursAus: VIEW SCREEN (300, 1)-(630, 299): CLS: CLOSE #1
  164.   LOCATE 2
  165.   OPEN "O", 1, includename
  166.   FOR k% = 1 TO 16
  167.     LOCATE , 35
  168.     dec& = 0
  169.     bild$ = ""
  170.     FOR l% = 16 TO 1 STEP -1
  171.       IF tabelle(k%, l%) = 1 THEN
  172.         dec& = dec& + 2 ^ ((l% - 16) * -1)
  173.         bild$ = CHR$(35) + bild$
  174.       ELSEIF tabelle(k%, l%) = 0 THEN
  175.         bild$ = CHR$(246) + bild$      '* 246
  176.       END IF
  177.     NEXT l%
  178.     PRINT HEX$(dec&), bild$
  179.     disk$ = "DATA &H" + HEX$(dec&)
  180.     PRINT #1, disk$, " REM "; bild$
  181.   NEXT k%
  182.   PRINT : PRINT
  183.   PRINT "Die Datei "; includename; " wurde erstellt."
  184.   PRINT "Sie enthält die Daten für den neuen "
  185.   PRINT "Maus-Cursor."
  186.   END
  187. END SUB
  188.  
  189. SUB SetDot (setxpos AS INTEGER, setypos AS INTEGER)
  190. '* Punkt setzen
  191.   CursAus
  192.   PAINT (setxpos, setypos), 8, 15               '* großes Bild
  193.   PSET ((328 + (setxpos - 8) \ 14), (100 + (setypos - 8) \ 14))
  194.   CursAn
  195.   tabelle((setypos - 8) / 14, (setxpos - 8) / 14) = 1
  196. END SUB
  197.  
  198. SUB SetXSub
  199.   SELECT CASE XPos%
  200.     CASE 21 TO 33: setx = 22
  201.     CASE 35 TO 47: setx = 36
  202.     CASE 49 TO 61: setx = 50
  203.     CASE 63 TO 75: setx = 64
  204.     CASE 77 TO 89: setx = 78
  205.     CASE 91 TO 103: setx = 92
  206.     CASE 105 TO 117: setx = 106
  207.     CASE 119 TO 131: setx = 120
  208.     CASE 133 TO 145: setx = 134
  209.     CASE 147 TO 159: setx = 148
  210.     CASE 161 TO 173: setx = 162
  211.     CASE 175 TO 187: setx = 176
  212.     CASE 189 TO 201: setx = 190
  213.     CASE 203 TO 215: setx = 204
  214.     CASE 217 TO 229: setx = 218
  215.     CASE 231 TO 243: setx = 232
  216.     CASE 305 TO 380: setx = 350: restart = FALSE
  217.     CASE ELSE: EXIT SUB
  218.   END SELECT
  219.   SetYSub
  220. END SUB
  221.  
  222. SUB SetYSub
  223.   SELECT CASE YPos%
  224.     CASE 21 TO 33: sety = 22
  225.     CASE 35 TO 47: sety = 36
  226.     CASE 49 TO 61: sety = 50
  227.     CASE 63 TO 75: sety = 64
  228.     CASE 77 TO 89: sety = 78
  229.     CASE 91 TO 103: sety = 92
  230.     CASE 105 TO 117: sety = 106
  231.     CASE 119 TO 131: sety = 120
  232.     CASE 133 TO 145: sety = 134
  233.     CASE 147 TO 159: sety = 148
  234.     CASE 161 TO 173: sety = 162
  235.     CASE 175 TO 187: sety = 176
  236.     CASE 189 TO 201: sety = 190
  237.     CASE 203 TO 215: sety = 204
  238.     CASE 217 TO 229: sety = 218
  239.     CASE 231 TO 243: sety = 232
  240.     CASE 279 TO 293: IF setx = 350 AND Knopf% = 1 THEN restart = TRUE
  241.     CASE 307 TO 321:
  242.       IF setx = 350 AND Knopf% = 1 THEN
  243.         END
  244.       END IF
  245.     CASE 251 TO 265: sety = 260
  246.     CASE ELSE:
  247.   END SELECT
  248. END SUB
  249.  
  250.