home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
DATABASE
/
DBT123S.ZIP
/
DBTOTHER.PRG
< prev
next >
Wrap
Text File
|
1990-07-22
|
7KB
|
179 lines
*===================================================================
* DBTOTHER.PRG - demo of cursor, delay, pause, getkey
* (c) 1990 BERNATH COMPUTER V 1.23S
* 07/20/1990
*==================================================================
PARAMETERS CHOICE
CALL DBTOOLS WITH "15,3"
CALL DBTOOLS WITH "7,3,14,0,0"
DO CASE
CASE CHOICE = 1
CALL DBTOOLS WITH "3,3,5,11,50,14,6,2,0,1"
CALL DBTOOLS WITH "1,4,10,14,6,0,CURSOR - function 4"
SET COLOR TO +W/GR
@ 6,8 SAY "The CURSOR function allows you to turn"
@ 7,8 SAY "the curson on or off, and to change it"
@ 8,8 SAY "from a normal to a fat cursor."
CALL DBTOOLS WITH "10,10,10,14,6"
CALL DBTOOLS WITH "3,6,10,16,65,14,0,1,0,0"
mPARM = "CALL DBTOOLS WITH "+CHR(34)+"4,off/on,normal/fat"+CHR(34)
SET COLOR TO +GR/N
@ 7,13 SAY "Syntax:"
@ 8,13 SAY mPARM
SET COLOR TO W/N
@ 10,13 SAY "Set the parameters to 0 to turn off the cursor or"
@ 11,13 SAY "set it to normal size, or set it to 1 to turn on"
@ 12,13 SAY "the cursor or set it to fat size."
CALL DBTOOLS WITH "10,15,15,14,0"
CALL DBTOOLS WITH "3,10,20,12,50,15,4,2,0,1"
CALL DBTOOLS WITH "1,11,23,15,4,0,Cursor on, normal"
CALL DBTOOLS WITH "6,48"
CALL DBTOOLS WITH "5,11,23,11,49,4"
SET COLOR TO +W/R
CALL DBTOOLS WITH "1,11,23,15,4,0,Turning off the cursor"
CALL DBTOOLS WITH "6,26"
CALL DBTOOLS WITH "4,0,0"
CALL DBTOOLS WITH "5,11,23,11,49,4"
CALL DBTOOLS WITH "1,11,23,15,4,0,Cursor is off"
CALL DBTOOLS WITH "6,48"
CALL DBTOOLS WITH "5,11,23,11,49,4"
CALL DBTOOLS WITH "1,11,23,15,4,0,Cursor on, fat"
CALL DBTOOLS WITH "4,1,1"
CALL DBTOOLS WITH "6,48"
CALL DBTOOLS WITH "5,11,23,11,49,4"
CALL DBTOOLS WITH "4,1,0"
CALL DBTOOLS WITH "1,11,23,15,4,0,Back to normal"
CALL DBTOOLS WITH "6,48"
CASE CHOICE = 2
CALL DBTOOLS WITH "3,3,5,13,50,14,6,2,0,1"
CALL DBTOOLS WITH "1,4,12,14,6,0,DELAY - function 6"
SET COLOR TO +W/GR
@ 6,8 SAY "The DELAY function allows you to put"
@ 7,8 SAY "timed WAIT's in your program. The pro-"
@ 8,8 SAY "gram will suspend all operations until"
@ 9,8 SAY "the specified time interval has passed."
CALL DBTOOLS WITH "10,11,11,14,6"
CALL DBTOOLS WITH "3,6,10,16,65,14,0,1,0,1"
SET COLOR TO +GR/N
mPARM = "CALL DBTOOLS WITH "+CHR(34)+"6,delaytime"+CHR(34)
@ 7,13 SAY "Syntax:"
@ 8,13 SAY mPARM
SET COLOR TO W/N
@ 10,13 SAY "The delaytime parameter is in units of clock tics,"
@ 11,13 SAY "which is 1/18th second on a PC (ie, 18 = 1 second)."
CALL DBTOOLS WITH "10,15,15,14,0"
CALL DBTOOLS WITH "3,10,20,12,45,15,4,2,0,1"
KOUNT = 10
DO WHILE KOUNT >= 0
mPARM = "1,11,25,15,4,0,Countdown: "+STR(KOUNT,2)
CALL DBTOOLS WITH mPARM
CALL DBTOOLS WITH "17,400,1"
KOUNT = KOUNT - 1
CALL DBTOOLS WITH "6,18"
ENDDO
CALL DBTOOLS WITH "18"
CASE CHOICE = 3
CALL DBTOOLS WITH "3,3,5,14,50,14,6,2,0,1"
CALL DBTOOLS WITH "1,4,12,14,6,0,PAUSE - function 10"
SET COLOR TO +W/GR
@ 6,8 SAY "The PAUSE function is a more elegant"
@ 7,8 SAY "alternative to dBASE's WAIT command,"
@ 8,8 SAY "providing a means to set the cursor"
@ 9,8 SAY "position and color attributes the mes-"
@ 10,8 SAY "sage will display in. After receiving"
@ 11,8 SAY "a keystroke, the message is blanked."
CALL DBTOOLS WITH "10,13,15,14,6"
CALL DBTOOLS WITH "3,6,10,15,69,14,0,1,0,1"
SET COLOR TO +GR/N
mPARM = "CALL DBTOOLS WITH "+CHR(34)+"10,row,col,FG,BG"+CHR(34)
@ 7,13 SAY "Syntax:"
@ 8,13 say mPARM
mPARM = "CALL DBTOOLS WITH "+CHR(34)+"10,row,col,FG,BG,alternate message"+CHR(34)
@ 9,13 SAY mPARM
mPARM = "CALL DBTOOLS WITH "+CHR(34)+"10,Y,row,col,FG,BG,<alt msg>"+CHR(34)
@ 10,13 SAY mPARM
SET COLOR TO W/N
@ 12,13 SAY "Note the use of PAUSE at the bottom of this window."
CALL DBTOOLS WITH "10,14,15,14,0"
CALL DBTOOLS WITH "6,36"
CALL DBTOOLS WITH "3,8,20,18,74,11,5,4,0,1"
CALL DBTOOLS WITH "1,9,23,11,5,0,Variations:"
CALL DBTOOLS WITH "1,10,23,3,5,0,You may specify the PAUSE command to use an"
CALL DBTOOLS WITH "1,11,23,3,5,0,alternate message:"
CALL DBTOOLS WITH "10,12,23,14,13,Hurry up and hit a key!!"
CALL DBTOOLS WITH "1,13,23,3,5,0,You may also trap and process function keys"
CALL DBTOOLS WITH "1,14,23,3,5,0,with the PAUSE command:"
m_KEY=0
DO WHILE m_KEY <> 27
CALL DBTOOLS WITH "1,15,23,11,5,0,Press any key (including Fkeys and cursor control"
m_VAR = "10,Y,16,23,11,5,keys) or ESC to quit:"
CALL DBTOOLS WITH m_VAR
m_KEY = ASC(m_VAR)-1 && extract scancodes
m_SCAN= ASC(SUBSTR(m_VAR,2,1))-1
CALL DBTOOLS WITH "5,17,23,17,47,5"
DO CASE
CASE m_KEY=27 .AND. m_SCAN=0 && ESC
CALL DBTOOLS WITH "1,17,23,7,5,0,ESC Pressed"
CASE m_KEY>=32 .AND. m_SCAN=0 && Regular Key
CALL DBTOOLS WITH "1,17,23,7,5,0,Regular Key Pressed"
OTHERWISE && FKey
CALL DBTOOLS WITH "1,17,23,3,5,0,Scan codes are: ";
+TRANSFORM(m_KEY,"999")+","+TRANSFORM(m_SCAN,"999")
ENDCASE
ENDDO
CASE CHOICE = 4
CALL DBTOOLS WITH "23,0"
CALL DBTOOLS WITH "3,3,5,11,50,0,10,2,0,1"
CALL DBTOOLS WITH "1,4,10,0,10,0,GETKEY - function 25"
SET COLOR TO B/*G
@ 6,8 SAY "The GETKEY function allows you to trap"
@ 7,8 SAY "and return unambiguous codes for any"
@ 8,8 SAY "combination of keys and Shift, Cntrl,"
@ 9,8 SAY " and Alt."
CALL DBTOOLS WITH "10,10,10,0,10"
CALL DBTOOLS WITH "3,6,10,16,65,15,2,1,0,1"
mPARM = "mPARM = "+CHR(34)+"25,echo mode"+CHR(34)
SET COLOR TO +W/G
@ 7,13 SAY "Syntax:"
@ 8,13 SAY mPARM
@ 9,13 say "CALL DBTOOLS WITH mPARM"
@ 10,13 SAY "mKEY=ASC(mPARM)-1"
@ 11,13 SAY "mSCAN=ASC(SUBSTR(mPARM,2,1))-1"
@ 13,16 SAY "echo mode = 0, no character echo"
@ 14,16 SAY "echo mode = 1, echo character"
CALL DBTOOLS WITH "3,16,25,20,70,13,4,1,0,1"
SET COLOR TO W/R
@ 17,27 SAY "Without echo:"
@ 18,27 SAY "With echo:"
CALL DBTOOLS WITH "1,19,27,15,4,0,Press ESC twice to exit"
mKEY=0
mSCAN=0
DO WHILE mKEY<>27
CALL DBTOOLS WITH "5,17,43,18,68"
mPARM="25,0"
@ 17,41 SAY " "
CALL DBTOOLS WITH mPARM
mKEY=ASC(mPARM)-1
mSCAN=ASC(SUBSTR(mPARM,2,1))-1
@ 17,46 SAY "KEY: "+TRANSFORM(mKEY,"999")+" SCAN: "+TRANSFORM(mSCAN,"999")
@ 18,41 SAY " "
mPARM="25,1"
CALL DBTOOLS WITH mPARM
mKEY=ASC(mPARM)-1
mSCAN=ASC(SUBSTR(mPARM,2,1))-1
@ 18,46 SAY "KEY: "+TRANSFORM(mKEY,"999")+" SCAN: "+TRANSFORM(mSCAN,"999")
CALL DBTOOLS WITH "6,36"
ENDDO
ENDCASE
CALL DBTOOLS WITH "14,3,0"
RETURN