PC Toledo

Código: Selecionar todos

***************************************
FUNCTION loc_on()
***************************************
* cChave é o grupo do item
cor(1)
WHILE .T.
   mEugRupa := crd->codigo
   * criar tbrowse 
   oPropri := tbrowsedb (05,28,17,70)


   * filtro tbrowse com a func skipwhil() 
   oProPri:SKIPBLOCK     := {|x| SKIPWHIL(x, {||item->cod_grup == cChave})} 
   oPropri:GOTOPBLOCK    := {| | SKIPWHIL((LASTREC()* -1),{||item->cod_grup == cChave})}
   oproPri:GOBOTTOMBLOCK := {| | SKIPWHIL((LASTREC()* 1), {||item->cod_grup == cChave})}

   oCol1  := tbcolumnnew("  PRODUTOS CADASTRADOS",     {||" ³ " + item->produto + " ³ "}) 

   oProPri:addcolumn(oCol1) 

   WHILE .T.
      WHILE(!oPropri:stabilize())
      END
      IF iNsert_dAta
         sset(2)
         IF     _MODE == 'pItem1'
             IF EMPTY(pItem1)
                forca_lc()
             ELSE
                SEEK gPitem + RTRIM(pItem1)
             END

         ELSEIF _MODE == 'pItem2'
             IF EMPTY(pItem2)
                forca_lc()
             ELSE
                SEEK gPitem + RTRIM(pItem2)
             END

         ELSEIF _MODE == 'pItem3'
            IF EMPTY(pItem3)
                forca_lc()
             ELSE
                SEEK gPitem + RTRIM(pItem3)
             END

         ELSEIF _MODE == 'pItem4'
             IF EMPTY(pItem4)
                forca_lc()
             ELSE
                SEEK gPitem + RTRIM(pItem4)
             END

         END
         IF EOF()
            forca_lc()
            oPropri:refreshall()
            KEYBOARD(CHR(47)); KEYBOARD(CHR(47))
         END
         oPropri:refreshall()
         KEYBOARD(CHR(47)); KEYBOARD(CHR(47))
      END

      nTecla := INKEY(0)

      DO CASE

         CASE ( nTecla == K_ESC ) 
            EXIT

         CASE ( nTecla == K_ENTER ) 
            EXIT 

         CASE ( nTecla == K_DOWN ) 
            oPropri:down () 

         CASE ( nTecla == K_UP ) 
            oPropri:up () 

         CASE ( nTecla == K_LEFT ) 
            oPropri:left () 

         CASE ( nTecla == K_RIGHT ) 
            oPropri:right () 

         CASE ( nTecla == K_PGUP ) 
            oPropri:pageup () 

         CASE ( nTecla == K_PGDN ) 
            oPropri:pagedown () 

         CASE ( nTecla == K_CTRL_PGUP ) 
            oPropri:gotop () 

         CASE ( nTecla == K_CTRL_PGDN ) 
            oPropri:gobottom ()

         OTHERWISE
            *** ENC100B2.PRG
            IF nAprima
               nAprima := .F.
            ELSE
               ver_teclado()
            END

      ENDCASE 

      oPropri:refreshall()
   END
   EXIT
END
RETURN

*************************************** 
FUNCTION SKIPWHIL (x,key_val)
***************************************
LOCAL i := 0 
IF LASTKEY() == 0 
   RETURN i 
END

IF (x > 0 .AND. RECNO() <> LASTREC()+1) 
   WHILE (i < x) 
      SKIP 1 
      IF EOF() .OR. !(EVAL(key_val)) 
         SKIP -1 
         EXIT 
      END
      i++ 
   END
ELSEIF (x < 0) 
   WHILE (i > x) 
      SKIP -1 
      IF BOF() 
         EXIT 
      END
      IF !(EVAL(key_val)) 
         SKIP 1 
         EXIT 
      END
      i--
   END
END
RETURN i

Código: Selecionar todos

      WHILE(!oPropri:stabilize())
      END

Código: Selecionar todos

oPropri:forceStable()

Código: Selecionar todos

SET ( _SET_EVENTMASK, INKEY_ALL - INKEY_MOVE )

ou


SET ( _SET_EVENTMASK, INKEY_ALL - INKEY_MOVE + HB_INKEY_GTEVENT )

