Shareware Supreme Volume 6 #1/swsii.zip/swsii/450/S9305.ZIP/SPENCE.ZIP/DBTEST.PRG

Text File | 1993-03-02 | 5.2 KB | 205 lines

// DbTest.prg
//
// Tbrowse code demonstrating how to use TBrowseFW().

// You can use this code with either the Class(y), SuperClass,
// or simulated versions of the filtered database browser sub-class.
// To use the simulated version, you must include the header
// file which includes the #translates to convert the simulated
// instance variable references into elements of the cargo array.
// Do this by compling this program as follows:
//
//   Clipper DbTest /a /m /n /w /dSIMUL

#include "Inkey.ch"

#define INCLAST(c) Substr(c, 1, Len(c) - 1) + ;
                   Chr( Asc( Substr( c, Len(c) ) ) + 1)

#define MOVE_UP_KEY(nKey) chr(nKey) $ ;
         (chr(K_UP) + chr(K_PGUP) + chr(K_CTRL_PGUP))

// NOTE - include header file containing #translates if simulated
// version.

#ifdef SIMUL
  #include "Dbrowser.ch"
#endif

FUNCTION Test1

FIELD Lname, Fname, AcBal IN TbDbf1

LOCAL oTbr
LOCAL bWhile, bFor, bFirst, bLast
LOCAL cSearcher
LOCAL GetList := {}

  USE Tbdbf1 NEW
  IF !file("Tbdbf1.ntx")
    INDEX ON upper(Lname + Fname) TO Tbdbf1
  ELSE
    SET INDEX TO Tbdbf1
  ENDIF

  // Browse entire database
  bFirst := {|| DbGoTop()    }
  bLast  := {|| DbGoBottom() }
  bFor   := {|| .T. }
  bWhile := {|| .T. }
  oTbr   := TBrowseFW(bWhile, bFor, bFirst, bLast)
  MyBrowse(oTbr)


  // Browse records WHILE upper(Lname) = cSearcher
  CLEAR SCREEN
  cSearcher := Space(Len(Lname))
  @ 10, 10 SAY "Enter searcher" GET cSearcher
  READ
  cSearcher := Trim(Upper(cSearcher))

  bWhile   := {|| Upper(Lname) = cSearcher }
  bFor     := {|| .T. }
  bFirst   := {|| DbSeek(cSearcher) }
  bLast    := {|| DbSeek(INCLAST(cSearcher), .T.), DbSkip(-1) }
  oTbr     := TBrowseFW(bWhile, bFor, bFirst, bLast)
  MyBrowse(oTbr)


  // Browse records WHILE upper(Lname) >=  "S" .AND.
  //                      upper(Lname) <= "T"
  //                FOR   AcBal >= 0
  bWhile   := {|| upper(Lname) >=  "S" .AND. ;
                  upper(Lname) <= "T" }
  bFor     := {|| AcBal >= 0 }
  bFirst   := {|| DbSeek("S") }
  bLast    := {|| DbSeek("U", .T.), DbSkip(-1) }
  oTbr     := TBrowseFW(bWhile, bFor, bFirst, bLast)
  MyBrowse(oTbr)


  // Browse records FOR upper(Lname) = "S" .OR. ;
  //                    upper(Lname) = "T"
  bWhile   := {|| .T. }
  bFor     := {|| Upper(Lname) = "S" .OR. ;
                  Upper(Lname) = "T" }
  bFirst   := {|| DbGoTop() }
  bLast    := {|| DbGoBottom() }
  oTbr := TBrowseFW(bWhile, bFor, bFirst, bLast)
  MyBrowse(oTbr)

  CLEAR SCREEN

RETURN NIL


FUNCTION MyBrowse(oTbr)

LOCAL lExitRequested := .F.
LOCAL nKey

  CLEAR SCREEN
  @ 0, 0 TO MaxRow(), MaxCol()
  oTbr:goTop()
  IF Eof()
    Alert("No Matching Records")
  ENDIF

  oTbr:nTop    := 1
  oTbr:nLeft   := 1
  oTbr:nBottom := MaxRow() - 1
  oTbr:nRight  := MaxCol() - 1

  addAllFields(oTbr)
  oTbr:insColumn(1, TBColumnNew("Rec #", {|| Recno() }))
  oTbr:freeze := 1


  DO WHILE !lExitRequested
    DO WHILE !oTbr:stabilize()
    ENDDO
    IF oTbr:hitBottom .AND. !oTbr:appendMode .AND. ;
       Alert("Add Record", {"Yes", "No"}) = 1
       oTbr:appendMode := .T.
       oTbr:goBottom()
       DO WHILE !oTbr:stabilize()
       ENDDO
    ELSEIF (Eof() .OR. LastRec() = 0) .AND. !oTbr:appendMode
      // No records in database or none matching scope
      IF Alert("Add record", {"Yes", "No"}) = 1
        oTbr:appendMode := .T.
        oTbr:down()
        DO WHILE !oTbr:Stabilize()
        ENDDO
      ELSE
        lExitRequested := .T.
      ENDIF
    ENDIF

    IF !lExitRequested
      nKey := InKey(0)
      IF nKey == K_ESC
        IF oTbr:appendMode
          oTbr:appendMode := .F.
          oTbr:refreshAll()
        ELSE
          lExitRequested := .T.
        ENDIF
      ELSEIF nKey == K_INS
        IF Alert("Add Record", {"Yes", "No"}) = 1
          oTbr:appendMode := .T.
          oTbr:goBottom()
        ENDIF
      ELSE
        IF StdMeth(nKey, oTbr)
          IF MOVE_UP_KEY(nKey) .AND. oTbr:appendMode .AND. LastRec() != 0
            oTbr:appendMode := .F.
            oTbr:refreshAll()
          ENDIF
        ENDIF
      ENDIF
    ENDIF
  ENDDO

RETURN NIL


FUNCTION StdMeth(nKey, oTbr)

LOCAL lKeyHandled := .T.

  DO CASE
    CASE nKey == K_DOWN;       oTbr:down()
    CASE nKey == K_UP;         oTbr:up()
    CASE nKey == K_PGDN;       oTbr:pageDown()
    CASE nKey == K_PGUP;       oTbr:pageUp()
    CASE nKey == K_CTRL_PGUP;  oTbr:goTop()
    CASE nKey == K_CTRL_PGDN;  oTbr:goBottom()
    CASE nKey == K_RIGHT;      oTbr:right()
    CASE nKey == K_LEFT;       oTbr:left()
    CASE nKey == K_HOME;       oTbr:home()
    CASE nKey == K_END;        oTbr:end()
    CASE nKey == K_CTRL_LEFT;  oTbr:panLeft()
    CASE nKey == K_CTRL_RIGHT; oTbr:panRight()
    CASE nKey == K_CTRL_HOME;  oTbr:panHome()
    CASE nKey == K_CTRL_END;   oTbr:panEnd()
    OTHERWISE;                 lKeyHandled := .F.
  ENDCASE

RETURN lKeyHandled


FUNCTION AddAllFields(oTbr)

LOCAL oTbc, ;
      nFieldNum, ;
      nFields := fcount()

  FOR nFieldNum := 1 TO nFields
    oTbc := TBColumnNew(field(nFieldNum), fieldblock(field(nFieldNum)))
    oTbr:addColumn(oTbc)
  NEXT

RETURN NIL