Category : BASIC Source Code
Archive   : QKWIN.ZIP
Filename : POPMENU1.BAS

 
Output of file : POPMENU1.BAS contained in archive : QKWIN.ZIP
'********************************************************************
'POPMENU1.BAS - A SAMPLE POP-UP MENU EXAMPLE
'POPMENU1 is like POPMENU, but lets you set attributes (colors) for
'each item in the menu.
'********************************************************************
REM $DYNAMIC
DEFINT A-Z 'Make all variables integers by default.
DIM w(2000) 'Dimension an integer array for our window.
CALL QWINIT(4) 'Need to call this command before using any QW commands.
CLS 'Clear the screen.

DIM SHARED m$(16) 'Define String array to hold menu items.
DIM SHARED cattr(16) 'Define integer array to hold attributes.
style = 2 'Make menu border double lined.
borderattr = 2 'Set attribute for border =
x = 30 'Begin at column 25.
y = 6 '& Row 6
max = 15 'Set # of items in menu = 15

'---- Load integer array with attributes for menu items ----
FOR i = 0 TO max
cattr(i) = i + 1
NEXT i

' ----- Array element (0) is used for the menus title -----
m$(0) = "Help Menu"

'--- Load string array for menu items from data statements. ----
DATA WOPEN,WCLOSE,WCLOSEALL,WPRINT,WLOCATE,WCSRPOS,WCLS, WCOLOR
DATA WWRAP,WCOPYSTR, WSETCSR,WCSRON,WCSROFF,WMOUSE,POPMENU
FOR i = 1 TO max
READ a$
m$(i) = " " + a$
NEXT i

LOCATE 3, 40
PRINT "POPMENU1 - ALLOWS YOU TO SET DIFFERENT COLORS FOR EACH MENU ITEM"

kb = 1: 'Allow F1 to exit the popmenu function. Result of key pressed in KB.
CALL POPMENU1(curel, kb, style, borderattr, cattr(), x, y, max, VARPTR(m$(0)))

LOCATE 16, 1: PRINT "Keyboard exit value: "; kb;
LOCATE 17, 1
IF curel = 0 THEN
PRINT "No options selected."
ELSE
PRINT "You've selected menu option: "; curel; "-->"; m$(curel)
END IF
PRINT "PRESS ANY KEY"
WHILE INKEY$ = "": WEND
END




  3 Responses to “Category : BASIC Source Code
Archive   : QKWIN.ZIP
Filename : POPMENU1.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/