Click above to get retro games delivered to your door ever month!

Browse()       Browse records within a window          Examplep.prg


Syntax:        Browse([<expN1>][,<expN2>][,<expN3>][,<expN4>])

Arguments:     <expN1...expN4> define the window coordinates.  If
               not specified, the default coordinates are 1, 0 to 23,
               79.

Returns:       True (.T.).

Description:   Browse() is a general purpose table-oriented browser and
               editor for records in the current work area.  Browse()
               operates in a window with a border if window coordinates
               are specified, otherwise it operates full-screen.

               Since it uses DBEDIT() as its base primitive, navigation
               keys are the same as DBEDIT().

               Status line: Browse() supports a status line in the
               upper right corner of the browse window indicating one of
               the following:

               Table: Browse() status line messages
               -----------------------------------------------------------------
                Message         Meaning
               -----------------------------------------------------------------
                <new>           Append mode
                <bof>           Top-of-file
                <Delete>        Current record is deleted
                Record          Record number display
               -----------------------------------------------------------------

               Modes: Browse() has three modes: browse, field edit,
               and append new record.

               . Browsing: This is the default mode of Browse().
                 Pressing any DBEDIT() navigation key moves the
                 highlight to a new column or row.

               . Field edit: Pressing Return on any field enters
                 field edit using a GET.  Pressing Return terminates the
                 edit mode with a save of changes.  Esc terminates
                 without saving changes.  Since the field edit mode uses
                 GET, all navigation and editing keys are READ keys.

               . Append mode: GOing BOTTOM with Ctrl-PgDn and then
                 pressing Dnarrow enters append mode with the indicating
                 message "<new>" on the status line.  A new blank record
                 is inserted.  Pressing Uparrow terminates the append
                 mode saving the new record if data has been entered.
                 If no data has been entered, the new record is deleted
                 and not saved to the current database file.

Calls:         Xbrowse(): Handle special keys and displays during
               DBEDIT().

               Statline(): Update status line in the browse window.

               Get_pic(): Return matching picture string for
               specified field.

               Pad(): Pad variable length characters strings with
               spaces.

               Clear_gets: SET KEY procedure to exit a READ.

Library:       EXTEND.LIB


--------------------------------- Source Code ------------------------------

   FUNCTION Browse

   PARAMETERS t, l, b, r
   PRIVATE n,move_chrs,force_rec,ntx_expr,ntx_eval,prev_rec,;
           is_append,any_append,keystroke,e_field,get_data

   IF EMPTY(FIELDNAME(1))
      * no database in use
      RETURN .F.

   ENDIF

   SAVE SCREEN

   IF PCOUNT() < 4
      t = 1
      l = 0
      b = 23
      r = 79

   ELSE
      * window specified
      @ M->t, M->l, M->b, M->r BOX "+-+|+-+|"
      @ M->t + 3, M->l SAY "-"
      @ M->t + 3, M->r SAY "|"

      * shrink
      t = M->t + 1
      l = M->l + 1
      b = M->b - 1
      r = M->r - 1

   ENDIF

   DECLARE field_list[FCOUNT()]

   FOR n = 1 TO FCOUNT()
      * each element contains one field name
      field_list[M->n] = FIELDNAME(M->n)

   NEXT

   * record movement keystroke values
   move_chrs = CHR(24) + CHR(5) + CHR(3) + CHR(18) + CHR(31) + CHR(30)

   IF EOF()
      GO TOP

   ENDIF

   * init
   force_rec = .T.             && update status flag
   is_append = .F.             && append model flag
   any_append = .F.            && records appended during current mode
   prev_rec = 0

   IF LASTREC() = 0
      * empty file..force append mode
      KEYBOARD CHR(24)

   ENDIF

   @ M->t, M->l SAY SPACE(M->r - M->l + 1)
   DBEDIT(M->t + 1, M->l, M->b, M->r, M->field_list, "xbrowse", 0, 0, " -",;
         " ")

   RESTORE SCREEN
   RETURN .T.


