home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pcmagazi
/
1992
/
06
/
tryalt.prg
< prev
Wrap
Text File
|
1991-10-06
|
5KB
|
82 lines
***********************************************************************
* TRYALT.PRG Clipper 5.0
* Test program to try the DOSSHELL and DOQUIT SET KEY procedures
***********************************************************************
SET PROCEDURE TO TRYALT
StartColor = SETCOLOR() && Save the existing colors
SET KEY 301 TO DOQUIT && Bind the Alt-X key to the DOQUIT procedure
SET KEY 274 TO DOSSHELL && Bind the Alt-E key to the DOSSHELL procedure
CLS
* SETCOLOR("W+/R")
pcmag = "PC Magazine Databases PC Magazine Databases PC Magazine Databases PC Magazine "
single = CHR(218)+CHR(196)+CHR(191)+CHR(179)+CHR(217)+CHR(196)+CHR(192)+CHR(179)
@ 0,0,24,79 BOX single+"x"
i = 1
DO WHILE i <= 23
@ i, 1 SAY pcmag
i = i + 1
ENDDO
* SETCOLOR(StartColor)
WAIT "" && Hit Alt-X or Alt-E while waiting
RETURN
***********************************************************************
* PROCEDURE DOQUIT Clipper 5.0
* SET KEY procedure to QUIT an application
***********************************************************************
PROCEDURE DOQUIT (ProcName, ProcLine, ProcVar) && Needed but not used
LOCAL OldRow, OldCol, Scol, Srow, OldCursor && Make some locals
OldRow = ROW() && Save cursor row
OldCol = COL() && and column
Scol = (MAXCOL() - 33) / 2 && Calculate upper left corner based on
Srow = (MAXROW() - 6) / 2 && MAXCOL and MAXROW
OldScreen = ; && Save the area of the screen
SAVESCREEN(Srow, Scol, Srow + 6, Scol + 33) && under the box
OldColor = SETCOLOR("GR+/B") && Save the current colors and set new ones
OldCursor = SETCURSOR(0) && Save the current cursor
@ Srow, Scol CLEAR TO Srow + 6, Scol + 33 && Clear the box
@ Srow, Scol TO Srow + 6, Scol + 33 DOUBLE && Draw the box
@ Srow + 2, Scol + 2 SAY ; && Place message in box
"Are you sure you want to quit?" &&
@ Srow + 4, Scol + 9 PROMPT " Yes " && Place the prompts
@ Srow + 4, Scol + 19 PROMPT " No " &&
SET KEY 301 TO && Unbind Alt-X temporarily
TONE(1500,1) && Sound two tones
TONE(2000,1) &&
MENU TO Choice && Get Yes or No
SETCURSOR(OldCursor) && Restore the cursor
IF Choice = 1 && Quit if they say YES
CLOSE ALL && CLOSE all files
SETCOLOR(StartColor) && Set the colors back
CLS && Clear the screen
QUIT && QUIT this app
ENDIF &&
SET KEY 301 TO DOQUIT && Bind the Alt-X key to this procedure
SETCOLOR(OldColor) && Restore the color
RESTSCREEN(Srow, Scol, Srow + 6, ; &&
Scol + 33, OldScreen) && Restore the area of the screen
SETPOS(OldRow, OldCol) && Restore the cursor position
RETURN && under the box
***********************************************************************
* PROCEDURE DOSSHELL Clipper 5.0
* SET KEY procedure to SHELL to DOS
***********************************************************************
PROCEDURE DOSSHELL (ProcName, ProcLine, ProcVar) && Needed but not used
LOCAL OldCursor, OldRow, OldCol && Make some locals
OldScreen = SAVESCREEN(0, 0, MAXROW(), MAXCOL()) && Saves the entire screen
OldCursor = SETCURSOR(1) && Set the cursor. Needed if shelling from a menu
OldColor = SETCOLOR(StartColor) && Save current colors and set new colors
OldRow = ROW() && Save cursor row
OldCol = COL() && and column
CLS &&
@ 0,0 SAY "Type EXIT to return to the program" && Tell the user how to return to
? && this program
ComSpec = GETENV("COMSPEC") && Get the COMSPEC environment variable
RUN (ComSpec) && Run COMMAND.COM
SETCOLOR(OldColor) && Restore the colors
RESTSCREEN(0, 0, MAXROW(), MAXCOL(), OldScreen) && Restore the screen
SETCURSOR(OldCursor) && Restore the cursor
SETPOS(OldRow, OldCol) && Restore the cursor position
RETURN