home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / IMB9004.ZIP / CALMOUSE.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-04-01  |  3.2 KB  |  160 lines
  1. DECLARE FUNCTION IsMono% ()
  2. DECLARE FUNCTION Rand% (MaxValue%)
  3. DECLARE SUB DspButtons (Buttons%, PX%, PY%)
  4. DECLARE SUB Normal ()
  5. DECLARE SUB PrintMsg (PosX%, PosY%, PrintTxt$)
  6. DECLARE SUB Reverse ()
  7. DECLARE SUB SetUpGrid ()
  8.  
  9. 'Program:   Call Mouse Demo Program
  10. '           CALMOUSE.BAS
  11.  
  12. DEFINT A-Z
  13.  
  14. '$INCLUDE: 'QB.BI'
  15. '$INCLUDE: 'MOUSE.BI'
  16.  
  17. DIM SHARED SWidth, VideoAddr
  18. DIM SHARED PrL, PrR, PrLr, PrM
  19. DIM SHARED PrLM, PrMR, PrAll, PrNone
  20. DIM SHARED ForeGround, BackGround, HiLight
  21. DIM SHARED ButtonLeft, ButtonRight, ButtonMiddle
  22.  
  23. True = -1: False = 0: SWidth = 80
  24.  
  25. 'Mouse button press definitions
  26.  
  27.     PrL = 1: PrR = 2: PrLr = 3: PrM = 4
  28.     PrLM = 5: PrMR = 6: PrAll = 7: PrNone = 0
  29.  
  30. 'Button definitions
  31.   
  32.     ButtonLeft = 0
  33.     ButtonRight = 1
  34.     ButtonMiddle = 2
  35.  
  36.     IF IsMono THEN
  37.         ForeGround = 7: BackGround = 0
  38.     ELSE
  39.         ForeGround = 3: BackGround = 0
  40.     END IF
  41.  
  42.     SCREEN 0: CLS : SetUpGrid
  43.  
  44.     IF ThereIsAMouse THEN
  45.         PrintMsg 24, 1, "Mouse Installed"
  46.         SLEEP (1)
  47.         IF NOT MouseReset THEN
  48.             PrintMsg 24, 1, "No mouse reset"
  49.             END
  50.         ELSE
  51.             PrintMsg 24, 1, "Mouse Reset"
  52.         END IF
  53.     ELSE
  54.         PrintMsg 24, 1,_
  55.            "Sorry, there's no mouse on this system"
  56.         END
  57.     END IF
  58.   
  59.     LOCATE 25, 1: Reverse: PRINT SPACE$(80);
  60.     LOCATE 25, 1
  61.     PRINT "(Press Left Button to change mouse,";
  62.     PRINT " Right Button to Quit)";
  63.     MouseOn
  64.     ClearButton ButtonLeft
  65.   
  66.     DO WHILE Buttons <> PrR
  67.         Buttons = GetMouseStatus(MPosX, MPosY)
  68.         DspButtons Buttons, MPosX, MPosY
  69.         IF Buttons = PrL THEN
  70.             MouseCharacter = Rand(255)
  71.             IF IsMono THEN
  72.                 SetMouseSoftCursor MouseCharacter,7,0
  73.             ELSE
  74.                 FGColor = Rand(7)
  75.                 BGColor = Rand(7)
  76.                 SetMouseSoftCursor_
  77.                    MouseCharacter, FGColor, BGColor
  78.             END IF
  79.             MouseOn
  80.             PrintMsg 2, 40, "MouseCharacter: "_
  81.                + STR$(MouseCharacter)
  82.             PrintMsg 3, 40, "MouseFGColor: "_
  83.                + STR$(FGColor)
  84.             PrintMsg 4, 40, "MouseBGColor: "_
  85.                + STR$(BGColor)
  86.             ClearButton ButtonLeft
  87.         END IF
  88.     LOOP
  89.  
  90.     MouseOff
  91.     END
  92.  
  93. SUB DspButtons (Buttons, PX, PY)
  94.     Reverse
  95.     LOCATE 24, 42: PRINT "Buttons: ";
  96.     SELECT CASE Buttons
  97.         CASE PrNone
  98.             PRINT "None          ";
  99.         CASE PrL
  100.             PRINT "Left          ";
  101.         CASE PrR
  102.             PRINT "Right         ";
  103.         CASE PrLr
  104.             PRINT "Left & right  ";
  105.         CASE PrM
  106.             PRINT "Middle        ";
  107.         CASE PrLM
  108.             PRINT "Left & middle ";
  109.         CASE PrMR
  110.             PRINT "Middle & right";
  111.         CASE PrAll
  112.             PRINT "All           ";
  113.         CASE ELSE
  114.             PRINT "Unknown " + STR$(Buttons);
  115.     END SELECT
  116.     LOCATE 24, 66: PRINT USING "XPos=## "; PX;
  117.     LOCATE 24, 74: PRINT USING "YPos=##"; PY;
  118.     Normal
  119. END SUB
  120.  
  121. FUNCTION IsMono
  122.     DIM InRegs AS RegType
  123.     InRegs.AX = &HF00
  124.     INTERRUPT &H10, InRegs, OutRegs
  125.     IsMono = (OutRegs.AX MOD 256 = 7)
  126. END FUNCTION
  127.  
  128. SUB Normal
  129.     COLOR ForeGround, BackGround
  130. END SUB
  131.  
  132. SUB PrintMsg (PosX, PosY, PrintTxt$)
  133.     LOCATE PosX, PosY: Reverse
  134.     PRINT LEFT$(PrintTxt$ + STRING$(40, " "), 40);
  135.     Normal
  136. END SUB
  137.  
  138. FUNCTION Rand (MaxValue)
  139.     Rand = INT((MaxValue + 1) * RND)
  140. END FUNCTION
  141.  
  142. SUB Reverse
  143.     COLOR BackGround, ForeGround
  144. END SUB
  145.  
  146. SUB SetUpGrid
  147.     LOCATE 1, 1
  148.     FOR I = 1 TO 80
  149.         PRINT RIGHT$(STR$(I), 1);
  150.     NEXT I
  151.     LOCATE 2, 1
  152.     FOR I = 2 TO 25
  153.         LOCATE I, 1
  154.         PRINT USING "##"; I;
  155.     NEXT I
  156.     Reverse
  157.     LOCATE 24, 1: PRINT SPACE$(80);
  158.     Normal
  159. END SUB
  160.