home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
CLIPPER
/
NCCLIB.ZIP
/
NCCVIEW.ZIP
/
G_MOVE.PRG
< prev
next >
Wrap
Text File
|
1993-10-26
|
5KB
|
219 lines
//═══════════════════════════════════════════════════════╕
// Program .....: G_Move │
// CopyRight ...: 1993 National Computer Consultants │
// All rights are reserved. │
// Author ......: Greg Rice │
//═══════════════════════════════════════════════════════╛
#include "set.ch"
#include "inkey.ch"
#define INPUT_LENGTH 256
FUNCTION g_seek()
static search_String := ""
LOCAL v_search, ;
key, ;
v_rec := recno(), ;
v_index := indexkey(0), ;
scrn := savescreen(3,15,6,76), ;
GetList := {}, ;
cColor := SetColor(), ;
sCursor := Set(_SET_CURSOR)
PRIVATE v_type // so that I can macro
v_type := (v_index)
setcolor(popup_color())
IF type(v_type) $ 'CND'
WinBox(3,15,5,63,0,4,.t.)
END
DO CASE
CASE type(v_type) == 'C'
v_search := subs(search_string+space(INPUT_LENGTH),1,INPUT_LENGTH)
@ 4,20 say 'Seek:' get v_search pict '@KS30'
set cursor on
READ
set cursor off
v_search := trim(v_search)
search_string := v_search
CASE type(v_type) == 'N'
v_search := val(search_string)
@ 4,20 say 'Enter pattern for seek:' get v_search pict replicate('#',30)
set cursor on
READ
set cursor off
search_string := str(v_search)
CASE type(v_type) == 'D'
v_search := ctod(search_string)
@ 4,20 say 'Enter pattern for seek:' get v_search
set cursor on
READ
set cursor off
search_string := dtoc(v_search)
OTHERWISE
WinBox(3,15,5,63,0,4,.t.)
NccMesg('Index file not open',4,'center,15,63',,4)
restscreen(3,15,6,76,scrn)
setcolor(cColor)
set(_SET_CURSOR,sCursor)
RETURN NIL
EndCASE
key := lastkey()
IF key # K_ESC
seek v_search
IF eof()
NccMesg(' Not found ! ',5,'center,15,63',,4)
go v_rec
ELSE
WinObj():Refresh := .t.
END
END
setcolor(cColor)
restscreen(3,15,6,76,scrn)
Set(_SET_CURSOR,sCursor)
RETURN NIL
FUNCTION g_goto()
LOCAL key, ;
v_rec := recno(), ;
v_goto := if(eof(),0,recno()), ;
scrn := savescreen(3,25,6,55), ;
GetList := {}, ;
cColor := SetColor(), ;
sCursor := Set(_SET_CURSOR)
setcolor(popup_color())
WinBox(3,25,5,53,0,4,.t.)
@ 4,30 say 'GoTo Record #' get v_goto ;
pict replicate('#',len(ltrim(str(reccount()))))
set cursor on
READ
set cursor off
key := lastkey()
IF key # K_ESC
IF reccount() < v_goto .or. v_goto < 1
NccMesg(' Out of Scope ',5,'center,25,53',,4)
go v_rec
setcolor(cColor)
restscreen(3,25,6,55,scrn)
Set(_SET_CURSOR, sCursor)
RETURN NIL
END
go v_goto
restscreen(3,25,6,55,scrn)
WinObj(Current_Window()):Refresh := .t.
END
setcolor(cColor)
restscreen(3,25,6,55,scrn)
Set(_SET_CURSOR, sCursor)
RETURN NIL
FUNCTION g_locate()
static locate_string := ""
LOCAL key, ;
GetList := {}, ;
v_rec := recno(), ;
scrn := savescreen(4,15,7,65), ;
cColor := SetColor(), ;
sCursor := Set(_SET_CURSOR)
PRIVATE v_locate // so that I can macro
setcolor(popup_color())
WinBox(4,15,6,63,0,4,.t.)
v_locate := subs(locate_string+space(INPUT_LENGTH),1,INPUT_LENGTH)
@ 5,20 say 'Locate For :'get v_locate pict '@KS27'
set cursor on
READ
set cursor off
key := lastkey()
IF empty(v_locate) .or. key = K_ESC
restscreen(4,15,7,65,scrn)
setcolor(cColor)
set(_SET_CURSOR,sCursor)
RETURN NIL
END
v_locate := ltrim(trim(v_locate))
IF type(v_locate) <> 'L'
NccMesg(' Locate error ',6,'center,15,63',,4)
setcolor(cColor)
restscreen(4,15,7,65,scrn)
set(_SET_CURSOR,sCursor)
RETURN NIL
END
NccMesg(' Searching ',6,'center,15,63')
IF &v_locate.
skip
END
locate_string := v_locate
LOCA for &v_locate. WHILE inkey() # K_ESC
@ 6,16 say replicate('═',46)
IF eof()
NccMesg(' Out of Scope ',6,'center,15,63',,4)
go v_rec
ELSEIF lastkey() = K_ESC
NccMesg(' ABORTED ',6,'center,15,63',,4)
go v_rec
ELSE
WinObj(Current_Window()):Refresh := .t.
END
restscreen(4,15,7,65,scrn)
setcolor(cColor)
set(_SET_CURSOR,sCursor)
RETURN NIL