home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / EZW1V30A.ZIP / PDDEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-05-28  |  7.9 KB  |  262 lines
  1. '=========================================================================
  2.  
  3. '                   PULLDOWN demonstration program
  4. '                         Using EZWINDOWS library.
  5.  
  6. '                   Written by
  7. '                         John C. Strong
  8. '                         3155 S.W. 178th Aveneu
  9. '                         Aloha, OR 97006
  10.  
  11. '=========================================================================
  12.  
  13.  
  14.     DEFINT A-Z
  15.     DECLARE SUB qbmouse (a%, b%, c%, d%)
  16.     REM $DYNAMIC
  17.     REM $INCLUDE: 'qb.bi'
  18.  
  19.     DIM HiPos1(10), HiPos2(10, 20), MaxSize(10), MaxItems(10), item$(10, 15), valid(10, 15), toggle(10, 15)
  20.     DIM reg AS regtype
  21.  
  22.     col = 1                                      'assume color monitor
  23.     IF INSTR(COMMAND$, "BW") THEN col = 0        'user wants black/white
  24.     ms = 1                                       'assume mouse
  25.     IF INSTR(COMMAND$, "IM") THEN ms = 0         'user doesn't want mouse
  26.     COLOR 7, col * 5
  27.     bl = 25
  28.     IF INSTR(COMMAND$, "43") THEN bl = 43
  29.     IF INSTR(COMMAND$, "50") THEN bl = 50
  30.     WIDTH 80, bl
  31.     CLS
  32.     
  33.     LOCATE 5, 5: PRINT "This is the PULLDOWN menu system!"
  34.     LOCATE 7, 5: PRINT "Here are some of its exciting features:"
  35.     LOCATE 9, 10
  36.     PRINT " Easily integrated into any existing QB 4.x program."
  37.     PRINT TAB(10); " Full mouse support."
  38.     PRINT TAB(10); " Full color control."
  39.     PRINT TAB(10); " Selections can by "; CHR$(34); "grayed"; CHR$(34); " out."
  40.     PRINT TAB(10); " Selections can be toggled inclusivley and exclusively."
  41.     PRINT TAB(10); " Mouse, cursor keys, or 'hot' keys can be used to"
  42.     PRINT TAB(12); "make a selection."
  43.     PRINT TAB(10); " 'Hot' key can be located anywhere in selection text."
  44.     PRINT TAB(10); " Menus pop up instantly, even on an XT!"
  45.     PRINT TAB(10); " Windows have a transparent shadow."
  46.     PRINT TAB(10); " Item will optionally blink upon selection."
  47.     PRINT TAB(10); " Dividing lines are inserted automatically."
  48.  
  49.     LOCATE 22, 5: PRINT "Select Exit from File menu when you're ready to quit..."
  50.     LOCATE 24, 5: PRINT "You selected:   ";
  51.  
  52.     FOR i = 1 TO 10          'HiPos1() holds the location in each menu
  53.         HiPos1(i) = 1       'name for the 'hot' key - in this case it
  54.     NEXT i                   'is the first letter in each name.
  55.     
  56.     'Load in menu data from data statements at the end of this program
  57.         
  58.     RESTORE PullDownMenuData
  59.     
  60.     FOR menu = 1 TO 8
  61.         READ MaxItems(menu)               'Number of selections in each menu
  62.         READ MaxSize(menu)                'Max length of items in each menu
  63.         FOR slct = 1 TO MaxItems(menu)
  64.             READ item$(menu, slct)       'Text displayed for selection
  65.             READ HiPos2(menu, slct)      'Hot key for each selection in menu
  66.             READ valid(menu, slct)       'Determines if grayed out or not
  67.             READ toggle(menu, slct)      'Determines if selection can be
  68.         NEXT slct
  69.     NEXT menu
  70.     
  71.     menuline$ = "   File  Edit  View  Search  Run  Debug  Calls  Options                         "
  72.     
  73.     menurow = 1                             'Screen row of menu line
  74.     menucol = 1                             'Beginning column position
  75.     menuattr = 7 * 16 + 0                   'Menu color
  76.     hotattr = 7 * 16 + 15                   'Hot key hilite color
  77.     hiattr = 0 * 16 + 7                     'Hilite bar color
  78.     NVattr = 7 * 16 + 8                     'color for grayed-out
  79.                                     'selections
  80.     clearafter = 1                          'erase menu after selection
  81.     menuslct = 1                            'menu to start with
  82.     snd = 1                                 'turn sound on
  83.     shadow = 4
  84.     COLOR 0, 7
  85.     LOCATE 1, 1
  86.     PRINT menuline$;
  87.     
  88.     CALL qbmouse(0, 0, 0, 0)                'initialize mouse
  89.     CALL qbmouse(1, 0, 0, 0)               'show mouse cursor
  90.     CALL qbmouse(10, 0, &H7000, 3844)     'set mouse cursor
  91.  
  92.     DO
  93.         itemslct = -1
  94.         DEF SEG = &H40                'Check if ALT key is being pressed
  95.         x = PEEK(&H17)                'Bit 3 will be high if so
  96.         DEF SEG                       '2^3 = 8
  97.         qbmouse 3, b, mx, my          'get mouse info
  98.         mx = mx / 8 + 1: my = my / 8 + 1        'convert to text coordinates
  99.  
  100.         'If ALT key is pressed, or mouse button pushed while cursor
  101.         'positioned on menu bar, then enter the pulldown routine
  102.  
  103.         IF (x AND 8) OR (b = 1 AND my = 1) THEN
  104.             DEF SEG = 0
  105.             POKE (1050), PEEK(1052)  'empty keyboard buffer
  106.             DEF SEG
  107.             CALL PULLDOWN(menuline$, menurow, menucol, menuattr, hotattr, hiattr, NVattr, HiPos1(), HiPos2(), MaxSize(), MaxItems(), item$(), valid(), toggle(), ms, clearafter, menuslct, shadow, snd, menuslct, itemslct)
  108.             LOCATE 24, 5
  109.             COLOR 7, 5
  110.             PRINT "You selected:   "; item$(menuslct, itemslct); "                      ";
  111.  
  112.             IF toggle(menuslct, itemslct) <> 0 THEN
  113.                 LOCATE 24, 40
  114.                 IF toggle(menuslct, itemslct) > 0 THEN
  115.                     PRINT "ON   ";
  116.                 ELSE
  117.                     PRINT "OFF  ";
  118.                 END IF
  119.             END IF
  120.             seed = menuslct
  121.             IF seed = 0 THEN seed = 1
  122.             qbmouse 2, b, c, d
  123.             COLOR 0, 7
  124.             LOCATE 1, 1
  125.             PRINT menuline$;
  126.             qbmouse 1, b, c, d
  127.         END IF
  128.     LOOP UNTIL menuslct = 1 AND itemslct = 15    '<== change this if your
  129.                                         'exit option is located
  130.                                         'somewhere different
  131.     
  132.     REDIM HiPos1(0), HiPos2(0, 0), MaxSize(0), MaxItems(0), item$(0, 0), valid(0, 0), toggle(0, 0)
  133.     
  134.     qbmouse 2, 0, 0, 0               'turn off mouse cursor
  135.     COLOR 7, 0
  136.     CLS
  137.     END
  138.  
  139. '---------------------------- End of Program Code ----------------------------
  140.  
  141. '=============================================================================
  142. '                              M e n u   D a t a
  143. '=============================================================================
  144.  
  145.  
  146. PullDownMenuData:
  147.  
  148.     'File menu
  149.  
  150.     DATA 15,17
  151.     DATA "New Program",1,1,0
  152.     DATA "Open Program...",1,1,0
  153.     DATA "Merge...",1,1,0
  154.     DATA "Save...",1,1,0
  155.     DATA "Save As",6,1,0
  156.     DATA "Save All",3,1,0
  157.     
  158.     'Here's an example of inserting a dividing line
  159.     DATA "~",0,0,0
  160.     
  161.     DATA "Create File...",1,1,0
  162.     DATA "Load File...",1,1,0
  163.     DATA "Unload File...",1,1,0
  164.     DATA "~",0,0,0
  165.     DATA "Print...",1,1,0
  166.     DATA "DOS Shell",1,1,0
  167.     DATA "~",0,0,0
  168.     DATA "Exit",2,1,0
  169.  
  170.     'Edit menu
  171.     
  172.     DATA 8,22
  173.     DATA "Undo   Alt+Backspace",1,1,0
  174.     DATA "Cut        Shift+Del",3,0,0
  175.     DATA "Copy        Ctrl+Ins",1,0,0
  176.     DATA "Paste      Shift+Ins",1,1,0
  177.     DATA "Clear            Del",3,1,0
  178.     DATA "~",0,0,0
  179.     DATA "New SUB...",5,1,0
  180.     DATA "New FUNCTION...",5,1,0
  181.  
  182.     'View menu
  183.     
  184.     DATA 9,24
  185.     DATA "SUBs...             F2",1,1,0
  186.     DATA "Next SUB      Shift+F2",2,1,0
  187.     DATA "Split",2,1,0
  188.     DATA "~",0,0,0
  189.     DATA "Next Statement",1,1,0
  190.     DATA "Output Screen       F4",2,1,0
  191.     DATA "~",0,0,0
  192.     DATA "Included File",1,0,0
  193.     DATA "Included Lines",10,1,0
  194.  
  195.     'Search menu
  196.     
  197.     DATA 5,26
  198.     DATA "Find...",1,1,0
  199.     DATA "Selected Text     Ctrl+\",1,1,0
  200.     DATA "Repeat Last Find      F3",1,1,0
  201.     DATA "Change...",1,1,0
  202.     DATA "Label...",1,1,0
  203.  
  204.     'Run menu
  205.  
  206.     DATA  9,21
  207.     DATA "Start      Shift+F5",1,1,0
  208.     DATA "Restart",1,1,0
  209.     DATA "Continue         F5",3,1,0
  210.     DATA "Modify COMMAND$...",8,1,0
  211.     DATA "~",0,0,0
  212.     DATA "Make EXE File...",7,1,0
  213.     DATA "Make Library...",6,1,0
  214.     DATA "~",0,0,0
  215.     DATA "Set Main Module...",5,1,0
  216.  
  217.     'Debug menu
  218.     
  219.     DATA 13,29
  220.     DATA "Add Watch...",1,1,0
  221.     DATA "Instant Watch...   Shift+F9",1,1,0
  222.     DATA "Watchpoint...",1,1,0
  223.     DATA "Delete Watch...",1,0,0
  224.     DATA "Delete All Watch",3,0,0
  225.     DATA "~",0,0,0
  226.     DATA "Trace On",1,1,0
  227.     DATA "History On",1,1,0
  228.     DATA "~",0,0,0
  229.     DATA "Toggle Breakpoint        F9",8,1,0
  230.     DATA "Clear All Breakpoints",1,1,0
  231.     DATA "Break On Errors",10,1,0
  232.     DATA "Set Next Statement",1,0,0
  233.  
  234.     'Calls menu
  235.     
  236.     DATA 1,17
  237.     DATA "PDDEMO.BAS",1,1,0
  238.  
  239.     'Options menu
  240.     
  241.     DATA 5,17
  242.     DATA "Display...",1,1,0
  243.     DATA "Set Paths...",5,1,0
  244.     DATA "Right Mouse...",7,1,0
  245.     DATA "Syntax Checking",1,1,1
  246.     DATA "Full Menus",1,1,1
  247.  
  248. REM $STATIC
  249. SUB qbmouse (a, b, c, d)
  250.     SHARED reg AS regtype
  251.     reg.ax = a
  252.     reg.bx = b
  253.     reg.cx = c
  254.     reg.dx = d
  255.     CALL interrupt(&H33, reg, reg)
  256.     a = reg.ax
  257.     b = reg.bx
  258.     c = reg.cx
  259.     d = reg.dx
  260. END SUB
  261.  
  262.