home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMSUBS.PRG < prev    next >
Text File  |  1992-11-12  |  2KB  |  67 lines
  1. *----------------------------------------------------------------------------
  2. *
  3. *   Program Name: MEMSUBS.PRG       Copyright: EDON Corporation                                         
  4. *   Date Created: 02/24/91           Language: Clipper S'87                                             
  5. *   Time Created: 07:48:50             Author: Ed Phillips                               
  6. *    Description: Save as a sub-screen
  7. *----------------------------------------------------------------------------
  8.  
  9. PROCEDURE SubScrn
  10.    PRIVATE r, c, key, wcolor, winbuff, top, left, bottom, right, corner
  11.    PRIVATE scrnbuff
  12.  
  13.    scrnbuff = Savescreen(1,0,24,79)
  14.    r = Row()
  15.    c = Col()
  16. *   wcolor = Setcolor(c_statln1)
  17.  
  18. *   @ 0,0 SAY 'SUB-SCREEN Pending...'
  19. *   Setcolor(wcolor)
  20.    corner = Savescreen(r,c,r,c)
  21.    @ r,c SAY '■'
  22.    top = r
  23.    left = c
  24.  
  25.    IF IsSub()
  26.       Gotoxy(Sb,Sr)
  27.    ELSE
  28.       Gotoxy(r,c)
  29.    ENDIF                                         && IF IsSub()
  30.  
  31.    DO WHILE .T.
  32.       StatLine('SUB-SCREEN Pending...')
  33.       key = Inkey(0)
  34.       IF key < 32
  35.          IF key = 27                             && escape
  36.             Restscreen(1,0,24,79,scrnbuff)
  37.             @ r,c SAY ''
  38.             EXIT
  39.          ENDIF
  40.  
  41.          DO CtrlKey
  42.       ELSEIF key >= 271 .AND. key != 287
  43.          DO AltKey
  44.       ELSE
  45.          IF key = 287                            && Alt-S
  46.             bottom = Row()
  47.             right = Col()
  48.  
  49.             Restscreen(top,left,top,left,corner)
  50.             DO SwapChk
  51.  
  52.             winbuff = Savescreen(top,left,bottom,right)
  53.             DO SaveScrn WITH top,left,bottom,right,winbuff
  54.  
  55.             st = 1
  56.             sl = 0
  57.             sb = 24
  58.             sr = 79
  59.             changed = .f.
  60.             EXIT
  61.          ENDIF                                   && IF Chr(key) $ 'Bb'
  62.       ENDIF                                      && IF key < 32
  63.    ENDDO                                         && DO WHILE .T.
  64.    @ r,c SAY ''
  65. RETURN
  66. * EOF: Memsubs.prg
  67.