Inoffizielles deutsches Xbase-Forum

Code: Alles auswählen

PROCEDURE BROWSE_MIT
  
  dbfView( 5,10,20,70, "vb_opb.dbf" )

RETURN

 
PROCEDURE dbfView(nTop, nLeft, nBottom, nRight, cDbfFile )

   LOCAL oTBrowse, n, nCount

  // 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.
  
  
  //////
  // The function generates a TBrowse object for viewing the data records and activates the TBrowse object
  //////
  
        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
     //////

Code: Alles auswählen

 
        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"
        */