home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
text
/
ncclib.zip
/
NCCDEMO.ZIP
/
G_INDE.PRG
< prev
next >
Wrap
Text File
|
1992-11-03
|
6KB
|
243 lines
//═══════════════════════════════════════════════════════╕
// Program .....: G_Index │
// CopyRight ...: 1992 National Computer Consultants │
// All rights are reserved. │
// Author ......: Greg Rice │
//═══════════════════════════════════════════════════════╛
#include "set.ch"
#include "inkey.ch"
#include "fileio.ch"
#define BUFFER 250
static func skipper( o, n )
local nActualSkipped := 0, nDirection := if(n>0,1,-1)
if n == 0
Return 0
endif
while nActualSkipped # n
if nDirection == 1
o:userslot++
if ! o:While()
o:userslot--
exit
endif
nActualSkipped++
else
o:userSlot--
if ! o:While()
o:userslot++
exit
endif
nActualSkipped--
endif
enddo
Return( nActualSkipped )
//───────────────────────┐
// Shut down index files │
//───────────────────────┘
Function g_indexclose()
@maxrow(),00 say padc( 'Closing Index files...',maxcol()+1,' ') color message_color()
WinIndexfiles(, {""} )
AttachIndexfiles( WinIndexfiles() )
inkey(1)
WinObj():RefreshAll()
@maxrow(),00 say space(maxcol()+1) color message_Color()
Return( NIL )
//─────────────────┐
// Open Index file │
//─────────────────┘
Function g_indexopen()
local i_file := "*.NTX" + space( BUFFER-5 ), Bar := MenuSys(), ;
scrn, xh := setcolor(), sCursor := Set( _SET_CURSOR ), GetList := {}, n
scrn := savescreen(maxrow()-5,03,maxrow()-1,36)
setColor( popup_color() )
WinBox(maxrow()-5,03,maxrow()-2,34,0,4,.t.)
@ maxrow()-4,04 say 'Open Index #' + ;
ltrim(trim(str(if( empty(winindexfiles()[1]), 1, len(winindexfiles())+1) ))) + ;
""
@ maxrow()-3,04 say 'File:' get i_file pict '@KS23'
set cursor on
READ
set(_SET_CURSOR,sCursor)
setcolor( xh )
IF lastkey() == K_ESC
restscreen(maxrow()-5,03,maxrow()-1,36,scrn)
setcolor(xh)
Return( NIL )
END
i_file := ltrim(trim(i_file))
while '?' $ i_file .or. '*' $ i_file
setcolor( popup_color() )
i_file := DirPick( i_file,,44 )
SetColor( xh )
enddo
IF lastkey() == K_ESC
restscreen(maxrow()-5,03,maxrow()-1,36,scrn)
setcolor(xh)
Return( NIL )
END
i_file := ltrim(trim(i_file))
IF file(i_file) .or. file(i_file+'.NTX')
i_file := uppe(i_file)
i_file := if( subs(i_file,-4) # '.NTX', i_file + '.NTX', i_file )
n := WinIndexFiles()
if ascan( n, i_file ) # 0
@maxrow(),0 say padc('Index file already opened... Press any key to continue',maxcol()+1,' ') ;
color message_color()
inkey(0)
@maxrow(),0 say space(maxcol()+1) ;
color message_color()
elseif ! OpenIndex( i_file )
@maxrow(),0 say padc('Invalid expression in index: Possibly the incorrect index file',maxcol()+1,' ') ;
color message_color()
inkey(0)
@maxrow(),0 say space(maxcol()+1) ;
color message_color()
else
if Empty( n[1] )
n[1] := i_file
else
aadd( n, i_file )
endif
WinIndexFiles( , n )
AttachIndexFiles( n )
WinObj():Refresh := .t.
endif
else
@maxrow(),0 say padc('File not found !!! Press any key', maxcol()+1, ' ' ) color message_color()
inkey(0)
@maxrow(),0 say space(80) color message_color()
endif
restscreen(maxrow()-5,03,maxrow()-1,36,scrn)
setcolor(xh)
Return( NIL )
//─────────────────────────────┐
// Open Requested Index File │
//─────────────────────────────┘
Function OpenIndex( x )
Return( ! ( "U" $ type( RawIndexOpen( x ) ) ) )
//───────────────────────────────────┐
// Return Index Expression From File │
//───────────────────────────────────┘
STATIC Function RawIndexOpen( x )
LOCAL ret_val , ;
handle , ;
buffer
ret_val := '!@#$%^&*()'
handle := fopen( x, FO_READ+FO_SHARED )
IF handle # -1
buffer := space(BUFFER)
fseek(handle,22,0)
IF fread(handle,@buffer,BUFFER) == BUFFER
if at(chr(0),buffer) # 0
ret_val := subs(buffer,1,at(chr(0),buffer)-1)
else
ret_val := trim(buffer)
endif
END
fclose(handle)
END
Return( ret_val )
//──────────────────────────────────────────┐
// Attach Index file list to Open Database │
//──────────────────────────────────────────┘
Function AttachIndexfiles(x)
local errorObj
BEGIN SEQUENCE
Set index to
aeval( x, { |y| DBSETINDEX( y ) } )
END SEQUENCE
Return( NIL )
//─────────────┐
// Index Order │
//─────────────┘
Function g_indexorder()
local scrn := savescreen(), nSel, x, temp, i, cColor := setColor(), xTop
xTop := int(((maxrow()/2)-4))
setColor( popup_color() )
nSel := arraydsp( WinIndexfiles(), ;
'Select file to make current controlling index', ;
'.' ;
,xTop,04,xTop+09,71, ;
0, ;
0, ;
.t., ;
, ;
{ |o| NccMesg( space(67), o:BottomRow+2,'center'), ;
NccMesg( ltrim(trim(indexkey(o:CurrentItem))),;
o:BottomRow+2, 'center,04,71' ), ;
dView_MouseReader(o,xTop,04,xTop+09,71) ;
} ;
)
if nSel # 0
x := WinIndexfiles()
temp := x[nSel]
for i = nSel to 2 step -1
x[i] := x[i-1]
next
x[1] := temp
WinIndexfiles( , x )
AttachIndexfiles( x )
Endif
restscreen(,,,,scrn)
SetColor( cColor )
WinObj():RefreshAll()
Return( NIL )