Class TBrowse() Foundation

// The program example shows the basic procedures for 
// programming with TBrowse and TBColumn objects in this example 
// of a simple DBF File Viewer. In order to display data on the screen 
// the following steps are required: 
// 
//   Generate TBrowse object and 
//   define navagation code blocks.     (-> PROCEDURE DbfView ) 
// 
//   Generate TBColumn objects and      (-> FUNCTION FieldColumn ) 
//   attach to the TBrowse object.      (-> PROCEDURE DbfView ) 
// 
//   Display, stabilize browse window 
//   and examine keyboard (events).     (-> PROCEDURE TBSetFocus ) 
// 
//   Call methods for the 
//   movement of the browse cursor      (-> FUNCTION TBNavigate ) 
// 
//   Perform appropriate skip operations 
//   based on cursor movement           (-> FUNCTION DbfSkipper ) 
// 
//   The basic steps are programmed in five different functions 
//   and procedures. 


#include "Inkey.ch" 

PROCEDURE Main 

   dbfView( 5,10,20,70, "ADRESSES.DBF" ) 

RETURN 

////// 
// The function generates a TBrowse object for 
// viewing the data records and activates 
// the TBrowse object 
////// 
PROCEDURE dbfView( nTop, nLeft, nBottom, nRight, cDbfFile ) 
   LOCAL oTBrowse, n, nCount 

   USE (cDbfFile) NEW                 // Open file 
                                      // Generate TBrowse object 
   oTBrowse := TBrowse():new( nTop, nLeft, nBottom, nRight ) 
   oTBrowse:goTopBlock    := {|| DbGoTop() } 
   oTBrowse:goBottomBlock := {|| DbGoBottom() } 
   oTBrowse:skipBlock     := {|n| DbfSkipper(n) } 
   oTBrowse:headSep       := Chr(205) + Chr(205) + Chr(205) 
   oTBrowse:colSep        := Chr(32)  + Chr(179) + Chr(32) 
   oTBrowse:colorSpec     := "N/BG,W+/B,N/R,W+/R" 

   nCount := FCount() 
   FOR n:=1 TO nCount                 // Generate TBColumn object 
      oTBColumn:= FieldColumn( n )    // in UDF 
      oTBrowse:AddColumn( oTBColumn ) // Attach TBColumn object 
   NEXT 

   TBSetFocus( oTBrowse )             // Activate TBrowse 

RETURN 

////// 
// The function generates a TBColumn object for 
// a field variable with help of the field position 
////// 
FUNCTION FieldColumn( nFieldPos ) 
   LOCAL oTBColumn , cHeading  , bBlock , ; 
         cFieldname, cFieldtype 

   cFieldname := FieldName( nFieldPos ) 
   cFieldtype := Type( cFieldname ) 
   cHeading   := Left( cFieldname, 1 ) + ; 
                 Lower( SubStr( cFieldname, 2 ) ) 

   IF cFieldtype == "M"              // Produce data code block 
      bBlock  := {|| IIf( Empty( FieldGet(nFieldPos) ), ; 
                          "          ", "<Memofield>" )  } 
   ELSE 
      bBlock  := FieldWBlock( cFieldname, Select() ) 
   ENDIF 
                                     // Generate TBColumn object 
   oTBColumn  := TBColumn():new( cHeading, bBlock ) 

   IF cFieldtype == "N"              // Negative numbers have 
                                     // different colors than 
                                     // positive numbers. 
      oTBColumn:colorBlock := {|n| IIF( n<0, {3,4}, {1,2} ) } 
   ELSEIF cFieldtype == "L" 
      oTBColumn:Picture := "Y"       // Picture for logical values 
   ENDIF 

RETURN oTBColumn 

////// 
// This function stabilizes the display in the 
// browse window and gets input from the keyboard 
////// 
PROCEDURE TBSetFocus( oTBrowse ) 
   LOCAL nKey := 0 

   DO WHILE nKey <> K_ESC 

      DO WHILE .NOT. oTBrowse:stabilize() 
         IF (nKey := Inkey()) <> 0 
            EXIT 
         ENDIF 
      ENDDO 

      IF oTBrowse:stable 
         nKey := Inkey(0) 
      ENDIF 

      TBNavigate( oTbrowse, nKey ) 
   ENDDO 

RETURN 

////// 
// The function sends different messages to a TBrowse object 
// for moving the cursor, depending on the key pressed. 
////// 
FUNCTION TBNavigate( oTBrowse, nKey ) 
   LOCAL bBlock  := SetKey( nKey ) 
   LOCAL lReturn := .T. 

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

RETURN lReturn 

////// 
// This function executes a skip operation on the data source 
// of a TBrowse object. It is called from oTBrowse:skipBlock 
// which is evaluated in oTBrowse:stabilize(), 
// and receives as a parameter the number of skip 
// operations to perform. DbSkipper() works with  DBF files 
////// 
FUNCTION DbfSkipper( nWantSkip ) 
   LOCAL nDidSkip := 0 

   DO CASE 
   CASE LastRec() == 0              // No data records to skip, 
                                    // nothing happens. 
   CASE nWantSkip == 0 
      GOTO RecNo()                  // Refresh data buffer 

   CASE nWantSkip > 0               // Skip forward 
      DO WHILE nWantSkip > nDidSkip .AND. .NOT. Eof() 
         SKIP 
         IF Eof()                   // End of file 
            SKIP -1 
            EXIT 
         ENDIF 
         nDidSkip ++ 
      ENDDO 

   CASE nWantSkip < 0               // Skip backward 
      DO WHILE nWantSkip < nDidSkip .AND. .NOT. Bof() 
         SKIP -1 
         IF Bof()                   // Beginning of file reached 
            EXIT 
         ENDIF 
         nDidSkip -- 
      ENDDO 

   ENDCASE 

RETURN nDidSkip                     // This much was skipped 
////// 
// EOF TEST.PRG 
//////