home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMMOVE.PRG < prev    next >
Text File  |  1992-11-12  |  5KB  |  174 lines
  1. *----------------------------------------------------------------------------
  2. *
  3. *   Program Name: MEMMOVE.PRG       Copyright: EDON Corporation                                         
  4. *   Date Created: 02/23/91           Language: Clipper S'87                                             
  5. *   Time Created: 10:06:59             Author: Ed Phillips                               
  6. *    Description: Move Block function for Memscrn.prg
  7. *----------------------------------------------------------------------------
  8.  
  9. PROCEDURE MoveBlock
  10.    PRIVATE r, c, key, wcolor, winbuff, top, left, bottom, right, corner
  11.    PRIVATE width, height, scrnbuff, wbuff
  12.  
  13.    scrnbuff = Savescreen(1,0,24,79)
  14.    r = Row()
  15.    c = Col()
  16.    wcolor = Setcolor(c_statln1)
  17.  
  18.    oldshow = showgm
  19.    IF ! oldshow
  20.       showgm = .t.
  21.       RestGets()
  22.       RestMenu()
  23.    ENDIF
  24.  
  25. *   @ 0,0 SAY 'MOVE Pending...'
  26.    Setcolor(wcolor)
  27.    corner = Savescreen(r,c,r,c)
  28.    @ r,c SAY '■'
  29.    top = r
  30.    left = c
  31.    Gotoxy(r,c)
  32.  
  33.    BEGIN SEQUENCE
  34.       DO WHILE .T.
  35.          StatLine('MOVE Pending...')
  36.          key = Inkey(0)
  37.          IF key < 32
  38.             IF key = 27                             && escape
  39.                Restscreen(1,0,24,79,scrnbuff)
  40.                @ top,left SAY ''
  41.                BREAK
  42.             ENDIF
  43.  
  44.             DO CtrlKey
  45.          ELSEIF key >= 271
  46.             DO AltKey
  47.          ELSE
  48.             IF Chr(key) $ 'Mm'
  49.  
  50.                bottom = Row()
  51.                right = Col()
  52.  
  53. *               wcolor = Setcolor(c_statln1)
  54. *               @ 0,0 SAY 'MOVE BLOCK...'
  55. *               Setcolor(wcolor)
  56.  
  57.                @ bottom,right SAY ''
  58.                Restscreen(top,left,top,left,corner)
  59.                DO SwapChk
  60.          
  61.                winbuff = Savescreen(top,left,bottom,right)  && save block
  62.                Scroll(top,left,bottom,right,0)   && clear block
  63.                wbuff = Savescreen(1,0,24,79)     && save screen, less block
  64.                Restscreen(top,left,bottom,right,winbuff)  && restore block
  65.                r = top
  66.                c = left
  67.                width = right - left
  68.                height = bottom - top
  69.                @ r,c SAY ''
  70.                DO WHILE .T.
  71.                   StatLine('MOVE BLOCK...')
  72.                   key = Inkey(0)
  73.  
  74.                   IF key < 32
  75.                      IF key = 27
  76.                         changed = .t.
  77.                         EXIT
  78.                      ENDIF                             && IF key = 27
  79.                      DO CtrlKey
  80.                   ELSEIF key >= 271
  81.                      DO AltKey
  82.                   ENDIF
  83.  
  84.                   Restscreen(1,0,24,79,wbuff)               && restore screen
  85.                   Restscreen(r,c,r+height,c+width,winbuff)  && restore block
  86.                ENDDO
  87.  
  88.                MoveGets()
  89.                MoveMenu()
  90.                EXIT
  91.             ENDIF                                   && IF Chr(key) $ 'Mm'
  92.          ENDIF                                      && IF key < 32
  93.       ENDDO                                         && DO WHILE .T.
  94.    END
  95.  
  96.    IF oldshow != showgm
  97.       showgm = oldshow
  98.       RestGets()
  99.       RestMenu()
  100.    ENDIF
  101.  
  102. RETURN
  103.  
  104. *----------------------------
  105. *         Author: Ed Phillips
  106. *   Date Created: 12/10/91
  107. *----------------------------
  108. FUNCTION MoveGets
  109.    *------------
  110.    * Update Gets
  111.    *------------
  112.    count = Chrcount(gchar,winbuff)
  113.    IF count > 0
  114.       SELECT ScrnGets
  115.       SET ORDER TO 2
  116.       dy = r - top
  117.       dx = c - left
  118.       width = width + 1
  119.       FOR i = 1 TO count
  120.          offset = Atnext(gchar,winbuff,i)
  121.          wid2 = 2 * width
  122.          x_row = (r + Int( offset / wid2 )) + dy*(-1)
  123.          x_col = (c + Int( (offset % wid2) / 2 )) + dx*(-1)
  124.  
  125.          SEEK Scr_file->Scrn_name+Str(x_row,2)+Str(x_col,2)
  126.          IF Found()
  127.             REPL G_row WITH G_row + dy, G_col WITH G_col + dx
  128.          ELSE
  129.             Sayerr('Get not found')
  130.             EXIT
  131.          ENDIF                                      && IF Found()
  132.       NEXT                                          && FOR i = 1 TO count
  133.       SET ORDER TO 1
  134.       SELECT Scr_file
  135.    ENDIF                                            && IF count > 0
  136.  
  137. RETURN(.T.)
  138.  
  139. *----------------------------
  140. *         Author: Ed Phillips
  141. *   Date Created: 12/10/91
  142. *----------------------------
  143. FUNCTION MoveMenu
  144.    *------------------
  145.    * Update Menu Picks
  146.    *------------------
  147.    count = Chrcount(mchar,winbuff)
  148.    IF count > 0
  149.       SELECT ScrnMenu
  150.  
  151.       dy = r - top
  152.       dx = c - left
  153.       width = width + 1
  154.       FOR i = 1 TO count
  155.          offset = Atnext(mchar,winbuff,i)
  156.          wid2 = 2 * width
  157.          x_row = (r + Int( offset / wid2 )) + dy*(-1)
  158.          x_col = (c + Int( (offset % wid2) / 2 )) + dx*(-1)
  159.  
  160.          SEEK Scr_file->Scrn_name+Str(x_row,2)+Str(x_col,2)
  161.          IF Found()
  162.             REPL M_row WITH M_row + dy, M_col WITH M_col + dx
  163.          ELSE
  164.             Sayerr('Menu Pick not found')
  165.             EXIT
  166.          ENDIF                                      && IF Found()
  167.       NEXT                                          && FOR i = 1 TO count
  168.  
  169.       SELECT Scr_file
  170.    ENDIF                                            && IF count > 0
  171. RETURN(.T.)
  172. * MEMMOVE.PRG
  173.  
  174.