home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l180 / 2.ddi / MOUSTCRS.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-02-07  |  6.8 KB  |  244 lines
  1.   ' ************************************************
  2.   ' **  Name:          MOUSTCRS                   **
  3.   ' **  Type:          Program                    **
  4.   ' **  Module:        MOUSTCRS.BAS               **
  5.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  6.   ' ************************************************
  7.   '
  8.   ' USAGE:           No command line parameters
  9.   ' REQUIREMENTS:    MIXED.QLB/.LIB
  10.   '                  Mouse
  11.   ' .MAK FILE:       MOUSTCRS.BAS
  12.   '                  MOUSSUBS.BAS
  13.   '                  BITS.BAS
  14.   '                  ATTRIB.BAS
  15.   ' PARAMETERS:      (none)
  16.   ' VARIABLES:       screenMask%   Integer bit mask for screen mask
  17.   '                  cursorMask%   Integer bit mask for cursor mask
  18.   '                  leftCount%    Count of left mouse button presses
  19.   '                  xm%           Mouse X position at last left button press
  20.   '                  ym%           Mouse Y position at last left button press
  21.   '                  row%          Code for which screen bit row was selected
  22.   '                  bit%          Bit pattern determined by screen column
  23.   '                                click on
  24.   '                  screenMask$   String of 0s and 1s for bit pattern display
  25.   '                  cursorMask$   String of 0s and 1s for bit pattern display
  26.   '                  i%            Looping index
  27.   '                  Shex$         Hexadecimal representation of the screen mask
  28.   '                  Chex$         Hexadecimal representation of the cursor mask
  29.   
  30.   ' Define constants
  31.     CONST FALSE = 0
  32.     CONST TRUE = NOT FALSE
  33.   
  34.   ' Functions
  35.     DECLARE FUNCTION Bin2BinStr$ (b%)
  36.   
  37.   ' Subprograms
  38.     DECLARE SUB Attrib ()
  39.     DECLARE SUB MouseHide ()
  40.     DECLARE SUB MouseInstall (mouseFlag%)
  41.     DECLARE SUB MousePressLeft (leftCount%, xMouse%, yMouse%)
  42.     DECLARE SUB MouseShow ()
  43.     DECLARE SUB MouseSoftCursor (screenMask%, cursorMask%)
  44.   
  45.   ' Is the mouse out there?
  46.     MouseInstall mouseFlag%
  47.     IF mouseFlag% = 0 THEN
  48.         PRINT "Mouse does not appear to be installed.  Check"
  49.         PRINT "your mouse documentation for proper installation."
  50.         PRINT
  51.         SYSTEM
  52.     END IF
  53.   
  54.   ' Put all attributes on the screen
  55.     Attrib
  56.   
  57.   ' Set masks to initial state
  58.     screenMask% = &H77FF
  59.     cursorMask% = &H7700
  60.   
  61.   ' Create the outlined boxes
  62.     COLOR 14, 0
  63.     PRINT "                  +---+-------+---+--------+----------+--------+"
  64.     PRINT "                  | b | bckgd | i | foregd |   char   |   =    |"
  65.     PRINT "    +-------------+---+-------+---+--------+----------+--------+"
  66.     PRINT "    | screen mask | 0 |  111  | 0 |  111   | 11111111 | &H77FF |"
  67.     PRINT "    | cursor mask | 0 |  111  | 0 |  111   | 00000000 | &H7700 |"
  68.     PRINT "    +-------------+---+-------+---+--------+----------+--------+"
  69.   
  70.   ' Print the instructions
  71.     COLOR 11, 0
  72.     PRINT "Click the mouse on any of the mask bits shown.  Then, try the"
  73.     PRINT "new cursor by moving across the attribute fields above.";
  74.   
  75.   ' Special indication for quitting
  76.     COLOR 15, 0
  77.     LOCATE 17, 1, 0
  78.     PRINT "Click here";
  79.     LOCATE 18, 1, 0
  80.     PRINT "to Quit - ";
  81.     COLOR 10, 0
  82.     PRINT "X";
  83.   
  84.   ' Put mask bits into boxes on screen
  85.     GOSUB PrintScreenMask
  86.     GOSUB PrintCursorMask
  87.   
  88.   ' Activate the mouse
  89.     MouseShow
  90.   
  91.   ' Do the main processing loop until the quit flag is set
  92.     DO
  93.         GOSUB MainLoop
  94.     LOOP UNTIL quitFlag%
  95.   
  96.   ' All done
  97.     MouseHide
  98.     CLS
  99.     SYSTEM
  100.   
  101.   
  102.   ' Main processing loop
  103. MainLoop:
  104.   
  105.   ' Where was mouse when left button was last pressed?
  106.     MousePressLeft leftCount%, xm%, ym%
  107.   
  108.   ' Was it on one of the two important rows of the screen?
  109.     SELECT CASE ym%
  110.     CASE 152
  111.         row% = 1
  112.     CASE 160
  113.         row% = 2
  114.     CASE ELSE
  115.         row% = 0
  116.     END SELECT
  117.   
  118.   ' Was it on an important column?
  119.     SELECT CASE xm%
  120.     CASE 80
  121.         IF ym% = 136 THEN
  122.             quitFlag% = TRUE
  123.         END IF
  124.     CASE 160
  125.         bit% = &H8000
  126.     CASE 200
  127.         bit% = &H4000
  128.     CASE 208
  129.         bit% = &H2000
  130.     CASE 216
  131.         bit% = &H1000
  132.     CASE 256
  133.         bit% = &H800
  134.     CASE 296
  135.         bit% = &H400
  136.     CASE 304
  137.         bit% = &H200
  138.     CASE 312
  139.         bit% = &H100
  140.     CASE 360
  141.         bit% = &H80
  142.     CASE 368
  143.         bit% = &H40
  144.     CASE 376
  145.         bit% = &H20
  146.     CASE 384
  147.         bit% = &H10
  148.     CASE 392
  149.         bit% = &H8
  150.     CASE 400
  151.         bit% = &H4
  152.     CASE 408
  153.         bit% = &H2
  154.     CASE 416
  155.         bit% = &H1
  156.     CASE ELSE
  157.         bit% = 0
  158.     END SELECT
  159.   
  160.   ' Modify the masks and update the cursor
  161.     IF leftCount% THEN
  162.         SELECT CASE row%
  163.         CASE 1
  164.             screenMask% = screenMask% XOR bit%
  165.         CASE 2
  166.             cursorMask% = cursorMask% XOR bit%
  167.         CASE ELSE
  168.         END SELECT
  169.         MouseSoftCursor screenMask%, cursorMask%
  170.         GOSUB PrintScreenMask
  171.         GOSUB PrintCursorMask
  172.     END IF
  173.   
  174.   ' End of main processing loop
  175.     RETURN
  176.   
  177.   ' Put screen mask bits on the screen
  178. PrintScreenMask:
  179.     COLOR 12, 0
  180.     screenMask$ = ""
  181.     screenMask$ = Bin2BinStr$(screenMask%)
  182.     MouseHide
  183.     FOR i% = 0 TO 15
  184.         SELECT CASE i%
  185.         CASE 0 TO 7
  186.             LOCATE 20, 53 - i%, 0
  187.             PRINT MID$(screenMask$, 16 - i%, 1);
  188.         CASE 8 TO 10
  189.             LOCATE 20, 48 - i%, 0
  190.             PRINT MID$(screenMask$, 16 - i%, 1);
  191.         CASE 11
  192.             LOCATE 20, 44 - i%, 0
  193.             PRINT MID$(screenMask$, 16 - i%, 1);
  194.         CASE 12 TO 14
  195.             LOCATE 20, 40 - i%, 0
  196.             PRINT MID$(screenMask$, 16 - i%, 1);
  197.         CASE 15
  198.             LOCATE 20, 36 - i%, 0
  199.             PRINT MID$(screenMask$, 16 - i%, 1);
  200.         CASE ELSE
  201.         END SELECT
  202.     NEXT i%
  203.     shex$ = "&H" + RIGHT$("000" + HEX$(screenMask%), 4)
  204.     LOCATE 20, 57, 0
  205.     COLOR 10, 0
  206.     PRINT shex$;
  207.     MouseShow
  208.     RETURN
  209.   
  210.   ' Put cursor mask bits on the screen
  211. PrintCursorMask:
  212.     COLOR 12, 0
  213.     cursorMask$ = ""
  214.     cursorMask$ = Bin2BinStr$(cursorMask%)
  215.     MouseHide
  216.     FOR i% = 0 TO 15
  217.         SELECT CASE i%
  218.         CASE 0 TO 7
  219.             LOCATE 21, 53 - i%, 0
  220.             PRINT MID$(cursorMask$, 16 - i%, 1);
  221.         CASE 8 TO 10
  222.             LOCATE 21, 48 - i%, 0
  223.             PRINT MID$(cursorMask$, 16 - i%, 1);
  224.         CASE 11
  225.             LOCATE 21, 44 - i%, 0
  226.             PRINT MID$(cursorMask$, 16 - i%, 1);
  227.         CASE 12 TO 14
  228.             LOCATE 21, 40 - i%, 0
  229.             PRINT MID$(cursorMask$, 16 - i%, 1);
  230.         CASE 15
  231.             LOCATE 21, 36 - i%, 0
  232.             PRINT MID$(cursorMask$, 16 - i%, 1);
  233.         CASE ELSE
  234.         END SELECT
  235.     NEXT i%
  236.     chex$ = "&H" + RIGHT$("000" + HEX$(cursorMask%), 4)
  237.     LOCATE 21, 57, 0
  238.     COLOR 10, 0
  239.     PRINT chex$;
  240.     MouseShow
  241.     RETURN
  242.   
  243.  
  244.