---------------------------------- Xbrowse() -------------------------------

   FUNCTION Xbrowse

   PARAMETERS mode, f_script
   PRIVATE ret_val

   * assume normal return
   ret_val = 1

   * save last keystroke
   keystroke = LASTKEY()

   * get fieldspec into normal variable
   e_field = field_list[M->f_script]

   IF M->prev_rec <> RECNO()
      * record pointer has been moved
      prev_rec = RECNO()
      force_rec = .T.

   ENDIF

   DO CASE

      CASE M->mode = 0
         * idle

         IF CHR(M->keystroke) $ M->move_chrs .OR. M->force_rec
            * need to update status line
            statline()

         ENDIF

      CASE M->mode = 1
         * bof bang

         IF M->is_append
            * no more append mode..refresh if any new records
            ret_val = IF(M->any_append, 2, 3)
            is_append = .F.
            any_append = .F.

         ELSE

            IF .NOT. EOF()
               * just display "bof bang" status
               @ M->t, M->r - 20 SAY pad(LTRIM(STR(RECNO())) + "/" +;
                                LTRIM(STR(LASTREC())), 15) + " <bof>"

            ENDIF
         ENDIF

         force_rec = .T.

      CASE M->mode = 2
         * eof bang

         IF M->is_append
            * append mode active

            IF M->keystroke = 24 .AND. .NOT. EOF()
               * down arrow...do it again
            ret_val = 3

         ELSE

            IF M->keystroke = 30
               * PgDn..no more append mode..refresh if any new records
               ret_val = IF(M->any_append, 2, 3)
               is_append = .F.
               any_append = .F.

               ELSE
                  * someone is standing on the down arrow

                  IF M->force_rec
                     * need to update status line
                     statline()

                  ENDIF
               ENDIF
            ENDIF

         ELSE

            IF M->keystroke = 24
               * enter append mode
               ret_val = 3
               is_append = .T.

            ELSE

               IF .NOT. EOF()
                  * just display "eof bang" status
                  @ M->t, M->r - 20 SAY pad(LTRIM(STR(RECNO())) + "/" +;
                                  LTRIM(STR(LASTREC())), 15) + " <eof>"

               ENDIF
            ENDIF
         ENDIF

         force_rec = .T.

      CASE M->mode = 3
         * file is empty

         IF M->keystroke = 24
            * enter append mode
            ret_val = 3
            is_append = .T.
            force_rec = .T.

         ELSE
            * just display status
            statline()

         ENDIF

      CASE M->mode = 4
         * keystroke exception

         DO CASE

            CASE M->keystroke = 27
               * exit requested..quit dbedit
               ret_val = 0

            CASE M->keystroke = 7 .AND. .NOT. EOF() .AND. LASTREC() <> 0
               * delete key..toggle deleted() flag

               IF DELETED()
                  RECALL

               ELSE
                  DELETE

               ENDIF

               * show the new deleted status
               statline()

            CASE M->keystroke = 13 .AND.;
                (M->is_append .OR. (.NOT. EOF() .AND. LASTREC() <> 0))
               * edit the current field
               ntx_expr = INDEXKEY(0)     && get the controlling index key

               IF .NOT. EMPTY(M->ntx_expr)
                  * expand key for comparison after edit
                  ntx_eval = &ntx_expr.

               ENDIF

               SET CURSOR ON

               * use memory variable for data entry
               get_data = &e_field.

               * up and down arrows will exit read
               SET KEY 5 TO clear_gets
               SET KEY 24 TO clear_gets

               * data entry
               @ ROW(),COL() GET get_data PICTURE get_pic(M->e_field)
               READ
               keystroke = LASTKEY()      && save exit key

               * release keys
               SET KEY 5 TO
               SET KEY 24 TO

               IF M->keystroke <> 27 .AND. UPDATED()
                  * new data confirmed

                  IF M->is_append .AND. EOF()
                     * first data in new record
                     APPEND BLANK
                     any_append = .T.

                     * update status line
                     statline()

                  ENDIF

                  * put it there
                  REPLACE &e_field. WITH M->get_data

               ENDIF

               SET CURSOR OFF

               IF .NOT. EMPTY(M->ntx_expr) .AND. .NOT. M->is_append
                  * file indexed..check for altered key field

                  IF M->ntx_eval <> (&ntx_expr.)
                     * key field altered..re-draw screen
                     ret_val = 2

                  ENDIF
               ENDIF

               IF M->ret_val <> 2
                  * certain keys move cursor after edit if no refresh

                  DO CASE

                     CASE M->keystroke = 5
                        * up arrow

                        IF M->is_append
                              * no more append mode..refresh if new records
                              ret_val = IF(M->any_append, 2, 3)
                              is_append = .F.
                              any_append = .F.

                        ELSE
                           * move up one row
                           KEYBOARD CHR(5)

                        ENDIF

                     CASE M->keystroke = 18
                        * PgUp

                        IF M->is_append
                              * no more append mode..refresh if new records
                              ret_val = IF(M->any_append, 2, 3)
                              is_append = .F.
                              any_append = .F.

                        ELSE
                           * return up arrow
                           KEYBOARD CHR(5)

                        ENDIF

                     CASE M->keystroke = 24
                        * down arrow
                        KEYBOARD CHR(24)

                     CASE M->keystroke = 3 .AND. .NOT. M->is_append
                        * PgDn..return down arrow if not append mode
                        KEYBOARD CHR(24)

                     CASE M->keystroke = 13
                        * return..move right
                        KEYBOARD CHR(4)

                  ENDCASE
               ENDIF
         ENDCASE
   ENDCASE

   RETURN M->ret_val

