home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMCOPY.PRG < prev    next >
Text File  |  1992-11-12  |  3KB  |  83 lines
  1. *----------------------------------------------------------------------------
  2. *
  3. *   Program Name: MEMCOPY.PRG       Copyright: EDON Corporation                                         
  4. *   Date Created: 02/23/91           Language: Clipper S'87                                             
  5. *   Time Created: 08:40:21             Author: Ed Phillips                               
  6. *    Description: Replicate a block, for memscrn.prg
  7. *----------------------------------------------------------------------------
  8.  
  9. PROCEDURE CopyBlock
  10.    PRIVATE r, c, key, wcolor, winbuff, top, left, bottom, right, corner
  11.    PRIVATE width, height, 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 'COPY Pending...'
  19. *   Setcolor(wcolor)
  20.    corner = Savescreen(r,c,r,c)
  21.    @ r,c SAY '■'
  22.    top = r
  23.    left = c
  24.    Gotoxy(r,c)
  25.    BEGIN SEQUENCE
  26.       DO WHILE .T.
  27.          StatLine('COPY Pending...')
  28.          key = Inkey(0)
  29.          IF key < 32
  30.             IF key = 27                             && escape
  31.                Restscreen(top,left,top,left,corner)
  32.                BREAK
  33.             ENDIF
  34.  
  35.             DO CtrlKey
  36.          ELSEIF key >= 271
  37.             DO AltKey
  38.          ELSE
  39.             IF Chr(key) $ 'Cc'
  40.  
  41.                bottom = Row()
  42.                right = Col()
  43.  
  44. *               wcolor = Setcolor(c_statln1)
  45. *               @ 0,0 SAY 'COPY BLOCK...'
  46. *               Setcolor(wcolor)
  47.  
  48.                @ bottom,right SAY ''
  49.                Restscreen(top,left,top,left,corner)
  50.                DO SwapChk
  51.          
  52.                winbuff = Savescreen(top,left,bottom,right)
  53.                is_scrap = .t.
  54.  
  55.                r = top
  56.                c = left
  57.                width = right - left
  58.                height = bottom - top
  59.                @ r,c SAY ''
  60.                DO WHILE .T.
  61.                   StatLine('COPY BLOCK...')
  62.                   key = Inkey(0)
  63.                   IF key = 27
  64.                      changed = .t.
  65.                      BREAK
  66.                   ENDIF                             && IF key = 27
  67.                   DO CtrlKey
  68.  
  69.                   IF Chr(key) $ 'Cc'
  70.                      scrnbuff = Savescreen(1,0,24,79)
  71.                   ENDIF                          && IF Chr(key) $ 'Cc'
  72.  
  73.                   Restscreen(1,0,24,79,scrnbuff)
  74.                   Restscreen(r,c,r+height,c+width,winbuff)  && copied block
  75.                ENDDO                                && DO WHILE .T.
  76.  
  77.             ENDIF                                   && IF Chr(key) $ 'Bb'
  78.          ENDIF                                      && IF key < 32
  79.       ENDDO                                         && DO WHILE .T.
  80.    END
  81. RETURN
  82. * MEMCOPY.PRG
  83.