FiveTech Support Forums

#include "FiveWin.ch"
#include "xbrowse.ch"
#include "fileio.ch"
#include "hbcompat.ch"

REQUEST DBFCDX

static hFile

//----------------------------------------------------------------------------//

function Main()

   local oWnd, oBrw
   local cTextFile   := "c:\TMP\REPORT\LIST21.LST"
   local cIndexDbf
   local c, k,lFont:= .t.

   cIndexDbf      := cFileSetExt( cTextFile, "dbf" )
   if ! File( cIndexDbf )
      MsgRun( "Creating Index", "PLEASE WAIT", { || CreateIndexDbf( cTextFile, cIndexDbf ) } )
   endif

   hFile    := FOpen( cTextFile )
   DEFINE FONT oBig  NAME "Courier New" SIZE  0,-13; DEFINE FONT oFont NAME "Courier New" SIZE 0,-11
   DEFINE FONT oFont1 NAME "Arial" SIZE 4, -8.4
   USE ( cIndexDbf ) NEW ALIAS TDX SHARED READONLY VIA "DBFCDX"
    nRecLen:=FIELD->RECLEN
   DEFINE WINDOW oWnd
   @ 0,0 XBROWSE oBrw OF oWnd DATASOURCE "TDX" ;
      FIELDS RecNo(), ReadLine(1),If(nRecLen>160,ReadLine(2),"" ); //Add
      HEADERS "No", "Text" ;
      PICTURES "9,999,999" ;
      NOBORDER

   WITH OBJECT oBrw
      :nStretchCol   := 2
      :lVThumbTrack  := .t.
       :nMarqueeStyle   := MARQSTYLE_HIGHLWIN7
      :nFreeze:=1
        :nColSel:=2
      :CreateFromCode()
   END
       oBrw:aCols[1]:nWidth:=35
         oBrw:aCols[1]:oDataFont:=oFont1
         oBrw:aCols[1]:nDataStrAlign:=AL_RIGHT
       
       oBrw:aCols[2]:oDataFont:= { || iif( lFont,oFont,oBig) }
       If nRecLen>160
           oBrw:aCols[3]:oDataFont:= { || iif( lFont,oFont,oBig) }
          Endif

   oWnd:oClient   := oBrw
   ACTIVATE WINDOW oWnd MAXIMIZED
   CLOSE TDX
   FClose( hFile )

return 0

//----------------------------------------------------------------------------//

static function ReadLine(nC)

   local nRead, cLine

   if FIELD->RECLEN == 0
      return ""
   endif

   FSeek( hFile, FIELD->OFFSET, FS_SET )
   cLine    := Space( FIELD->RECLEN )
   nRead    := FRead( hFile, @cLine, FIELD->RECLEN )
   If nC=2
       cLine:=Subs(cLine,47,200) //add
   Endif

return Left( cLine, nRead )

//----------------------------------------------------------------------------//

static function CreateIndexDbf( cFile, cDbf )

   local hFile
   local nBufSize := 32000
   local cBuf     := Space( nBufSize )
   local nRead, nPrevRead  := 0
   local nAt, nLen

   DbCreate( cDbf, {{ "OFFSET", 'N', 12, 0 }, { "RECLEN", 'N', 4, 0 }}, "DBFCDX", .t., "TDX" )
   DbAppend()
   FIELD->OFFSET  := 0

   hFile    := FOpen( cFile )
   do while .t.
      nRead    := FRead( hFile, @cBuf, nBufSize )
      nAt      := 1
      do while ( nAt := At( CRLF, cBuf, nAt, nRead ) ) > 0
         nLen  := nAt + nPrevRead - FIELD->OFFSET - 1
         FIELD->RECLEN  := nLen
         DBAPPEND()
         nAt++
         FIELD->OFFSET  := nAt + nPrevRead
         nAt++
      enddo
      if nRead < nBufSize
         exit
      else
         nPrevRead   += nBufSize
      endif
   enddo
   FIELD->RECLEN  := nRead + nPrevRead - FIELD->OFFSET
   CLOSE TDX

return nil

Static FUNCTION VerPag()
      nPagIni=1
    
      For vI:=1 To oBrw:nArrayAt
         IF At(chr(12),aTexto[ vI ][2])>0
             nPagIni++
         Endi
      Next vI     
      If(nPagIni>nPagTot,nPagIni--, )
      oSay:Refresh()
Return Nil

Static Funct BuscaCad(vQue)
       oBrw:Skip()
         For vI:= oBrw:nArrayAt To nRec
          IF At(AllTrim(vQue),UPPER(aTexto[ oBrw:nArrayAt ][2]))>0
             Exit          
          Endif
          oBrw:Skip()
          
          If vI=oBrw:nArrayAt
             oBrw:GoTop()
             MsgInfo("No existe cadena indicada")
             Exit      
              Endif
        Next vI
       (oBrw:Refresh(),oBrw:SetFocus())
Retu Nil