Código: Selecionar todos

#include "Common.ch"
#include "Inkey.ch"
#include "Setcurs.ch"
#include "Error.ch"

#define APP_MODE_ON( b )      ( b:cargo := TRUE  )
#define APP_MODE_OFF( b )     ( b:cargo := FALSE )
#define APP_MODE_ACTIVE( b )  ( b:cargo )

// Separator strings for the browse display
#define MY_HEADSEP      CHR(196)+CHR(194)+CHR(196)
#define MY_COLSEP       " "+CHR(179)+" "

/***
*
*  MyBrowse()
*
*  Create a Tbrowse object and browse with it.
*
*/
PROCEDURE MyBrowse(nTop, nLeft, nBottom, nRight )
  LOCAL oBrowse                          // The TBrowse object
  LOCAL nCursSave                        // State preservers
  LOCAL nKey                             // Keystroke
  LOCAL lMore := TRUE                    // Loop control
  LOCAL xReadExit := READEXIT( .T. )  // Enable Up/Down as READ EXIT keys

   // Make a "stock" Tbrowse object for the current workarea
   oBrowse := StockBrowseNew( nTop, nLeft, nBottom, nRight )

   // Change the heading and column separators
   oBrowse:headSep := MY_HEADSEP
   oBrowse:colSep  := MY_COLSEP

   // Play with the colors and picture
   FormatColumn( oBrowse )

   // Save cursor shape, turn the cursor off while browsing
   nCursSave := SETCURSOR( SC_NONE )

   // Main loop
   WHILE lMore

      // Don't let the cursor move into frozen columns
      IF ( oBrowse:colPos <= oBrowse:freeze )
         oBrowse:colPos := ( oBrowse:freeze + 1 )

      ENDIF

      // Stabilize the display until it's stable or a key is pressed
      oBrowse:forceStable()

      IF ( oBrowse:hitTop .or. oBrowse:hitBottom )
        tone( 125, 0 )

      ENDIF

      /*
      *  Make sure that the current record is showing
      *  up-to-date data in CASE we are on a network.
      */
      oBrowse:refreshCurrent():forceStable()

      // Everything's done -- just wait for a key
      nKey := inkey( 0 )

      IF ( nKey == K_ESC )
         // Esc means leave
         lMore := .F.

      ELSE
         // Apply the key to the oBrowse
         applyKey( oBrowse, nKey )

      ENDIF

   ENDDO

   SETCURSOR( nCursSave )
   READEXIT( xReadExit )

RETURN


/***
*
*   ApplyKey()
*
*   Apply one keystroke to the oBrowse.
*
*   NOTE: uses the cargo #defines shown at the top of Tbdemo.prg
*
*/
STATIC PROCEDURE ApplyKey( oBrowse, nKey )
  LOCAL nCursor
  LOCAL oGet, MyVar
  LOCAL GetList := {}

   DO CASE
   CASE nKey == K_DOWN
     IF EOF()
       oBrowse:goBottom()
       Tone( 125, 0 )
     ELSE
       oBrowse:down()
     ENDIF

   CASE nKey == K_PGDN
     IF EOF()
       Tone( 125, 0 )
       oBrowse:goBottom()
     ELSE
       oBrowse:pageDown()
     ENDIF

   CASE nKey == K_CTRL_PGDN
     IF EOF()
       Tone( 125, 0 )
       oBrowse:goBottom()
     ELSE
       oBrowse:goBottom()
     ENDIF

   CASE nKey == K_UP
     IF BOF()
       oBrowse:goTop()
       Tone( 125, 0 )
     ELSE
       oBrowse:up()
     ENDIF

   CASE nKey == K_PGUP
     IF BOF()
       oBrowse:goTop()
       Tone( 125, 0 )
     ELSE
       oBrowse:pageUp()
     ENDIF

   CASE nKey == K_CTRL_PGUP
     IF BOF()
       oBrowse:goTop()
       Tone( 125, 0 )
     ELSE
       oBrowse:goTop()
     ENDIF

   CASE nKey == K_RIGHT
        oBrowse:right()

   CASE nKey == K_LEFT
        oBrowse:left()

   CASE nKey == K_HOME
        oBrowse:home()

   CASE nKey == K_END
        oBrowse:end()

   CASE nKey == K_CTRL_LEFT
        oBrowse:panLeft()

   CASE nKey == K_CTRL_RIGHT
        oBrowse:panRight()

   CASE nKey == K_CTRL_HOME
        oBrowse:panHome()

   CASE nKey == K_CTRL_END
        oBrowse:panEnd()

   CASE nKey == K_RETURN
        oBrowse:right()

   CASE ( nKey == K_SPACE )
       Tone( 125, 0 )

   CASE nKey == K_MOUSEMOVE
       Tone( 125, 0 )

   CASE nKey >= 1002 .AND. nKey <= 1007 // MOUSE EVENTS
      nCRow    := oBrowse:RowPos
      nMRow    := oBrowse:mRowPos

      IF nCRow < nMRow
         FOR nXv := nCRow to nMRow -1
             oBrowse:down()

         NEXT
      ELSEIF nCRow > nMRow
         FOR nXv := nMRow to nCRow -1
             oBrowse:up()

         NEXT
      ENDIF

      IF BOF()
         oBrowse:gotop()
      ENDIF

      IF EOF()
         oBrowse:goBottom()
      ENDIF

   case nKey == K_DEL
     tone( 125, 0 )

   OTHERWISE
      tone( 125, 0 )

   ENDCASE

