home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMCTRL.PRG < prev    next >
Text File  |  1992-11-12  |  6KB  |  199 lines
  1. *.............................................................................
  2. *
  3. *   Program Name: MEMCTRL.PRG       Copyright: EDON Corporation
  4. *   Date Created: 02/22/91           Language: Clipper S'87
  5. *   Time Created: 13:07:57             Author: Ed Phillips
  6. *           Desc: Control Key Handler for Memscrn.prg
  7. *.............................................................................
  8.  
  9. PROCEDURE CtrlKey
  10.    PRIVATE oldcolor, char, tchar, scrnbuff, width, height
  11.  
  12.    DO CASE
  13.       CASE key = -15                             && Shift-F6
  14.          DO CenterText
  15.  
  16.       CASE key = -17                             && Shift-F8 paste scrap
  17.          IF (scr - scl + 1) * (scb - sct + 1) * 2 = Len(scrap)
  18.             scrnbuff = Savescreen(1,0,24,79)
  19.             r = sct
  20.             c = scl
  21.             width = scr - scl
  22.             height = scb - sct
  23.  
  24.             wcolor = Setcolor(c_statln1)
  25.             @ 0,0 SAY 'Position Block, <Esc> when done...'
  26.             Setcolor(wcolor)
  27.  
  28.             @ r,c SAY ''
  29.             Restscreen(r,c,r+height,c+width,scrap)
  30.             DO WHILE .T.
  31.                key = Inkey(0)
  32.                IF key = 27
  33.                   changed = .t.
  34.                   EXIT
  35.                ENDIF                             && IF key = 27
  36.                IF key != -17
  37.                   DO CtrlKey
  38.                ENDIF                          && IF key != -17
  39.  
  40.                Restscreen(1,0,24,79,scrnbuff)
  41.                Restscreen(r,c,r+height,c+width,scrap)
  42.             ENDDO
  43.          ENDIF
  44.  
  45.       CASE key = -9                              && <F10> display gets/menu
  46.          showgm = If( showgm, .f., .t.)
  47.          Restscreen(St,Sl,Sb,Sr,Screen)
  48.          RestGets()
  49.          RestMenu()
  50.  
  51.       CASE key = -8                              && <F9> box style
  52.          single = If( single, .f., .t.)
  53.  
  54.       CASE key = -7                              && <F8> copy block to buffer
  55.          IF is_scrap .AND. Type('winbuff') != 'U'
  56.             scrap = winbuff
  57.             sct = top
  58.             scl = left
  59.             scb = bottom
  60.             scr = right
  61.             BREAK
  62.          ENDIF                                   && IF is_scrap
  63.          is_scrap = .f.
  64.  
  65.       CASE key = 1                               && home
  66.          r = 1
  67.          c = 0
  68.          @ r,c SAY ''
  69.  
  70.       CASE key = 2                               && Ctrl-rtarrow
  71.          @ Row(),79 SAY ''
  72.          c = 79
  73.  
  74.       CASE key = 3                               && page down
  75.          r = 24
  76.          c = 79
  77.          @ r,c SAY ''
  78.  
  79.       CASE key = 4                               && rtarrow
  80.          IF Col() < 79
  81.             @ Row(),Col()+1 SAY ''
  82.             r = Row()
  83.             c = Col()
  84.          ENDIF
  85.  
  86.       CASE key = 5                               && uparrow
  87.          IF Row() > 1
  88.             @ Row()-1,Col() SAY ''
  89.             r = Row()
  90.             c = Col()
  91.          ENDIF
  92.  
  93.       CASE key = 6                               && end
  94.          r = 24
  95.          c = 0
  96.          @ r,c SAY ''
  97.  
  98.       CASE key = 7                               && del GET
  99.  
  100.          oldshow = showgm
  101.          IF ! oldshow
  102.             showgm = .t.
  103.             RestGets()
  104.             RestMenu()
  105.          ENDIF
  106.  
  107.          char = Savescreen(r,c,r,c)
  108.          tchar = Chr(Bin2w(Subs(char,1,1)))
  109.  
  110.          IF tchar = gchar
  111.  
  112.             *-----------
  113.             * Delete GET
  114.             *-----------
  115.             SELECT ScrnGets
  116.             SET ORDER TO 2
  117.             SEEK Scr_file->Scrn_name+Str(r,2)+Str(c,2)
  118.             IF Found()
  119.                oldcolor = Setcolor()
  120.                DELETE
  121.                DO ScrnAttrib
  122.                @ r,c SAY ' '
  123.                Alert()
  124.                Setcolor(oldcolor)
  125.             ENDIF                                && IF Found()
  126.             SET ORDER TO 1
  127.             SELECT Scr_file
  128.  
  129.          ELSEIF tchar = mchar
  130.  
  131.             *-----------------
  132.             * Delete Menu Pick
  133.             *-----------------
  134.             SELECT ScrnMenu
  135.  
  136.             SEEK Scr_file->Scrn_name+Str(r,2)+Str(c,2)
  137.             IF Found()
  138.                oldcolor = Setcolor()
  139.                DELETE
  140.                DO ScrnAttrib
  141.                @ r,c SAY ' '
  142.                Alert()
  143.                Setcolor(oldcolor)
  144.             ENDIF                                && IF Found()
  145.  
  146.             SELECT Scr_file
  147.          ENDIF                                   && IF tchar = gchar
  148.  
  149.          IF oldshow != showgm
  150.             showgm = oldshow
  151.             RestGets()
  152.             RestMenu()
  153.          ENDIF
  154.  
  155.       CASE key = 8                               && backspace
  156.          IF c > 0
  157.             c = c - 1
  158.             @ r,c SAY Space(1)
  159.             Gotoxy(r,c)
  160.          ENDIF                                   && IF c > 0
  161.  
  162.       CASE key = 9                               && tab
  163.          c = If(c+5 > 79, 79, c+5)
  164.          @ r,c SAY ''
  165.  
  166.       CASE key = 18                              && page up
  167.          r = 1
  168.          c = 79
  169.          @ r,c SAY ''
  170.  
  171.       CASE key = 19                              && ltarrow
  172.          IF Col() > 0
  173.             @ Row(),Col()-1 SAY ''
  174.             r = Row()
  175.             c = Col()
  176.          ENDIF
  177.  
  178.       CASE key = 23                              && Ctrl-end
  179.          @ 24,Col() SAY ''
  180.          r = 24
  181.  
  182.       CASE key = 24                              && down arrow
  183.          IF Row() < 24
  184.             @ Row()+1,Col() SAY ''
  185.             r = Row()
  186.             c = Col()
  187.          ENDIF
  188.       CASE key = 26                              && Ctrl-ltarrow
  189.          @ Row(),0 SAY ''
  190.          c = 0
  191.  
  192.       CASE key = 29                              && Ctrl-home
  193.          @ 1,Col() SAY ''
  194.          r = 1
  195.  
  196.    ENDCASE
  197. RETURN
  198. * EOF: MEMCTRL.PRG
  199.