home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l180 / 1.ddi / CDEMO2.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-02-07  |  7.1 KB  |  214 lines
  1.   ' ************************************************
  2.   ' **  Name:          CDEMO2                     **
  3.   ' **  Type:          Program                    **
  4.   ' **  Module:        CDEMO2.BAS                 **
  5.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  6.   ' ************************************************
  7.   '
  8.   ' USAGE:           No command line parameters
  9.   ' REQUIREMENTS:    CGA
  10.   '                  MIXED.QLB/.LIB
  11.   ' .MAK FILE:       (none)
  12.   ' PARAMETERS:      (none)
  13.   ' VARIABLES:       m$            Menu string
  14.   '                  word%         Integer to be packed with two bytes
  15.   '                  hi%           Most significant byte unpacked from an
  16.   '                                integer
  17.   '                  lo%           Least significant byte unpacked from an
  18.   '                                integer
  19.   '                  a$            Workspace for TextGet and TextPut
  20.   '                  b$            Workspace for TextGet and TextPut
  21.   '                  n%            Timing constant for TextPut demonstration
  22.   '                  row%          Row location to put small "window" using
  23.   '                                TextPut
  24.   '                  col%          Column location to put small "window" using
  25.   '                                TextPut
  26.   '                  t0            Timer variable
  27.   '                  x$            String variable for bit shifting
  28.   '                  i%            Looping index
  29.   
  30.   
  31.   ' Functions
  32.     DECLARE FUNCTION MenuString% CDECL (row%, col%, a$)
  33.     DECLARE FUNCTION BitShiftleft% CDECL (a$)
  34.     DECLARE FUNCTION BitShiftRight% CDECL (a$)
  35.     DECLARE FUNCTION NumberOfBits& CDECL (a$)
  36.   
  37.   ' Subprograms
  38.     DECLARE SUB PackWord CDECL (word%, hi%, lo%)
  39.     DECLARE SUB UnPackWord CDECL (word%, hi%, lo%)
  40.     DECLARE SUB TextGet CDECL (r1%, c1%, r2%, c2%, a$)
  41.     DECLARE SUB TextPut CDECL (r1%, c1%, r2%, c2%, a$)
  42.   
  43.   ' Build menu string
  44.     m$ = "Packword Unpackword Textget Textput "
  45.     m$ = m$ + "Bitshiftleft Bitshiftright Numberofbits Quit"
  46.   
  47.   ' Let user repeatedly select the demonstrations
  48.     DO
  49.         COLOR 15, 1
  50.         CLS
  51.         PRINT
  52.         PRINT
  53.         PRINT "MenuString function..."
  54.         PRINT
  55.         PRINT "Select one of the CTOOLS2 demonstrations by ";
  56.         PRINT "pressing the Left arrow,"
  57.         PRINT "Right arrow, first letter of the choice, or Enter keys."
  58.       
  59.       ' Use MenuString to choose demonstrations
  60.         SELECT CASE MenuString%(1, 1, m$)
  61.           
  62.       ' PackWord demonstration
  63.         CASE 1
  64.           
  65.             CLS
  66.             PRINT "PackWord word%, 255, 255  ...  word% = ";
  67.             PackWord word%, 255, 255
  68.             PRINT word%
  69.             PRINT "PackWord word%,   0,   1  ...  word% = ";
  70.             PackWord word%, 0, 1
  71.             PRINT word%
  72.             PRINT "PackWord word%,   1,   0  ...  word% = ";
  73.             PackWord word%, 1, 0
  74.             PRINT word%
  75.           
  76.             PRINT
  77.             PRINT "Press any key to continue..."
  78.           
  79.             DO
  80.             LOOP UNTIL INKEY$ <> ""
  81.           
  82.       ' UnPackWord demonstration
  83.         CASE 2
  84.           
  85.             CLS
  86.             PRINT "UnPackWord  -1, hi%, lo%  ...  hi%, lo% =";
  87.             UnPackWord -1, hi%, lo%
  88.             PRINT hi%; lo%
  89.             PRINT "UnPackWord   1, hi%, lo%  ...  hi%, lo% =";
  90.             UnPackWord 1, hi%, lo%
  91.             PRINT hi%; lo%
  92.             PRINT "UnPackWord 256, hi%, lo%  ...  hi%, lo% =";
  93.             UnPackWord 256, hi%, lo%
  94.             PRINT hi%; lo%
  95.           
  96.             PRINT
  97.             PRINT "Press any key to continue..."
  98.           
  99.             DO
  100.             LOOP UNTIL INKEY$ <> ""
  101.           
  102.       ' TextGet and TextPut demonstration
  103.         CASE 3, 4
  104.           
  105.           ' TextGet a line of text
  106.             CLS
  107.             PRINT "A Vertical Message"
  108.             a$ = SPACE$(36)
  109.             TextGet 1, 1, 1, 18, a$
  110.           
  111.           ' TextPut it back, but stretch it vertically
  112.             TextPut 6, 1, 23, 1, a$
  113.           
  114.           ' Now just a normal line of text at top
  115.             LOCATE 1, 1
  116.             PRINT "TextGet and TextPut - Press any key to stop"
  117.           
  118.           ' Create first of two colorful text patterns
  119.             COLOR 14, 4
  120.             LOCATE 13, 13, 0
  121.             PRINT CHR$(201); CHR$(205); CHR$(209); CHR$(205); CHR$(187)
  122.             LOCATE 14, 13, 0
  123.             PRINT CHR$(199); CHR$(196); CHR$(197); CHR$(196); CHR$(182)
  124.             LOCATE 15, 13, 0
  125.             PRINT CHR$(200); CHR$(205); CHR$(207); CHR$(205); CHR$(188)
  126.             a$ = SPACE$(30)
  127.             TextGet 13, 13, 15, 17, a$
  128.           
  129.           ' Create second of two colorful text patterns
  130.             COLOR 10, 1
  131.             LOCATE 13, 13, 0
  132.             PRINT CHR$(218); CHR$(196); CHR$(210); CHR$(196); CHR$(191)
  133.             LOCATE 14, 13, 0
  134.             PRINT CHR$(198); CHR$(205); CHR$(206); CHR$(205); CHR$(181)
  135.             LOCATE 15, 13, 0
  136.             PRINT CHR$(192); CHR$(196); CHR$(208); CHR$(196); CHR$(217)
  137.             b$ = SPACE$(30)
  138.             TextGet 13, 13, 15, 17, b$
  139.           
  140.           ' Randomly pop up little "windows"
  141.             n% = 0
  142.             DO
  143.                 row% = INT(RND * 21 + 3)
  144.                 col% = INT(RND * 73 + 4)
  145.                 TextPut row%, col%, row% + 2, col% + 4, a$
  146.                 row% = INT(RND * 21 + 3)
  147.                 col% = INT(RND * 73 + 4)
  148.                 TextPut row%, col%, row% + 2, col% + 4, b$
  149.                 IF n% < 10 THEN
  150.                     n% = n% + 1
  151.                     t0 = TIMER
  152.                     DO
  153.                     LOOP UNTIL TIMER > t0 + (10 - n%) / 10
  154.                 END IF
  155.             LOOP UNTIL INKEY$ <> ""
  156.           
  157.       ' BitShiftLeft demonstration
  158.         CASE 5
  159.           
  160.             CLS
  161.             x$ = "This string will be shifted left 8 bits"
  162.             PRINT x$
  163.             FOR i% = 1 TO 8
  164.                 PRINT "bit ="; BitShiftleft%(x$)
  165.             NEXT i%
  166.             PRINT x$
  167.           
  168.             PRINT
  169.             PRINT "Press any key to continue..."
  170.           
  171.             DO
  172.             LOOP UNTIL INKEY$ <> ""
  173.           
  174.       ' BitShiftRight demonstration
  175.         CASE 6
  176.           
  177.             CLS
  178.             x$ = "This string will be shifted right 8 bits"
  179.             PRINT x$
  180.             FOR i% = 1 TO 8
  181.                 PRINT "bit ="; BitShiftRight%(x$)
  182.             NEXT i%
  183.             PRINT x$
  184.           
  185.             PRINT
  186.             PRINT "Press any key to continue..."
  187.           
  188.             DO
  189.             LOOP UNTIL INKEY$ <> ""
  190.           
  191.       ' BitShiftRight demonstration
  192.         CASE 7
  193.           
  194.             CLS
  195.             x$ = "The number of bits in this string is ..."
  196.             PRINT x$
  197.             PRINT NumberOfBits&(x$)
  198.           
  199.             PRINT
  200.             PRINT "Press any key to continue..."
  201.           
  202.             DO
  203.             LOOP UNTIL INKEY$ <> ""
  204.           
  205.       ' Must be time to quit
  206.         CASE ELSE
  207.             COLOR 7, 0
  208.             CLS
  209.             END
  210.         END SELECT
  211.     LOOP
  212.   
  213.  
  214.