home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / text / ncclib.zip / NCCDEMO.ZIP / G_INDE.PRG < prev    next >
Text File  |  1992-11-03  |  6KB  |  243 lines
  1. //═══════════════════════════════════════════════════════╕
  2. //  Program .....: G_Index                               │
  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. #include "fileio.ch"
  11.  
  12.  
  13. #define BUFFER   250
  14.  
  15.  
  16. static func skipper( o, n )
  17.  
  18.    local nActualSkipped := 0, nDirection := if(n>0,1,-1)
  19.  
  20.    if n == 0
  21.      Return 0
  22.    endif
  23.  
  24.    while nActualSkipped # n
  25.      if nDirection == 1
  26.        o:userslot++
  27.        if ! o:While()
  28.          o:userslot--
  29.          exit
  30.        endif
  31.        nActualSkipped++
  32.      else
  33.        o:userSlot--
  34.        if ! o:While()
  35.          o:userslot++
  36.          exit
  37.        endif
  38.        nActualSkipped--
  39.      endif
  40.    enddo
  41.  
  42. Return( nActualSkipped )
  43.  
  44.  
  45.  
  46. //───────────────────────┐
  47. // Shut down index files │
  48. //───────────────────────┘
  49. Function g_indexclose()
  50.  
  51.    @maxrow(),00 say padc( 'Closing Index files...',maxcol()+1,' ') color message_color()
  52.    WinIndexfiles(, {""} )
  53.    AttachIndexfiles( WinIndexfiles() )
  54.    inkey(1)
  55.    WinObj():RefreshAll()
  56.    @maxrow(),00 say space(maxcol()+1) color message_Color()
  57.  
  58. Return( NIL )
  59.  
  60. //─────────────────┐
  61. // Open Index file │
  62. //─────────────────┘
  63. Function g_indexopen()
  64.  
  65.     local i_file := "*.NTX" + space( BUFFER-5 ), Bar := MenuSys(), ;
  66.           scrn, xh := setcolor(), sCursor := Set( _SET_CURSOR ), GetList := {}, n
  67.  
  68.  
  69.     scrn   := savescreen(maxrow()-5,03,maxrow()-1,36)
  70.     setColor( popup_color() )
  71.     WinBox(maxrow()-5,03,maxrow()-2,34,0,4,.t.)
  72.     @ maxrow()-4,04 say 'Open Index #' + ;
  73.       ltrim(trim(str(if( empty(winindexfiles()[1]), 1, len(winindexfiles())+1) ))) + ;
  74.       ""
  75.     @ maxrow()-3,04 say 'File:' get i_file pict '@KS23'
  76.  
  77.     set cursor on
  78.     READ
  79.     set(_SET_CURSOR,sCursor)
  80.     setcolor( xh )
  81.  
  82.     IF lastkey() == K_ESC
  83.       restscreen(maxrow()-5,03,maxrow()-1,36,scrn)
  84.       setcolor(xh)
  85.       Return( NIL )
  86.  
  87.     END
  88.  
  89.     i_file := ltrim(trim(i_file))
  90.  
  91.     while  '?' $ i_file .or. '*' $ i_file
  92.       setcolor( popup_color() )
  93.       i_file := DirPick( i_file,,44 )
  94.       SetColor( xh )
  95.     enddo
  96.  
  97.     IF lastkey() == K_ESC
  98.       restscreen(maxrow()-5,03,maxrow()-1,36,scrn)
  99.       setcolor(xh)
  100.       Return( NIL )
  101.  
  102.     END
  103.  
  104.     i_file := ltrim(trim(i_file))
  105.  
  106.     IF file(i_file) .or. file(i_file+'.NTX')
  107.       i_file := uppe(i_file)
  108.       i_file := if( subs(i_file,-4) # '.NTX', i_file + '.NTX', i_file )
  109.       n := WinIndexFiles()
  110.       if ascan( n, i_file ) # 0
  111.         @maxrow(),0 say padc('Index file already opened... Press any key to continue',maxcol()+1,' ') ;
  112.                     color message_color()
  113.         inkey(0)
  114.         @maxrow(),0 say space(maxcol()+1) ;
  115.                     color message_color()
  116.       elseif ! OpenIndex( i_file )
  117.         @maxrow(),0 say padc('Invalid expression in index:  Possibly the incorrect index file',maxcol()+1,' ') ;
  118.                     color message_color()
  119.         inkey(0)
  120.         @maxrow(),0 say space(maxcol()+1) ;
  121.                     color message_color()
  122.       else
  123.         if Empty( n[1] )
  124.           n[1] := i_file
  125.         else
  126.           aadd( n, i_file )
  127.         endif
  128.         WinIndexFiles( , n )
  129.         AttachIndexFiles( n )
  130.         WinObj():Refresh := .t.
  131.       endif
  132.     else
  133.       @maxrow(),0 say padc('File not found !!!  Press any key', maxcol()+1, ' ' ) color message_color()
  134.       inkey(0)
  135.       @maxrow(),0 say space(80) color message_color()
  136.     endif
  137.  
  138.     restscreen(maxrow()-5,03,maxrow()-1,36,scrn)
  139.     setcolor(xh)
  140.  
  141. Return( NIL )
  142.  
  143.  
  144.  
  145. //─────────────────────────────┐
  146. //  Open Requested Index File  │
  147. //─────────────────────────────┘
  148. Function OpenIndex( x )
  149.  
  150. Return( ! ( "U" $ type( RawIndexOpen( x ) ) ) )
  151.  
  152.  
  153. //───────────────────────────────────┐
  154. // Return Index Expression From File │
  155. //───────────────────────────────────┘
  156. STATIC Function RawIndexOpen( x )
  157.  
  158.     LOCAL ret_val      , ;
  159.           handle       , ;
  160.           buffer
  161.  
  162.  
  163.     ret_val := '!@#$%^&*()'
  164.     handle  := fopen( x, FO_READ+FO_SHARED )
  165.  
  166.     IF handle # -1
  167.       buffer := space(BUFFER)
  168.       fseek(handle,22,0)
  169.  
  170.       IF fread(handle,@buffer,BUFFER) == BUFFER
  171.         if at(chr(0),buffer) # 0
  172.           ret_val := subs(buffer,1,at(chr(0),buffer)-1)
  173.         else
  174.           ret_val := trim(buffer)
  175.         endif
  176.  
  177.       END
  178.  
  179.       fclose(handle)
  180.  
  181.     END
  182.  
  183. Return( ret_val )
  184.  
  185.  
  186. //──────────────────────────────────────────┐
  187. //  Attach Index file list to Open Database │
  188. //──────────────────────────────────────────┘
  189. Function AttachIndexfiles(x)
  190.  
  191.     local errorObj
  192.  
  193.  
  194.     BEGIN SEQUENCE
  195.  
  196.       Set index to
  197.       aeval( x, { |y| DBSETINDEX( y ) } )
  198.  
  199.     END SEQUENCE
  200.  
  201. Return( NIL )
  202.  
  203.  
  204. //─────────────┐
  205. // Index Order │
  206. //─────────────┘
  207. Function g_indexorder()
  208.  
  209.     local scrn := savescreen(), nSel, x, temp, i, cColor := setColor(), xTop
  210.  
  211.  
  212.     xTop := int(((maxrow()/2)-4))
  213.     setColor( popup_color() )
  214.     nSel := arraydsp( WinIndexfiles(), ;
  215.                      'Select file to make current controlling index', ;
  216.                      '.' ;
  217.                      ,xTop,04,xTop+09,71, ;
  218.                      0, ;
  219.                      0, ;
  220.                      .t., ;
  221.                      , ;
  222.                      { |o| NccMesg( space(67), o:BottomRow+2,'center'), ;
  223.                            NccMesg( ltrim(trim(indexkey(o:CurrentItem))),;
  224.                                  o:BottomRow+2, 'center,04,71' ), ;
  225.                            dView_MouseReader(o,xTop,04,xTop+09,71) ;
  226.                      } ;
  227.                     )
  228.     if nSel # 0
  229.       x    := WinIndexfiles()
  230.       temp := x[nSel]
  231.       for i = nSel to 2 step -1
  232.         x[i] := x[i-1]
  233.       next
  234.       x[1] := temp
  235.       WinIndexfiles( , x )
  236.       AttachIndexfiles( x )
  237.     Endif
  238.     restscreen(,,,,scrn)
  239.     SetColor( cColor )
  240.     WinObj():RefreshAll()
  241.  
  242. Return( NIL )
  243.