home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
egaf02.zip
/
EGATST.PRG
< prev
Wrap
Text File
|
1989-11-11
|
5KB
|
236 lines
* EGATST.PRG - test bed for EGAF.OBJ
* Jim Kyle - 11/11/89 - Use at your OWN risk!!!
PUBLIC TOP_WORDS[6], TOP_DESC[6], TOP_LOCS[6]
SET COLOR TO W+/B,W+/R+,W+/B,W/N,W/N
SET CONFIRM OFF
DO INIT_MENU
call _set28
clear screen
? 'This is a test to see what happens'
?? ' when the EGAF.OBJ package is used at 80x28.'
c = col() && save position while testing screen size
r = row()
call __brc && put cursor in bottom RH corner of screen
c1 = col() && adjust for zero-based r,c values
r1 = row()
@ row(),col()-3 SAY 'BRC'
@ r+2, 0 SAY 'CRT size is '+str(r1+1,3,0)+' rows by'+str(c1+1,3,0)+' cols...'
for i = r+2 to r1-2
? 'This is line '+str(row(),3,0)
next
*WAIT
* rmb - 11-07-89
SET KEY 28 TO HELP
temp = " "
@ r1,0 SAY "Press Any Key"
@ r1,col()+1 GET temp
READ
clear screen
@ 1,0,4,c1 BOX '┌─┐│┘─└│ '
@ 5,0,r1,c1 BOX '╒═╕│╛═╘│ '
CHOICE = 1
DO WHILE .T.
DO GET_TOGGLE WITH TOP_WORDS, TOP_DESC, TOP_LOCS, 6, CHOICE
IF CHOICE = 6
EXIT
ENDIF
ENDDO
SET KEY 28 TO
*WAIT
*
call _set43
clear screen
? 'This is a test to see what happens'
?? ' when the EGAF.OBJ package is used at 80x43.'
c = col() && save position while testing screen size
r = row()
call __brc && put cursor in bottom RH corner of screen
c1 = col() && adjust for zero-based r,c values
r1 = row()
@ row(),col()-3 SAY 'BRC'
@ r+2, 0 SAY 'CRT size is '+str(r1+1,3,0)+' rows by'+str(c1+1,3,0)+' cols...'
for i = r+2 to r1-2
? 'This is line '+str(row(),3,0)
next
*WAIT
* rmb - 11-07-89
SET KEY 28 TO HELP
temp = " "
@ r1,0 SAY "Press Any Key"
@ r1,col()+1 GET temp
READ
clear screen
@ 1,0,4,c1 BOX '┌─┐│┘─└│ '
@ 5,0,r1,c1 BOX '╒═╕│╛═╘│ '
CHOICE = 1
DO WHILE .T.
DO GET_TOGGLE WITH TOP_WORDS, TOP_DESC, TOP_LOCS, 6, CHOICE
IF CHOICE = 6
EXIT
ENDIF
ENDDO
SET KEY 28 TO
*WAIT
*
call _set50
clear screen
? 'This is a test to see what happens'
?? ' when the EGAF.OBJ package is used at 80x43.'
c = col() && save position while testing screen size
r = row()
call __brc && put cursor in bottom RH corner of screen
c1 = col() && adjust for zero-based r,c values
r1 = row()
@ row(),col()-3 SAY 'BRC'
@ r+2, 0 SAY 'CRT size is '+str(r1+1,3,0)+' rows by'+str(c1+1,3,0)+' cols...'
for i = r+2 to r1-2
? 'This is line '+str(row(),3,0)
next
*WAIT
* rmb - 11-07-89
SET KEY 28 TO HELP
temp = " "
@ r1,0 SAY "Press Any Key"
@ r1,col()+1 GET temp
READ
clear screen
@ 1,0,4,c1 BOX '┌─┐│┘─└│ '
@ 5,0,r1,c1 BOX '╒═╕│╛═╘│ '
CHOICE = 1
DO WHILE .T.
DO GET_TOGGLE WITH TOP_WORDS, TOP_DESC, TOP_LOCS, 6, CHOICE
IF CHOICE = 6
EXIT
ENDIF
ENDDO
SET KEY 28 TO
*WAIT
*
call _set25
clear screen
? 'This is a test to see what happens'
?? ' when the EGAF.OBJ package is used at 80x25.'
c = col() && save position while testing screen size
r = row()
call __brc && put cursor in bottom RH corner of screen
c1 = col() && adjust for zero-based r,c values
r1 = row()
@ row(),col()-3 SAY 'BRC'
@ r+2, 0 SAY 'CRT size is '+str(r1+1,3,0)+' rows by'+str(c1+1,3,0)+' cols...'
for i = r+2 to r1-2
? 'This is line '+str(row(),3,0)
next
*WAIT
* rmb - 11-07-89
SET KEY 28 TO HELP
temp = " "
@ r1,0 SAY "Press Any Key"
@ r1,col()+1 GET temp
READ
clear screen
@ 1,0,4,c1 BOX '┌─┐│┘─└│ '
@ 5,0,r1,c1 BOX '╒═╕│╛═╘│ '
CHOICE = 1
DO WHILE .T.
DO GET_TOGGLE WITH TOP_WORDS, TOP_DESC, TOP_LOCS, 6, CHOICE
IF CHOICE = 6
EXIT
ENDIF
ENDDO
SET KEY 28 TO
*WAIT
*
SET COLOR TO
clear screen
quit
PROCEDURE INIT_MENU
TOP_WORDS[1] = "File"
TOP_WORDS[2] = "Edit"
TOP_WORDS[3] = "Report"
TOP_WORDS[4] = "Shell"
TOP_WORDS[5] = "Utility"
TOP_WORDS[6] = "Quit"
TOP_DESC[1] = "Perform Basic File Operations. "
TOP_DESC[2] = "Edit the Database. "
TOP_DESC[3] = "Run Built-In or User-Defined Reports."
TOP_DESC[4] = "Shell Temporarily to DOS. "
TOP_DESC[5] = "System Utilities. "
TOP_DESC[6] = "Exit Management System. "
TOP_LOCS[1] = 2
TOP_LOCS[2] = 9
TOP_LOCS[3] = 16
TOP_LOCS[4] = 25
TOP_LOCS[5] = 33
TOP_LOCS[6] = 43
RETURN
PROCEDURE GET_TOGGLE
PARAMETERS WORDS, DESC, LOCS, NUMS, GCHOICE
SET ESCAPE ON
SET MESSAGE TO 3
FOR I = 1 to NUMS
mstr = CHR(179) + " " + DESC[I] + SPACE(77-LEN(DESC[I])) + CHR(179)
@ 2, LOCS[I] PROMPT WORDS[I] MESSAGE mstr
NEXT I
SET INTENSITY ON
SET WRAP ON
MENU TO GCHOICE
SET WRAP OFF
SET CURSOR OFF
SET INTENSITY OFF
IF GCHOICE = 0
GCHOICE = NUMS
ENDIF
SET ESCAPE OFF
RETURN
PROCEDURE HELP
PARAMETERS mprog,mline,mvar
PRIVATE num, cstr, dstr, hcolor, PrevRow, PrevCol
IF mprog='HELP'
RETURN
ENDIF
PrevRow = ROW()
PrevCol = COL()
SET CURSOR OFF
hdr_scr = SAVESCREEN(0,72,1,79)
help_scr = SAVESCREEN(13,8,33,72)
stat_scr = SAVESCREEN(41,30,42,79)
KEYBOARD ""
@ 13,20,20,60 BOX '╒═╕│╛═╘│ '
@ 13,30 SAY '[ Help System ]'
@ 18,28 SAY "Sorry, No Help Available."
INKEY(0)
KEYBOARD ""
RESTSCREEN(0,72,1,79,hdr_scr)
RESTSCREEN(13,8,33,72,help_scr)
RESTSCREEN(41,30,42,79,stat_scr)
@ PrevRow, PrevCol SAY ""
RETURN