home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / utility / v11n06.zip / TRYALT.PRG < prev   
Text File  |  1991-10-06  |  5KB  |  82 lines
  1. ***********************************************************************
  2. * TRYALT.PRG                                             Clipper 5.0
  3. * Test program to try the DOSSHELL and DOQUIT SET KEY procedures
  4. ***********************************************************************
  5. SET PROCEDURE TO TRYALT
  6. StartColor = SETCOLOR()       && Save the existing colors
  7. SET KEY 301 TO DOQUIT         && Bind the Alt-X key to the DOQUIT procedure
  8. SET KEY 274 TO DOSSHELL       && Bind the Alt-E key to the DOSSHELL procedure
  9. CLS
  10. * SETCOLOR("W+/R")
  11. pcmag = "PC Magazine Databases PC Magazine Databases PC Magazine Databases PC Magazine "
  12. single = CHR(218)+CHR(196)+CHR(191)+CHR(179)+CHR(217)+CHR(196)+CHR(192)+CHR(179)
  13. @ 0,0,24,79 BOX single+"x"
  14. i = 1
  15. DO WHILE i <= 23
  16.    @ i, 1 SAY pcmag
  17.    i = i + 1
  18. ENDDO
  19. * SETCOLOR(StartColor)
  20. WAIT ""                           && Hit Alt-X or Alt-E while waiting
  21. RETURN
  22.  
  23. ***********************************************************************
  24. * PROCEDURE DOQUIT                                         Clipper 5.0
  25. * SET KEY procedure to QUIT an application
  26. ***********************************************************************
  27. PROCEDURE DOQUIT (ProcName, ProcLine, ProcVar)    && Needed but not used
  28. LOCAL OldRow, OldCol, Scol, Srow, OldCursor       && Make some locals
  29. OldRow = ROW()                                    && Save cursor row
  30. OldCol = COL()                                    &&   and column
  31. Scol = (MAXCOL() - 33) / 2                        && Calculate upper left corner based on
  32. Srow = (MAXROW() - 6) / 2                         &&    MAXCOL and MAXROW
  33. OldScreen = ;                                     && Save the area of the screen
  34.    SAVESCREEN(Srow, Scol, Srow + 6, Scol + 33)    &&    under the box
  35. OldColor = SETCOLOR("GR+/B")                      && Save the current colors and set new ones
  36. OldCursor = SETCURSOR(0)                          && Save the current cursor
  37. @ Srow, Scol CLEAR TO Srow + 6, Scol + 33         && Clear the box
  38. @ Srow, Scol TO Srow + 6, Scol + 33 DOUBLE        && Draw the box
  39. @ Srow + 2, Scol + 2  SAY ;                       && Place message in box
  40.       "Are you sure you want to quit?"            &&
  41. @ Srow + 4, Scol + 9  PROMPT "  Yes  "            && Place the prompts
  42. @ Srow + 4, Scol + 19 PROMPT "   No  "            &&
  43. SET KEY 301 TO                                    && Unbind Alt-X temporarily
  44. TONE(1500,1)                                      && Sound two tones
  45. TONE(2000,1)                                      &&
  46. MENU TO Choice                                    && Get Yes or No
  47. SETCURSOR(OldCursor)                              && Restore the cursor
  48. IF Choice = 1                                     && Quit if they say YES
  49.    CLOSE ALL                                      && CLOSE all files
  50.    SETCOLOR(StartColor)                           && Set the colors back
  51.    CLS                                            && Clear the screen
  52.    QUIT                                           && QUIT this app
  53. ENDIF                                             &&
  54. SET KEY 301 TO DOQUIT                             && Bind the Alt-X key to this procedure
  55. SETCOLOR(OldColor)                                && Restore the color
  56. RESTSCREEN(Srow, Scol, Srow + 6, ;                &&
  57.            Scol + 33, OldScreen)                  && Restore the area of the screen
  58. SETPOS(OldRow, OldCol)                            && Restore the cursor position
  59. RETURN                                            &&     under the box
  60.  
  61. ***********************************************************************
  62. * PROCEDURE DOSSHELL                                         Clipper 5.0
  63. * SET KEY procedure to SHELL to DOS
  64. ***********************************************************************
  65. PROCEDURE DOSSHELL (ProcName, ProcLine, ProcVar)  && Needed but not used
  66. LOCAL OldCursor, OldRow, OldCol                   && Make some locals
  67. OldScreen = SAVESCREEN(0, 0, MAXROW(), MAXCOL())  && Saves the entire screen
  68. OldCursor = SETCURSOR(1)                          && Set the cursor. Needed if shelling from a menu
  69. OldColor = SETCOLOR(StartColor)                   && Save current colors and set new colors
  70. OldRow = ROW()                                    && Save cursor row
  71. OldCol = COL()                                    &&   and column
  72. CLS                                               &&
  73. @ 0,0 SAY "Type EXIT to return to the program"    && Tell the user how to return to
  74. ?                                                 &&   this program
  75. ComSpec = GETENV("COMSPEC")                       && Get the COMSPEC environment variable
  76. RUN (ComSpec)                                     && Run COMMAND.COM
  77. SETCOLOR(OldColor)                                && Restore the colors
  78. RESTSCREEN(0, 0, MAXROW(), MAXCOL(), OldScreen)   && Restore the screen
  79. SETCURSOR(OldCursor)                              && Restore the cursor
  80. SETPOS(OldRow, OldCol)                            && Restore the cursor position
  81. RETURN
  82.