RETURN


/***
*
*   StockBrowseNew()
*
*   Create a "stock" Tbrowse object for the current workarea.
*
*/
STATIC FUNCTION StockBrowseNew( nTop, nLeft, nBottom, nRight )
  LOCAL oBrowse
  LOCAL n
  LOCAL oColumn
  LOCAL nCounter

   // Start with a new browse object from TBrowseDB()
   oBrowse := TBrowseDB( nTop, nLeft, nBottom, nRight )

   nCounter := FCOUNT()

   IF nCounter >  32
      nCounter := 32
   ENDIF

   // Add a column for each field in the current workarea
   for n := 1 to nCounter

      // Make a new column
      oColumn := TBColumnNew( field( n ), FieldWBlock( field( n ), select() ) )

      // Add the column to the browse
      oBrowse:addColumn( oColumn )

   next

RETURN oBrowse


/***
*
*   FormatColumn()
*
*   Set up some colors and pictures for the column.
*
*/
STATIC PROCEDURE FormatColumn( oBrowse )
  LOCAL n, r, oColumn, xValue, lControl
  r := MAXCOL()

   // Set up a list of colors for the browse to use
   oBrowse:colorSpec := "N/W,N/BG,B/W,B/BG,B/W,B/BG,R/W,B/R"

   lControl := .T.

   // Loop through the columns, choose some colors for each
   for n := 1 to oBrowse:colCount
      // Get (a reference to) the column
      oColumn := oBrowse:getColumn( n )

      // Get a sample of the underlying data by evaluating the codeblock
      xValue := EVAL( oColumn:block )

      DO CASE
      CASE ISNUMBER( xValue )
          // For numbers, use a color block to highlight negative values
          IF LEN( STR( xValue ) ) <= 10
            oColumn:picture    := "@E 9,999,999.99"
            oColumn:colorBlock := { |x| iif( x < 0, { 7, 8 }, { 5, 6 } ) }
          ELSE
            oColumn:picture    := "@E 999,999,999,999,999.99"
            oColumn:colorBlock := { |x| iif( x < 0, { 7, 8 }, { 5, 6 } ) }
          ENDIF

          // Set default colors also (controls the heading color)
          oColumn:defColor := {7, 8}

      CASE ISCHARACTER( xValue )
         // For non-numeric, just use colors 3 and 4
         oColumn:picture  := ""
         oColumn:defColor := { 3, 4 }

        IF r > 80
          IF len( xValue ) > 96
            oColumn:picture  := "@S96"
          ENDIF
        ELSE
          IF len( xValue ) > 60
            oColumn:picture  := "@S60"
          ENDIF
        ENDIF

      CASE ISDATE( xValue )
         // For non-numeric, just use colors 3 and 4 
         oColumn:picture  := repl( "@E", len( DTOC( xValue ) ) + 2 )
         oColumn:defColor := { 3, 4 }

      OTHERWISE
         // For non-numeric, just use colors 3 and 4
         oColumn:defColor := { 3, 4 }

      ENDCASE

   next

RETURN