---------------------------------- Statline() ------------------------------

   FUNCTION Statline

   * display record pointer information
   @ M->t, M->r - 27 SAY "Record "

   IF LASTREC() = 0 .AND. .NOT. M->is_append
      * file is empty
      @ M->t, M->r - 20 SAY "<none>               "

   ELSE

      IF EOF()
         * no record number if eof
         @ M->t, M->r - 40 SAY "         "
         @ M->t, M->r - 20 SAY "                " +;
                          IF(M->is_append, "<new>", "<eof>")

      ELSE
         * normal record..display recno()/lastrec() and deleted()
         @ M->t, M->r - 40 SAY IF(DELETED(), "<Deleted>", "         ")
         @ M->t, M->r - 20 SAY pad(LTRIM(STR(RECNO())) + "/" +;
                             LTRIM(STR(LASTREC())), 21)

      ENDIF
   ENDIF

   * status line is current
   force_rec = .F.

   RETURN 0


---------------------------------- Get_pic() -------------------------------

   FUNCTION Get_pic

   PARAMETERS field
   PRIVATE pstring, s

   DO CASE

      CASE TYPE(M->field) = "C"
         * character field is bounded by window width
         pstring = "@KS" + LTRIM(STR(MIN(LEN(&field.), 78)))

      CASE TYPE(M->field) = "N"
         * convert to character to help format picture string
         s = STR(&field.)

         IF "." $ M->s
            * decimals in numeric...use the form "9999.99"
            pstring = REPLICATE("9", AT(".", M->s) - 1) + "."
            pstring = pstring + REPLICATE("9", LEN(M->s) - LEN(M->pstring))

         ELSE
            * no decimals...only need the correct length
            pstring = REPLICATE("9", LEN(M->s))

         ENDIF

      OTHERWISE
         * no picture
         pstring = ""

   ENDCASE

   RETURN pstring


------------------------------------ Pad() ---------------------------------

   FUNCTION Pad

   PARAMETERS string, length

   RETURN SUBSTR(string + SPACE(length), 1, length)


---------------------------------- Clear_gets ------------------------------

   PROCEDURE Clear_gets
   PARAMETERS dummy1,dummy2,dummy3

   CLEAR GETS
   RETURN