Newsgroup: it.comp.lang.vo-clipper
Titolo: tBrowse

Non so se č OT, ma con xHarbour non riesco a trovare l'algoritmo giusto per
cambiare il colore di una singola cella con il metodo Autolite impostato a
True. Il mio scopo č cambiare appunto il colore della cella con la pressione
del tasto invio: ho provato cambiando il valore di colorRect, ma non ho
ottenuto nulla. Qualcuno puņ gentilmente aiutarmi ?
Grazie: Max

 ottenuto nulla. Qualcuno puň gentilmente aiutarmi ?
Se usi la TBrowse standard dovrebbe funzionare esattamente come in
Clipper. Solo che comunque non ti so aiutare. Prova a mandare un
esempietto (minuscolo ma completo) che mostri il problema...
EMG
--
EMAG Software Homepage:     
http://www.emagsoftware.it
The EMG's ZX-Spectrum Page: 
http://www.emagsoftware.it/spectrum
The Best of Spectrum Games: 
http://www.emagsoftware.it/tbosg

Ti invio direttamente la mia funzione. Hai ragione tu cmq, in Clipper
funziona ma non in xHarbour. Ho provato anche a postare al newsgroup di
xHarbour (per me infatti si tratta di un bug non corretto), ma niente
risposta.
Grazie: Max
P.S.: Sono riuscito a farlo funzionare col mouse, ma mi blocco per il colore
della cella: mah !!
*********************
#Include "Inkey.ch"
PROCEDURE MAIN()
   LOCAL aRet := {}
   CLS
   SELECT 1
   USE "Qualsiasi database"
   GO TOP
   aRet := H_BrowDB( 10,00,20,79,,,,,.T. )
*   INKEY(0)
   RETURN
