home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / heimw_p / machcurs.bas < prev    next >
Encoding:
BASIC Source File  |  1990-11-22  |  7.9 KB  |  327 lines
  1.  
  2. '*--------------------------------------------------------*
  3. '*                    MachCurs.Bas                        *
  4. '*          (c) 1991 E. Schütte & toolbox                 *
  5. '*                 für PowerBasic 2.0                     *
  6. '*--------------------------------------------------------*
  7. $LIB COM -
  8. $LIB IPRINT -
  9. $LIB HERC -
  10. $ERROR ALL -
  11. $EVENT -
  12. $OPTION AUTODIM -
  13. $OPTION CNTLBREAK -
  14. $FLOAT EMULATE
  15.  
  16. %FALSE = 0
  17. %TRUE = -1
  18.  
  19. %FLAGS = 0
  20. %AX    = 1
  21. %BX    = 2
  22. %CX    = 3
  23. %DX    = 4
  24. %SI    = 5
  25. %DI    = 6
  26. %BP    = 7
  27. %DS    = 8
  28. %ES    = 9
  29.  
  30. DIM z1%(15, 1), tabelle%(16, 16)
  31.  
  32. $INCLUDE"CURSOR.CUR"
  33.  
  34. RESTORE
  35. FOR i% = 0 TO 15
  36.   READ dummy$
  37.   z1%(i%, 1) = VAL(dummy$)
  38.   z1%(i%, 0) = NOT z1%(i%, 1)
  39. NEXT i%
  40.  
  41. ON ERROR GOTO NoEGA
  42. SCREEN 9
  43. ON ERROR GOTO 0
  44.  
  45. CALL Init
  46. CALL Geschwindigkeit (30, 30)
  47. CALL GCurs (0, 0, VARPTR(z1%(0, 0)), VARSEG(z1%(0, 0)))
  48. CALL Grenzen (0, 0, 620, 349)
  49. PALETTE 0, 7: PALETTE 15, 0: VIEW: CLS : CLEAR
  50. FOR k% = 20 TO 244 STEP 14      '* waagerechte Linien
  51.   LINE (20, k%)-(244, k%), 15
  52. NEXT k%
  53. FOR k% = 20 TO 244 STEP 14   '* senkrechte Linien
  54.   LINE (k%, 20)-(k%, 244), 15
  55. NEXT k%
  56. LOCATE 25, 5
  57. COLOR 15
  58. PRINT "Punkte setzen mit linker Maustaste, ";
  59. PRINT "Punkte löschen mit rechter Maustaste";
  60. LINE (0, 330)-(640, 330), 1, B
  61. LOCATE 19, 40: PRINT "SICHERN"
  62. LINE (305, 251)-(380, 265), 1, B
  63. LOCATE 21, 40: PRINT "NEUSTART"
  64. LINE (305, 279)-(380, 293), 1, B
  65. LOCATE 23, 42: PRINT "ENDE"
  66. LINE (305, 307)-(380, 321), 1, B
  67. LINE (325, 98)-(348, 119), 2, B  '* kleiner Cursor
  68. CALL CursAn
  69.  
  70. DO
  71.   restart% = %FALSE
  72.   CALL SetXSub
  73.   IF setx% > 21 AND setx% < 233 THEN
  74.     IF sety% > 21 AND sety% < 233 THEN
  75.       kn% = Knopf%
  76.       SELECT CASE kn%
  77.     CASE 1: CALL SetDot (setx%, sety%)
  78.     CASE 2: CALL RemDot (setx%, sety%)
  79.       END SELECT
  80.     END IF
  81.   ELSEIF sety% > 232 THEN
  82.     IF setx% = 350 AND sety% = 260 AND Knopf% = 1 THEN
  83.       IF (NOT restart%) THEN CALL DateiMachen
  84.     END IF
  85.   END IF
  86.   IF restart% THEN RUN
  87. LOOP
  88.  
  89. NoEGA:
  90. PRINT "Dieses Programm benötigt eine EGA- oder VGA-Karte"
  91. END
  92.  
  93. SUB DateiMachen
  94. SHARED dec&, bild$, disk$, XPos%, YPos%, includename$
  95.   CLOSE
  96.   CALL CursAus
  97.   LOCATE 5, 50: PRINT "Name der Definitions-"
  98.   LOCATE 6, 50: PRINT "datei: ";
  99.   INPUT "", includename$
  100.   LOCATE 5, 50: PRINT SPACE$(21);
  101.   LOCATE 6, 50: PRINT SPACE$(21);
  102.   CALL CursAn
  103.   IF includename$ <> "" THEN
  104.     includename$ = UCASE$(includename$)
  105.     IF INSTR(includename$, ".") = 0 THEN
  106.       includename$ = includename$ + ".CUR"
  107.     END IF
  108.   ELSE
  109.     EXIT SUB
  110.   END IF
  111.   OPEN "R", 1, includename$       '* Nachfrage, wenn Datei
  112.   IF LOF(1) > 0 THEN              '* schon existiert.
  113.     VIEW SCREEN (370, 20)-(620, 240), , 4
  114.     CALL CursAus
  115.     LOCATE 4, 55: PRINT "ACHTUNG !"
  116.     LOCATE 6, 52: PRINT "Die Datei "; includename$
  117.     LOCATE 7, 52: PRINT "existiert bereits!"
  118.     LOCATE 8, 52: PRINT "------------------------"
  119.     LOCATE 10, 52: PRINT "Wollen Sie sie wirklich"
  120.     LOCATE 11, 52: PRINT "überschreiben?"
  121.     LOCATE 14, 60: PRINT "ja"
  122.     LOCATE 16, 61: PRINT "nein"
  123.     LINE (468, 178)-(522, 200), 1, B
  124.     LINE (468, 208)-(522, 228), 1, B
  125.     CALL CursAn
  126.     DO
  127.       IF XPos% > 467 AND XPos% < 523 THEN
  128.         IF YPos% > 178 AND YPos% < 201 AND Knopf% = 1 THEN
  129.       CALL Schreiben
  130.         END IF
  131.         IF YPos% > 207 AND YPos% < 229 AND Knopf% = 1 THEN
  132.       CALL CursAus
  133.           VIEW SCREEN (369, 19)-(621, 241)
  134.       CLS : VIEW: CALL CursAn: CLOSE : EXIT SUB
  135.         END IF
  136.       END IF
  137.     LOOP
  138.   ELSE
  139.     CALL Schreiben
  140.   END IF
  141. END SUB
  142.  
  143. SUB RemDot (setxpos%, setypos%)
  144. SHARED tabelle%()
  145. '* Punkt löschen:
  146.   CALL CursAus
  147.   PAINT (setxpos%, setypos%), 7, 15            '* großes Bild
  148.   PRESET ((328 + (setxpos% - 8) \ 14), _
  149.           (100 + (setypos% - 8) \ 14))
  150.                                              '* kleines Bild
  151.   CALL CursAn
  152.   tabelle%((setypos% - 8) / 14, (setxpos% - 8) / 14) = 0
  153. END SUB
  154.  
  155. SUB Schreiben
  156. SHARED dec&, bild$, disk$, includename$, tabelle%()
  157.   CALL CursAus
  158.   VIEW SCREEN (300, 1)-(630, 299)
  159.   CLS
  160.   LOCATE 2
  161.   CLOSE #1
  162.   OPEN "O", 1, includename$
  163.   FOR k% = 1 TO 16
  164.     LOCATE , 35
  165.     dec& = 0
  166.     bild$ = ""
  167.     FOR l% = 16 TO 1 STEP -1
  168.       IF tabelle%(k%, l%) = 1 THEN
  169.         dec& = dec& + 2 ^ ((l% - 16) * -1)
  170.         bild$ = CHR$(35) + bild$
  171.       ELSEIF tabelle%(k%, l%) = 0 THEN
  172.         bild$ = CHR$(246) + bild$      '* 246
  173.       END IF
  174.     NEXT l%
  175.     PRINT HEX$(dec&), bild$
  176.     disk$ = "DATA &H" + HEX$(dec&)
  177.     PRINT #1, disk$, " REM "; bild$
  178.   NEXT k%
  179.   PRINT : PRINT
  180.   PRINT "Die Datei "; includename$; " wurde erstellt."
  181.   PRINT "Sie enthält die Daten für den neuen "
  182.   PRINT "Maus-Cursor."
  183.   DELAY 3
  184.   SCREEN 0, 0, 0
  185.   END
  186. END SUB
  187.  
  188. SUB SetDot (setxpos%, setypos%)
  189. SHARED tabelle%()
  190. '* Punkt setzen
  191.   CALL CursAus
  192.   PAINT (setxpos%, setypos%), 8, 15             '* großes Bild
  193.   PSET ((328 + (setxpos% - 8) \ 14), _
  194.         (100 + (setypos% - 8) \ 14)),15
  195.   CALL CursAn
  196.   tabelle%((setypos% - 8) \ 14, (setxpos% - 8) \ 14) = 1
  197. END SUB
  198.  
  199. SUB SetXSub
  200. SHARED setx%, restart%
  201.   SELECT CASE XPos%
  202.     CASE 21 TO 33: setx% = 22
  203.     CASE 35 TO 47: setx% = 36
  204.     CASE 49 TO 61: setx% = 50
  205.     CASE 63 TO 75: setx% = 64
  206.     CASE 77 TO 89: setx% = 78
  207.     CASE 91 TO 103: setx% = 92
  208.     CASE 105 TO 117: setx% = 106
  209.     CASE 119 TO 131: setx% = 120
  210.     CASE 133 TO 145: setx% = 134
  211.     CASE 147 TO 159: setx% = 148
  212.     CASE 161 TO 173: setx% = 162
  213.     CASE 175 TO 187: setx% = 176
  214.     CASE 189 TO 201: setx% = 190
  215.     CASE 203 TO 215: setx% = 204
  216.     CASE 217 TO 229: setx% = 218
  217.     CASE 231 TO 243: setx% = 232
  218.     CASE 305 TO 380: setx% = 350: restart% = %FALSE
  219.     CASE ELSE: EXIT SUB
  220.   END SELECT
  221.   CALL SetYSub
  222. END SUB
  223.  
  224. SUB SetYSub
  225. SHARED setx%, sety%, restart%
  226.   SELECT CASE YPos%
  227.     CASE 21 TO 33: sety% = 22
  228.     CASE 35 TO 47: sety% = 36
  229.     CASE 49 TO 61: sety% = 50
  230.     CASE 63 TO 75: sety% = 64
  231.     CASE 77 TO 89: sety% = 78
  232.     CASE 91 TO 103: sety% = 92
  233.     CASE 105 TO 117: sety% = 106
  234.     CASE 119 TO 131: sety% = 120
  235.     CASE 133 TO 145: sety% = 134
  236.     CASE 147 TO 159: sety% = 148
  237.     CASE 161 TO 173: sety% = 162
  238.     CASE 175 TO 187: sety% = 176
  239.     CASE 189 TO 201: sety% = 190
  240.     CASE 203 TO 215: sety% = 204
  241.     CASE 217 TO 229: sety% = 218
  242.     CASE 231 TO 243: sety% = 232
  243.     CASE 279 TO 293: IF setx% = 350 AND Knopf% = 1 THEN restart% = %TRUE
  244.     CASE 307 TO 321:
  245.       IF setx% = 350 AND Knopf% = 1 THEN
  246.     SCREEN 0, 0, 0
  247.         END
  248.       END IF
  249.     CASE 251 TO 265: sety% = 260
  250.   END SELECT
  251. END SUB
  252.  
  253. '===========================================================
  254. '              Mausprozeduren und -funktionen
  255.  
  256. '* Mauscursor aktivieren
  257. SUB CursAn
  258.   Reg %AX,1
  259.   CALL Interrupt &H33
  260. END SUB
  261.  
  262. '* Mauscursor abschalten
  263. SUB CursAus
  264.   Reg %AX, 2
  265.   CALL Interrupt &H33
  266. END SUB
  267.  
  268. '* Grafikcursor definieren
  269. SUB GCurs (horiz%, vertik%, offset&, segm&)
  270.   Reg %AX, 9
  271.   Reg %BX, horiz%
  272.   Reg %CX, vertik%
  273.   Reg %DX, offset&
  274.   Reg %ES, segm&
  275.   CALL Interrupt &H33
  276. END SUB
  277.  
  278. '* Mickey-Einheit definieren
  279. SUB Geschwindigkeit (horiz%, vertik%)
  280.   Reg %AX, 15
  281.   Reg %CX, horiz%
  282.   Reg %DX, vertik%
  283.   CALL Interrupt &H33
  284. END SUB
  285.  
  286. '* Fenster für Mauscursor definieren
  287. SUB Grenzen (links%, oben%, rechts%, unten%)
  288.   Reg %AX, 7
  289.   Reg %CX, links%
  290.   Reg %DX, rechts%
  291.   CALL Interrupt 51
  292.   Reg %AX, 8
  293.   Reg %CX, oben%
  294.   Reg %DX, unten%
  295.   CALL Interrupt &H33
  296. END SUB
  297.  
  298. '* Maustreiber initialisieren
  299. SUB Init
  300.   Reg %AX, 0
  301.   CALL Interrupt &H33
  302. END SUB
  303.  
  304. '* Maustastenstatus lesen
  305. FUNCTION Knopf%
  306.   Reg %AX, 3
  307.   CALL Interrupt &H33
  308.   Knopf% = Reg(%BX)
  309. END FUNCTION
  310.  
  311. '* horizontale Cursorposition ermitteln
  312. FUNCTION XPos%
  313.   Reg %AX, 3
  314.   CALL Interrupt &H33
  315.   XPos% = Reg(%CX)
  316. END FUNCTION
  317.  
  318. '* vertikale Cursorposition ermitteln
  319. FUNCTION YPos%
  320.   Reg %AX, 3
  321.   CALL Interrupt &H33
  322.   YPos% = Reg(%DX)
  323. END FUNCTION
  324.  
  325. '*--------------------------------------------------------*
  326. '*                Ende von Machcurs.Bas                   *
  327.