home *** CD-ROM | disk | FTP | other *** search
- /* tbFilt1.prg: A simple filtered browse of supplier.dbf.
-
- Uses the fact that the database is indexed on supplier->name,and
- that therefore all records to be "passed" by the filter will be
- together in a block. Cursor movement blocks goTopBlock,
- goBottomBlock and skipBlock are then used to maintain the cursor
- within that block.
-
- Copyright (C) Dave Boettcher 1993. This source code, and functional
- fragments thereof, may only be distributed unchanged and as part of
- the file POWER_TB.ARJ. See POWER_TB.TXT for full copyright details.
-
- Last change: 14 May 93 6:49 pm
- */
-
- #include "setcurs.ch"
- #include "inkey.ch"
- #include "box.ch"
-
- function main()
-
- local oBrowse
- local oColumn
- local nKey
- local lCont := .T.
- local oldColour := setcolor("w+/b")
- local oldCursor := setcursor(SC_NONE)
-
- local cScope := "Nantucket UK Ltd"
- local bScope := {|| upper(alltrim(supplier->name)) == upper(cScope) }
-
- use supplier new
- index on supplier->name to supplier
- goTop(cScope)
-
- clear screen
- @ 0, 0, 24, 79 box B_DOUBLE
-
- oBrowse := tbrowsedb(1, 1, 23, 78)
- oBrowse:headsep := "─┬─"
- oBrowse:colsep := " │ "
- oBrowse:goTopBlock := {|| goTop(cScope) }
- oBrowse:goBottomBlock := {|| goBottom(cScope) }
- oBrowse:skipBlock := {|x| Skipper(x, bScope) }
-
- oColumn := TBColumnNew("Name", {|| supplier->name})
- oColumn:width := 20
- oColumn:footsep := "─┴─"
- oBrowse:AddColumn(oColumn)
-
- oColumn := TBColumnNew("Street", {|| supplier->street})
- oColumn:width := 20
- oColumn:footsep := "─┴─"
- oBrowse:AddColumn(oColumn)
-
- oColumn := TBColumnNew("Town", {|| supplier->town})
- oColumn:width := 20
- oColumn:footsep := "─┴─"
- oBrowse:AddColumn(oColumn)
-
- oColumn := TBColumnNew("County", {|| supplier->county})
- oColumn:width := 20
- oColumn:footsep := "─┴─"
- oBrowse:AddColumn(oColumn)
-
- oColumn := TBColumnNew("Postcode", {|| supplier->product})
- oColumn:width := 7
- oColumn:footsep := "─┴─"
- oBrowse:AddColumn(oColumn)
-
- oColumn := TBColumnNew("Product", {|| supplier->product})
- oColumn:width := 250
- oColumn:footsep := "─┴─"
- oBrowse:AddColumn(oColumn)
-
- do while lCont
-
- do while .not. oBrowse:stable .AND. (nKey := InKey()) == 0
- oBrowse:Stabilize()
- enddo
-
- if oBrowse:stable
- if (oBrowse:hitTop .OR. oBrowse:hitBottom)
- Tone(125,0)
- endif
- nKey := InKey(0)
- endif
-
- Do Case
- Case nKey == K_DOWN ; oBrowse:Down()
- Case nKey == K_UP ; oBrowse:Up()
- Case nKey == K_LEFT ; oBrowse:Left()
- Case nKey == K_RIGHT ; oBrowse:Right()
- Case nKey == K_PGDN ; oBrowse:PageDown()
- Case nKey == K_PGUP ; oBrowse:PageUp()
- Case nKey == K_CTRL_PGUP ; oBrowse:GoTop()
- Case nKey == K_CTRL_PGDN ; oBrowse:GoBottom()
- Case nKey == K_ESC ; lCont := .F.
- endcase
-
- enddo
-
- setcolor(oldColour)
- setcursor(oldCursor)
- clear screen
-
- return nil
-
-
- function gotop(cScope)
-
- seek cScope
-
- return nil
-
-
- function gobottom(cScope)
-
- local searcher
-
- searcher := substr(cScope,1,len(cScope)-1)+chr(asc(right(cScope,1))+1)
- dbseek(searcher, .t.)
- skip -1
-
- return nil
-
-
- function skipper( nRequested, bscope )
-
- local nAllowed := 0
-
- do case
-
- case nRequested == 0
- skip 0
-
- case nRequested > 0
- do while eval(bScope) .and. !eof() .and. nAllowed < nRequested
- skip 1
- nAllowed++
- enddo
-
- if !eval(bScope) .or. eof()
- nAllowed--
- skip -1
- endif
-
- case nRequested < 0
- do while eval(bScope) .and. !bof() .and. nAllowed > nRequested
- skip -1
- nAllowed--
- enddo
-
- if !eval(bScope)
- nAllowed++
- skip 1
- elseif bof()
- nAllowed++
- endif
-
- endcase
-
- return (nAllowed)
-