***************************************************
FUNCTION H_Browdb( nTop,nLeft,nBottom,nRight,cColor, ;
                   aTitoliDB,aCampiDB,nShadow,xMulti,lSaveScr )
   LOCAL oB, n, cScrSave, nKey, nCursSave
   LOCAL oColumn, xGetVar, nPos, cHlpScr
   LOCAL lMulti, nButton, cClmCol
   LOCAL cOldCol := SETCOLOR()
   LOCAL xRet    := 0
   LOCAL aMulti  := {}, aTot := {}
   // Check parameters
   IF SELECT() == 0 .OR. LASTREC() == 0
      CLS
      QUIT
   ENDIF
   cColor   := IF( cColor  ==NIL, "W/B,N/W,N/N,N/N,N/BG", cColor )
   lMulti   := IF( xMulti  ==NIL, .F., ;
                   IF( VALTYPE(xMulti)=="L", xMulti, .T. ))
   lSaveScr := IF( lSaveScr==NIL, .F., lSaveScr )
   IF lSaveScr
      cScrSave := SAVESCREEN( nTop,nLeft,nBottom,nRight )
   ENDIF
   SETCOLOR( cColor )
   // Draw a box
   DISPBOX( nTop,nLeft,nBottom,nRight,"???????? ",cColor )
   IF nShadow != NIL
      H_Shadow( nTop,nLeft,nBottom,nRight,nShadow )
   ENDIF
   // Make tBrowse
   oB           := TBrowseDB( nTop + 2, nLeft + 1, nBottom - 1, nRight - 1 )
   oB:headSep   := "?"
   oB:colSep    := "?"
   oB:skipBlock := {|x| Skipped(x)}
   // Add a column for each field
   IF VALTYPE( aTitoliDB ) == "U" .OR. ;
      VALTYPE( aCampiDB )  == "U"
      FOR n := 1 TO FCOUNT()
         oB:addColumn( TBColumnNew( FIELDNAME(n), ;
                       FIELDBLOCK(FIELDNAME(n)) ) )
      NEXT n
   ELSE
      FOR n := 1 TO LEN( aCampiDB )
         oB:addColumn( TBColumnNew( aTitoliDB[n], ;
                       FIELDBLOCK(FIELDNAME(FIELDPOS(aCampiDB[n]))) ) )
      NEXT n
   ENDIF
   nCursSave := SETCURSOR()
   SETCURSOR(0)
   oB:forceStable()
   DO WHILE .T.
      // Don't allow the cursor to move in frozen columns
      IF ( oB:colPos <= oB:freeze )
         oB:colPos := ( oB:freeze + 1 )
      ENDIF
      oB:forceStable()
      // Display status
      Statline(oB)
      nKey := INKEY(0)
      DO CASE
      CASE ( nKey == K_DOWN )
         oB:down()
      CASE ( nKey == K_UP )
         oB:up()
      CASE ( nKey == K_PGDN )
         oB:pageDown()
      CASE ( nKey == K_PGUP )
         oB:pageUp()
      CASE ( nKey == K_CTRL_PGUP )
         oB:goTop()
      CASE ( nKey == K_CTRL_PGDN )
         oB:goBottom()
      CASE ( nKey == K_RIGHT )
         oB:right()
      CASE ( nKey == K_LEFT )
         oB:left()
      CASE ( nKey == K_HOME )
         oB:home()
      CASE ( nKey == K_END )
         oB:end()
      CASE ( nKey == K_CTRL_LEFT )
         oB:panLeft()
      CASE ( nKey == K_CTRL_RIGHT )
         oB:panRight()
      CASE ( nKey == K_CTRL_HOME )
         oB:panHome()
      CASE ( nKey == K_CTRL_END )
         oB:panEnd()
      CASE ( nKey == K_ALT_F )
         TONE( 700,1 )
         TONE( 600,1 )
         FreezeCol( oB,aTitoliDB,aCampiDB )
      CASE ( nKey == K_RETURN )
         // Cell position
         oColumn := oB:getColumn(oB:colPos)
         // Value and color of field in the column
         xGetVar := IF( VALTYPE(xMulti)!="L", RECNO(), EVAL(oColumn:block) )
         cClmCol := oColumn:defColor
         // Value to return
         IF lMulti
            nPos := ASCAN( aMulti,xGetVar )
            IF nPos == 0
               oB:colorRect(
{oB:rowPos,oB:colPos,oB:rowPos,oB:colPos},{6,6} )
               IF LEN( aMulti ) < 4096
                  AADD( aMulti,xGetVar )
               ELSE
                  aMulti := H_Anonil( aMulti )
                  IF LEN( aTot ) < 4096
                     AADD( aTot,aMulti )  // Se supero il limite, uso un
