home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
progbas
/
baswind4.arj
/
BASWIN22.ZIP
/
DEMO2.BAS
< prev
next >
Wrap
BASIC Source File
|
1986-11-14
|
13KB
|
349 lines
key off:color 7,1:cls
dim scrn%(2000),item$(100),tagged%(100),tag$(100),msgdat$(5)
for i=1 to 30
ulr%=rnd*17:while ulr% = 0:ulr%=rnd*17:wend
lrr%=rnd*23:while lrr% < ulr%:lrr%=rnd*23:wend
ulc%=rnd*60:while ulc% = 0:ulc%=rnd*60:wend
lrc%=rnd*79:while lrc% < ulc%:lrc%=rnd*79:wend
fore%=rnd*15
back%=rnd*7
call makewind(ulr%,ulc%,lrr%,lrc%,2,fore%,back%,0,1,"")
next i
call makewind(9,15,16,65,2,0,7,0,1,"")
color 0,7
locate 9,18:print "Introducing ..."
locate 11,18:print " Window Tools"
locate 13,18:print "A collection of useful routines based on"
locate 14,18:print "BASWIND2 designed to perform powerful func-"
locate 15,18:print "tions in your own programs ..."
seconds=5:gosub waitsec
call makewind(9,15,16,65,2,0,7,0,0,"")
locate 12,18:print " Stand by for a complete demo ... "
seconds=5:gosub waitsec
color 7,1
cls
locate 8,10:print "The first demo you will see will be POPMENU - A routine"
locate 9,10:print "used to select options from a menu window using the cursor"
locate 10,10:print "keys to move a 'select bar'. You will actually use this"
locate 11,10:print "routine to select the other demos ..."
seconds=7:gosub waitsec
demo: cls
item$(1)=" POPLIST "
item$(2)=" TAGLIST "
item$(3)=" POPDIR "
item$(4)=" TAGDIR "
item$(5)=" BARMENU "
item$(6)=" MENU123 "
item$(7)=" CALENDAR "
item$(8)=" CALENDR3 "
item$(9)=" KEYCAL "
item$(10)=" CAUTION "
item$(11)=" WARNING "
item$(12)=" End Demo "
call popmenu("Select Demo ...",12,item$(),4,0,7,15,1,"0",1,select%)
on select% gosub dopopl,dotagl,dopopd,dotagd,dobar,do123,docal,docal3,dokey,docau,dowarn
if select%=12 then goto endit
goto demo
dopopl: cls
locate 8,10:print "This is POPLIST - a pop-up window that allows you to"
locate 9,10:print "display a list of items passed in an array. If there"
locate 10,10:print "are too many items in the list to fit in the window,"
locate 11,10:print "you can scroll the data up and down; use the Page Up"
locate 12,10:print "and Page Down keys and the Home and End Keys to fully"
locate 13,10:print "display all of the items in the list ..."
seconds=10:gosub waitsec
cls
for i=1 to 100
item$(i)=space$(18)
temp$=" Item # "+str$(i)
mid$(item$(i),3,len(temp$))=temp$
next i
call poplist("Choose an Item ...",10,100,item$(),0,3,15,5,"0",1,select%)
locate 23,10
print "The Item Number you selected was ";select%;" ";item$(select%)
seconds=5:gosub waitsec
return
dotagl: cls
locate 8,10:print "This is TAGLIST - Similar in function to POPLIST, this routine"
locate 9,10:print "allows you to scroll through a large list of items; but rather"
locate 10,10:print "than letting you select only one item, it allows you to 'tag'"
locate 11,10:print "a group of items using the 'T' key, or 'untag' items already"
locate 12,10:print "tagged by means of the 'U' key ..."
seconds=10:gosub waitsec
cls
for i=0 to 99
item$(i)=space$(18)
tagged%(i)=0
temp$=" Item # "+str$(i)
mid$(item$(i),3,len(temp$))=temp$
next i
call taglist("[T]ag or [U]ntag",10,99,numtagged%,item$(),tagged%(),5,0,0,7,"0",0)
locate 2,3
print "The ";numtagged%;" Items you tagged were: "
locate 4,5
for i=0 to 99
locate ,5:if tagged%(i)=1 then print item$(i)
next i
seconds=5:gosub waitsec
return
dopopd: cls
locate 8,10:print "This is POPDIR - A special case of the POPLIST routine. Here the"
locate 9,10:print "items to be selected from are the directory of a disk, returned"
locate 10,10:print "from a directory search given a filespec which may include the"
locate 11,10:print "wildcard characters '?' and '*' ..."
seconds=10:gosub waitsec
cls
input "Enter File Spec: ";SEARCH$
CALL POPDIR(SEARCH$,10,0,7,5,7,"0",1,NUMFILES%,SELECTFILE$)
locate 23,10:print "Returned Value is: ";selectfile$
seconds=5:gosub waitsec
return
dotagd: cls
locate 8,10:print "This is TAGDIR - A special case of the POPDIR routine. Instead of "
locate 9,10:print "selecting only one file from a directory, you may tag and untag"
locate 10,10:print "filenames to be returned in an array. This type of routine is"
locate 11,10:print "useful for File Manager type programs ..."
seconds=10:gosub waitsec
cls
input "Enter File Spec: ";SEARCH$
CALL TAGDIR(SEARCH$,10,6,0,0,7,"0",0,numtagged%,tag$())
locate 2,3
print "The ";numtagged%;" Items you tagged were: "
locate 4,5
for i=0 to numtagged%-1
locate ,5:print tag$(i)
next i
seconds=5:gosub waitsec
return
dobar: cls
locate 8,10:print "This is BARMENU - A highlighted Menu Bar is passed to the routine"
locate 9,10:print "as a string. By pressing the left and right cursor keys, a 'pull-down'"
locate 10,10:print "menu is displayed below each of the Menu Bar items. This routine is"
locate 11,10:print "very similar to the user interface of QuickBASIC Version 2.0 ..."
seconds=10:gosub waitsec
cls
DIM MAXSIZE%(15),MAXITEMS%(15),ITEMS$(5,15)
for i=0 TO 4
for j=0 TO 9
ITEMS$(I,J)=" Menu"+str$(i+1)+" Item"+str$(j+1)+" "
next j
next i
for i=0 TO 4
MAXSIZE%(I)=15
MAXITEMS%(I)=10
next i
MENULINE$=" MENU#1 MENU#2 MENU#3 MENU#4 MENU#5 "
CALL BARMENU(MENULINE$,0,7,12,5,MAXSIZE%(),MAXITEMS%(),ITEMS$(),MENUSLCT%,ITEMSLCT%)
locate 23,10:print "Returned Value is MENU: ";MENUSLCT%;" ITEM: ";ITEMSLCT%;" ";
seconds=5:gosub waitsec
return
do123: cls
locate 8,10:print "This is MENU123 - An imitation of the Lotus 1-2-3 user interface. A menu bar"
locate 9,10:print "string is passed to the routine for the various selections to be displayed."
locate 10,10:print "Also, an array of descriptions for each menu choice is also passed to be "
locate 11,10:print "shown on the line below. A highlighted block defines the current selection ..."
seconds=10:gosub waitsec
cls
DIM ITEMDESC$(10)
MENULINE$=" Format Copy Rename Delete Erase Move Discard Pop Push BigBadBillybob "
MENUFG%=7:MENUBG%=1
ITEMNUM%=10
FOR I=0 TO ITEMNUM%
ITEMDESC$(I)="This is Menu Item Number"+str$(i+1)
NEXT I
COLOR 7,1:KEY OFF:CLS
LOCATE 3,1:PRINT STRING$(80,205)
CALL MENU123(MENULINE$,1,MENUFG%,MENUBG%,ITEMNUM%,ITEMDESC$(),ITEMSLCT%)
LOCATE 10,10
PRINT "Item Selected Was: ";itemslct%
seconds=5:gosub waitsec
return
docal: cls
locate 8,10:print "This is CALENDAR - As its name implies, this routine returns"
locate 9,10:print "a calendar displayed in a window when passed a month number "
locate 10,10:print "and a year..."
seconds=10:gosub waitsec
cls
input "Month (1-12)",month%
input "Year (4 digit)",year%
CALL CALENDAR(MONTH%,YEAR%,"0",0,7,1)
seconds=10:gosub waitsec
color 7,1:cls
return
docal3: cls
locate 8,10:print "This is CALENDR3 - Like CALENDAR, this routine returns"
locate 9,10:print "a calendar in a window when passed a month number and a"
locate 10,10:print "year; however, this routine also returns calendars for"
locate 11,10:print "the previous and following months ..."
seconds=10:gosub waitsec
cls
input "Month (1-12)",month%
input "Year (4 digit)",year%
CALL CALENDR3(MONTH%,YEAR%,12,0,7,1)
seconds=10:gosub waitsec
color 7,1:cls
return
dokey: cls
locate 8,10:print "This is KEYCAL - Like CALENDAR, this routine returns a calendar"
locate 9,10:print "in a window when passed a month number and a year; however this"
locate 10,10:print "routine allows you to advance or back up months and years by"
locate 11,10:print "using the cursor keys ..."
seconds=10:gosub waitsec
cls
input "Month (1-12)",month%
input "Year (4 digit)",year%
print "Press [ESC] or [RETURN] to exit ..."
call keycal(MONTH%,YEAR%,"0",0,7,1)
color 7,1
cls
return
docau: cls
locate 8,10:print "This is CAUTION - It displays a yellow 'caution' window with one"
locate 9,10:print "or more lines of text passed to it in an array. You then select"
locate 10,10:print "(using the cursor keys) whether to Continue or Cancel the current"
locate 11,10:print "operation ..."
seconds=10:gosub waitsec
cls
MSGDAT$(0)="You are about to convert your Color Monitor"
MSGDAT$(1)="into a Monochrome Monitor."
MSGDAT$(3)="ARE YOU ABSOLUTELY SURE YOU WANT TO DO THIS?"
CALL CAUTION(4,MSGDAT$(),"0",RETURN.CODE%)
LOCATE 23,35
IF RETURN.CODE%=0 THEN PRINT "CANCEL" ELSE PRINT "CONTINUE"
seconds=5:gosub waitsec
return
dowarn: cls
locate 8,10:print "This is WARNING - It displays a red 'WARNING' window with one"
locate 9,10:print "or more lines of text passed to it in an array. You then select"
locate 10,10:print "(using the cursor keys) whether to Continue or Cancel the current"
locate 11,10:print "operation ..."
seconds=10:gosub waitsec
cls
MSGDAT$(0)="You are about to convert your house AC voltage"
MSGDAT$(1)="from 110 volts to 440 volts."
MSGDAT$(3)="ARE YOU ABSOLUTELY SURE YOU WANT TO DO THIS?"
CALL WARNING(4,MSGDAT$(),"0",RETURN.CODE%)
LOCATE 23,35
IF RETURN.CODE%=0 THEN PRINT "CANCEL" ELSE PRINT "CONTINUE"
seconds=5:gosub waitsec
return
endit:
color 7,1:cls
call makewind(9,15,16,65,2,0,7,0,1,"")
color 0,7
locate 10,18:print " * Window Tools * "
locate 12,18:print "As a marketing experiment, the Window Tools "
locate 13,18:print "routines will be released to the Public Do-"
locate 14,18:print "main at the rate of about one per month ..."
seconds=5:gosub waitsec
call makewind(9,15,16,65,2,0,7,0,0,"")
locate 9,18:print "However, if you would like to obtain all of"
locate 10,18:print "these routines at once, with source code and"
locate 11,18:print "supporting documentation, please send $25 to:"
locate 13,18:print " Dave Evers "
locate 14,18:print " 2500 Larch Rd. #58 "
locate 15,18:print " Quincy, IL 62301 "
seconds=5:gosub waitsec
color 7,1
locate 22,9:print "Please see accompanying file BASWIND2.ARC for more information"
end
waitsec: begintime=timer
while endtime < begintime+seconds
endtime=timer
wend
return