home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / text / ncclib.zip / NCCDEMO.ZIP / G_MOVE.PRG < prev    next >
Text File  |  1992-10-21  |  5KB  |  219 lines
  1. //═══════════════════════════════════════════════════════╕
  2. //  Program .....: G_Move                                │
  3. //  CopyRight ...: 1992 National Computer Consultants    │
  4. //                 All rights are reserved.              │
  5. //  Author ......: Greg Rice                             │
  6. //═══════════════════════════════════════════════════════╛
  7.  
  8. #include "set.ch"
  9. #include "inkey.ch"
  10.  
  11. #define INPUT_LENGTH 256
  12.  
  13.  
  14. FUNCTION g_seek()
  15.  
  16.     static search_String := ""
  17.     LOCAL v_search, ;
  18.           key, ;
  19.           v_rec   := recno(), ;
  20.           v_index := indexkey(0), ;
  21.           scrn    := savescreen(3,15,6,76), ;
  22.           GetList := {}, ;
  23.           cColor  := SetColor(), ;
  24.           sCursor := Set(_SET_CURSOR)
  25.  
  26.     PRIVATE v_type     // so that I can macro
  27.  
  28.     v_type  := (v_index)
  29.  
  30.     setcolor(popup_color())
  31.     IF type(v_type) $ 'CND'
  32.       WinBox(3,15,5,63,0,4,.t.)
  33.  
  34.     END
  35.  
  36.     DO CASE
  37.       CASE type(v_type) == 'C'
  38.         v_search := subs(search_string+space(INPUT_LENGTH),1,INPUT_LENGTH)
  39.         @  4,20 say 'Seek:' get v_search pict '@KS30'
  40.  
  41.         set cursor on
  42.         READ
  43.         set cursor off
  44.  
  45.         v_search      := trim(v_search)
  46.         search_string := v_search
  47.  
  48.       CASE type(v_type) == 'N'
  49.         v_search := val(search_string)
  50.         @ 4,20 say 'Enter pattern for seek:' get v_search pict replicate('#',30)
  51.  
  52.         set cursor on
  53.         READ
  54.         set cursor off
  55.  
  56.         search_string := str(v_search)
  57.  
  58.       CASE type(v_type) == 'D'
  59.         v_search := ctod(search_string)
  60.         @ 4,20 say 'Enter pattern for seek:' get v_search
  61.  
  62.         set cursor on
  63.         READ
  64.         set cursor off
  65.  
  66.         search_string := dtoc(v_search)
  67.  
  68.       OTHERWISE
  69.         WinBox(3,15,5,63,0,4,.t.)
  70.         NccMesg('Index file not open',4,'center,15,63',,4)
  71.         restscreen(3,15,6,76,scrn)
  72.         setcolor(cColor)
  73.         set(_SET_CURSOR,sCursor)
  74.         RETURN NIL
  75.  
  76.     EndCASE
  77.  
  78.     key := lastkey()
  79.  
  80.     IF key # K_ESC
  81.       seek v_search
  82.  
  83.       IF eof()
  84.         NccMesg(' Not found ! ',5,'center,15,63',,4)
  85.         go v_rec
  86.  
  87.       ELSE
  88.         WinObj():Refresh := .t.
  89.  
  90.       END
  91.  
  92.     END
  93.     setcolor(cColor)
  94.     restscreen(3,15,6,76,scrn)
  95.     Set(_SET_CURSOR,sCursor)
  96.  
  97. RETURN NIL
  98.  
  99.  
  100.  
  101. FUNCTION g_goto()
  102.  
  103.     LOCAL key, ;
  104.           v_rec   := recno(), ;
  105.           v_goto  := if(eof(),0,recno()), ;
  106.           scrn    := savescreen(3,25,6,55), ;
  107.           GetList := {}, ;
  108.           cColor  := SetColor(), ;
  109.           sCursor := Set(_SET_CURSOR)
  110.  
  111.     setcolor(popup_color())
  112.     WinBox(3,25,5,53,0,4,.t.)
  113.     @ 4,30 say 'GoTo Record #' get v_goto ;
  114.                                pict replicate('#',len(ltrim(str(reccount()))))
  115.  
  116.     set cursor on
  117.     READ
  118.     set cursor off
  119.  
  120.     key := lastkey()
  121.  
  122.     IF key # K_ESC
  123.       IF reccount() < v_goto .or. v_goto < 1
  124.         NccMesg(' Out of Scope ',5,'center,25,53',,4)
  125.         go v_rec
  126.         setcolor(cColor)
  127.         restscreen(3,25,6,55,scrn)
  128.         Set(_SET_CURSOR, sCursor)
  129.         RETURN NIL
  130.  
  131.       END
  132.  
  133.       go v_goto
  134.       restscreen(3,25,6,55,scrn)
  135.       WinObj(Current_Window()):Refresh := .t.
  136.  
  137.     END
  138.     setcolor(cColor)
  139.     restscreen(3,25,6,55,scrn)
  140.     Set(_SET_CURSOR, sCursor)
  141.  
  142. RETURN NIL
  143.  
  144.  
  145.  
  146. FUNCTION g_locate()
  147.  
  148.     static locate_string := ""
  149.     LOCAL key, ;
  150.           GetList := {}, ;
  151.           v_rec   := recno(), ;
  152.           scrn    := savescreen(4,15,7,65), ;
  153.           cColor  := SetColor(), ;
  154.           sCursor := Set(_SET_CURSOR)
  155.  
  156.     PRIVATE v_locate    // so that I can macro
  157.  
  158.  
  159.     setcolor(popup_color())
  160.     WinBox(4,15,6,63,0,4,.t.)
  161.     v_locate := subs(locate_string+space(INPUT_LENGTH),1,INPUT_LENGTH)
  162.     @ 5,20 say 'Locate For :'get v_locate pict '@KS27'
  163.  
  164.     set cursor on
  165.     READ
  166.     set cursor off
  167.  
  168.     key := lastkey()
  169.  
  170.     IF empty(v_locate) .or. key = K_ESC
  171.       restscreen(4,15,7,65,scrn)
  172.       setcolor(cColor)
  173.       set(_SET_CURSOR,sCursor)
  174.       RETURN NIL
  175.  
  176.     END
  177.  
  178.     v_locate := ltrim(trim(v_locate))
  179.  
  180.     IF type(v_locate) <> 'L'
  181.       NccMesg(' Locate error ',6,'center,15,63',,4)
  182.       setcolor(cColor)
  183.       restscreen(4,15,7,65,scrn)
  184.       set(_SET_CURSOR,sCursor)
  185.       RETURN NIL
  186.  
  187.     END
  188.  
  189.     NccMesg(' Searching ',6,'center,15,63')
  190.     IF &v_locate.
  191.       skip
  192.  
  193.     END
  194.  
  195.     locate_string := v_locate
  196.     LOCA for &v_locate.  WHILE inkey() # K_ESC
  197.  
  198.     @ 6,16 say replicate('═',46)
  199.  
  200.     IF eof()
  201.       NccMesg(' Out of Scope ',6,'center,15,63',,4)
  202.       go v_rec
  203.  
  204.     ELSEIF lastkey() = K_ESC
  205.       NccMesg(' ABORTED ',6,'center,15,63',,4)
  206.       go v_rec
  207.  
  208.     ELSE
  209.       WinObj(Current_Window()):Refresh := .t.
  210.  
  211.     END
  212.  
  213.     restscreen(4,15,7,65,scrn)
  214.     setcolor(cColor)
  215.     set(_SET_CURSOR,sCursor)
  216.  
  217. RETURN NIL
  218.  
  219.