altro array
                  ELSE
                     H_Error()            // Max 16.777.216 records
                     C_MsgExclamation( "Non posso aggiungere altri
record","Warning" )
                  ENDIF
                  aMulti := {}
               ENDIF
            ELSE
               oB:colorRect(
{oB:rowPos,oB:colPos,oB:rowPos,oB:colPos},{1,2} )
               ADEL( aMulti,nPos )
            ENDIF
         ELSE
            xRet := RECNO()               // xGetVar
            EXIT
         ENDIF
      CASE ( nKey == K_F1 )
         cHlpScr := SAVESCREEN()
         DISPBOX( 05,11,18,67,"???????? ","+GR/R" )
         @06,12 SAY PADC( "HELP BROWSE",54 ) COLOR "+GR/R"
         @08,12 SAY " ?     ?  / Mouse SX     Movimenti singoli"
COLOR "+W/R"
         @09,12 SAY "CTRL +  ?  ?             Movimenti per pagina sx o dx"
COLOR "+W/R"
         @10,12 SAY "PgUp PgDn                Movimenti per pagina su o giù"
COLOR "+W/R"
         @11,12 SAY "HOME END                 Pagina precedente o
successiva" COLOR "+W/R"
         @12,12 SAY "CTRL + HOME END          Prima e ultima pagina sx o dx"
COLOR "+W/R"
         @13,12 SAY "CTRL + PgUp PgDn         Prima e ultima pagina su o
giù" COLOR "+W/R"
         @14,12 SAY " ? / Mouse Double Clk    Scelta valore"
COLOR "+W/R"
         @15,12 SAY "ALT + F                  Blocca/Sblocca colonna"
COLOR "+W/R"
         @16,12 SAY "F1                       Help On/Off"
COLOR "+W/R"
         @17,12 SAY "Esc / Mouse DX           Uscita"
COLOR "+W/R"
         INKEY(0)
         RESTSCREEN( ,,,,cHlpScr )
      CASE ( nKey == K_ESC ) .OR. ( nKey == K_RBUTTONDOWN )
         IF lMulti
            xRet := IF( EMPTY( aTot ), H_Anonil( aMulti ), aTot )
         ENDIF
         EXIT
      CASE ( ( nKey == K_LBUTTONDOWN ) .OR. ( nKey == K_LDBLCLK ) )
         xRet := tMouseDB( oB,MROW(),MCOL(),nKey )
         IF xRet != 0
            EXIT
         ENDIF
      ENDCASE
   ENDDO
   SETCURSOR( nCursSave )
   SETCOLOR( cOldCol )
   IF lSaveScr
      RESTSCREEN( nTop,nLeft,nBottom,nRight,cScrSave )
   ENDIF
RETURN xRet
***************************************************
* Display status
STATIC FUNCTION Statline( oB )
   LOCAL nTop, nRight
   nTop   := oB:nTop - 1
   nRight := oB:nRight
   @ nTop, nRight - 27 SAY "Record "
   IF LASTREC() == 0
      // Empty
   ELSEIF ( RECNO() == LASTREC() + 1 )
      // Eof
      @ nTop, nRight - 40 SAY "         "
      @ nTop, nRight - 20 SAY "                <eof>"
   ELSE
      // Display n° record
      @ nTop, nRight - 20 SAY PAD( LTRIM( STR( RECNO() )) + "/" +;
                              LTRIM( STR( LASTREC() )), 16)     +;
                              IF( oB:hitTop, "<bof>", "     " )
   ENDIF
RETURN ( NIL )
***************************************************
* Skip database and number of records skipped
STATIC FUNCTION Skipped( nRequest )
   LOCAL nCount := 0
   IF LASTREC() != 0
      IF ( nRequest == 0 )
         SKIP 0
      ELSEIF ( nRequest > 0 .AND. RECNO() != LASTREC() + 1 )
         // Forward
         DO WHILE ( nCount < nRequest )
            SKIP 1
            IF EOF()
               // Go bottom
               SKIP -1
               EXIT
            ENDIF
            nCount++
         ENDDO
      ELSEIF ( nRequest < 0 )
         // Backward
         DO WHILE ( nCount > nRequest )
            SKIP -1
            IF BOF()
               EXIT
            ENDIF
            nCount--
         ENDDO
      ENDIF
   ENDIF
RETURN ( nCount )
***************************************************
STATIC PROCEDURE FreezeCol( oB,aTitoliDB,aCampiDB )
   LOCAL oColn, nColPos
   IF oB:freeze == 1
      // If exist freeze column, delete it
      oB:delColumn( 1 )
      oB:freeze := 0
   ELSE
      nColPos := oB:colPos
      IF VALTYPE( aTitoliDB ) == "U" .OR. ;
         VALTYPE( aCampiDB )  == "U"
         oColn := TBColumnNew( FIELDNAME(nColPos),
FIELDBLOCK(FIELDNAME(nColPos)) )
      ELSE
         oColn := TBColumnNew( aTitoliDB[nColPos],
FIELDBLOCK(aCampiDB[nColPos]) )
      ENDIF
      // Insert freeze column to first position
      oB:insColumn( 1,oColn )
      // Freeze
      oB:freeze := 1
   ENDIF
RETURN
***************************************************
FUNCTION tMouseDB( oB,nRow,nCol,nKey )
   LOCAL nCount, nDBCol, nNewCol
   LOCAL nColsLen, aColsSpc
   LOCAL nReturn := 0
   IF nCol < oB:nRight             // BASE/1132 BOUND ERROR
      IF ( oB:HitTest( nRow,nCol ) == -5121 )
         // New ROW mouse position
         IF oB:RowPos < ( oB:rowCount() - 1 )
            nCount := oB:mRowPos - oB:RowPos - IF( ! EMPTY( oB:headSep ), 1,
0 )
         ELSE
            nCount := oB:mRowPos - oB:RowPos + 1
         ENDIF
         IF nCount > 0
            oB:down()
         ELSEIF nCount < 0
            oB:up()
         ENDIF
         // New COLUMN mouse position
         nColsLen := IF( oB:ColPos == 1, COL(), 0 )
         aColsSpc := {}
         nDBCol := IF( oB:freeze > 0, oB:freeze, oB:leftVisible )
         DO WHILE nDBCol <= oB:rightVisible
            nColsLen += oB:colWidth(nDBCol) + IF( nDBCol < oB:rightVisible,
1, 0 )
            AADD( aColsSpc, nColsLen )
            nDBCol++
         ENDDO
         // Column position is equal to mouse click
         FOR nNewCol := 1 TO LEN( aColsSpc )
            IF oB:mColPos <= aColsSpc[nNewCol]
               EXIT
            ELSE
               IF nNewCol == LEN( aColsSpc )
                  EXIT
               ENDIF
            ENDIF
         NEXT nNewCol
         oB:ColPos := oB:leftVisible + ( nNewCol - 1 )
         oB:forceStable()
         IF oB:ColPos == oB:leftVisible
            oB:left()
         ELSEIF oB:ColPos == oB:rightVisible
            oB:right()
         ENDIF
      ENDIF
      IF nKey == K_LDBLCLK
         nReturn := RECNO()
      ENDIF
   ENDIF
RETURN nReturn
***************************************************
STATIC PROCEDURE ColorCell( oB,oCol,nColor )
   LOCAL ftmp   := Eval(oCol:block)
   LOCAL nCol   := Col()
   LOCAL cType  := ValType( ftmp )
   local cPict  := if( !empty( oCol:Picture ), oCol:Picture, "@" )
   local cDisp  := ""
   local cColor := iif(oCol:ColorBlock != NIL,;
                       hb_ColorIndex(oB:ColorSpec, Eval(oCol:ColorBlock,
ftmp)[nColor] - 1),;
                       hb_ColorIndex(oB:ColorSpec, nColor - 1))
   do case
      case cType $ "CM"
         cDisp := transform( Left( ftmp, oCol:Width ), cPict )
      case cType == "N"
         cDisp := Right( transform(  ftmp, cPict ), oCol:Width )
      case cType == "D"
         cPict := if( cPict == "@", "@D", cPict )
         cDisp := Right( transform(  ftmp, cPict ), oCol:Width )
      case cType == "L"
         cDisp := Space( oCol:Width / 2 ) + iif( ftmp, "T","F" )
   endcase
   DevOut(
   DispOut( cDisp, cColor )
   // Logical fields are centered on column width
//   SetPos( Row(), nCol + if( cType == "L", oB:aColumns[oB:ColPos]:Width /
2, 0 ) )
return
***************************************************

 Ti invio direttamente la mia funzione.
Mi dispiace ma non č compilabile né in Clipper 5.2e né in xHarbour
0.92.0 e quindi non posso aiutarti. Comunque se dici (e sei sicuro) che
in Clipper lo stesso sorgente funziona allora č sicuramente un bug di
xHarbour. Probabilmente non ti hanno dato retta per lo stesso motivo per
cui non posso aiutarti io. Per correggere un bug servono PRG *minimali*
e *compilabili*.


Devo aver dimenticato alcune funzioni interne, cmq grazie lo stesso. Ci
sbatterò la testa.........
A presto: Max