home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMPAINT.PRG < prev    next >
Text File  |  1992-11-12  |  2KB  |  57 lines
  1. *----------------------------------------------------------------------------
  2. *
  3. *   Program Name: MEMPAINT.PRG      Copyright: EDON Corporation                                         
  4. *   Date Created: 02/23/91           Language: Clipper S'87                                             
  5. *   Time Created: 08:29:29             Author: Ed Phillips                               
  6. *    Description: Paint block with current color, for memscrn.prg
  7. *----------------------------------------------------------------------------
  8.  
  9. PROCEDURE Paint
  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 'PAINT Pending...'
  19. *   Setcolor(wcolor)
  20.    corner = Savescreen(r,c,r,c)
  21.    corner = Subs(corner,1,1)
  22.    @ r,c SAY '■'
  23.    top = r
  24.    left = c
  25.    Gotoxy(r,c)
  26.    DO WHILE .T.
  27.       StatLine('PAINT Pending...')
  28.       key = Inkey(0)
  29.       IF key < 32
  30.          IF key = 27                             && escape
  31.             Restscreen(1,0,24,79,scrnbuff)
  32.             @ r,c SAY ''
  33.             EXIT
  34.          ENDIF
  35.  
  36.          DO CtrlKey
  37.       ELSEIF key >= 271
  38.          DO AltKey
  39.       ELSE
  40.          IF Chr(key) $ 'Pp'
  41.             bottom = Row()
  42.             right = Col()
  43.             @ top,left SAY corner
  44.             DO SwapChk
  45.          
  46.             winbuff = SaveWinTxt(top,left,bottom,right)
  47.             Scroll(top,left,bottom,right,0)
  48.             SayWinTxt(top,left,bottom,right,winbuff)
  49.             changed = .t.
  50.             EXIT
  51.          ENDIF                                   && IF Chr(key) $ 'Bb'
  52.       ENDIF                                      && IF key < 32
  53.    ENDDO                                         && DO WHILE .T.
  54.    @ r,c SAY ''
  55. RETURN
  56. * EOF: MEMPAINT.PRG
  57.