Posible bug en xbrowse

[wmormar]

Al presionar el boton izquierdo del mouse en una linea del xbrowse, lanza un error:
[code]Application
===========
Path and name: V:\nicotina\nicotina.exe (32 bits)
Size: 2,057,728 bytes
Time from start: 0 hours 0 mins 11 secs
Error occurred at: 02-10-2009, 11:20:30
Error description: Error DBCMD/2001 Workarea not in use: DBSKIP
Args:

Stack Calls
===========
Called from: => DBSKIP(0)
Called from: .\source\classes\XBROWSE.PRG => TXBROWSEW:MOUSEMOVE(3192)
Called from: => TWINDOW:HANDLEEVENT(0)
[/code]

La posible solución encontrada es:
[code]METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TXBrowse

.......
.......

if ::cAlias == "ARRAY"
::nArrayAt-= ( ::RowCount() - ::nRowSel )
else
if ( ::nLen - ::RowCount() + ::nRowSel + 1) <= ::KeyNo()
::Skip( -1 ) // Correción wmormar
endif
endif
[/code]

Saludos, espero ayude

[Antonio Linares]

WIlliam,

Puedes reproducir el error en FWH\samples\TestXBrw.prg ?

[wmormar]

Antonio,

Checo y comento.

[wmormar]

Antonio,

He checado el testxbrw.prg y no da ningun problema con el bug mencionado.

Las pruebas que he hecho son con tMySql y el problema viene, porque en la xbrowse se valida Array y DBF.

Esté código lo demuestra.

Code: Select all  Expand view

        if ::cAlias == "ARRAY"
            ::nArrayAt-= ( ::RowCount() - ::nRowSel )
         else
            if ( ::nLen - ::RowCount() + ::nRowSel + 1)  <= ::KeyNo()
               ::Skip( -1 )   // Correción wmormar
            endif
         endif
 

o es array u otro.

espero me haya explicado.

saludos

[Antonio Linares]

William,

Entiendo. Luego esa modificación solo deberíamos aplicarla si se usa TMySQL.

Como podriamos detectar en el código que se está usando TMySQL ?

[wmormar]

William,

Entiendo. Luego esa modificación solo deberíamos aplicarla si se usa TMySQL.

Como podriamos detectar en el código que se está usando TMySQL ?

Antonio,

Podriamos detectar si es tmysql, colocando algo como ::classname(), Aunque pudiese darse el error con ADO de igual manera.

He colocado lo siguiente en mi definición. Bien podría ser la forma de detectar que es tmysql.

DATA nDataType; // Data type to be used: 0->rdd, 1->array, ... (more to come)
AS NUMERIC // If navigation codeblocks are not specified then get automatically
// initialiated when adjusting the browse depending on this DATA value
// 7777 -> TMySQL

::nDataType := 7777

Saludos

[Antonio Linares]

William,

Nuestra propuesta es añadir este nuevo define a include\xbrowse.ch:

Code: Select all  Expand view

#define DATATYPE_MYSQL        64
 

Los valores que tenemos ahora en include\xbrowse quedan asi:

Code: Select all  Expand view

#define DATATYPE_RDD           1
#define DATATYPE_ARRAY         2
#define DATATYPE_ADO           4
#define DATATYPE_ODBF         16
#define DATATYPE_TREE         32
#define DATATYPE_MYSQL        64
 

Podrias adaptar tu código a este define y publicar los cambios necesarios ? gracias

[Antonio Linares]

William,

Mauricio tambien ha detectado este otro cambio:
viewtopic.php?p=88421#p88421

[wmormar]

William,

Nuestra propuesta es añadir este nuevo define a include\xbrowse.ch:

Code: Select all  Expand view

#define DATATYPE_MYSQL        64
 

Los valores que tenemos ahora en include\xbrowse quedan asi:

Code: Select all  Expand view

#define DATATYPE_RDD           1
#define DATATYPE_ARRAY         2
#define DATATYPE_ADO           4
#define DATATYPE_ODBF         16
#define DATATYPE_TREE         32
#define DATATYPE_MYSQL        64
 

Podrias adaptar tu código a este define y publicar los cambios necesarios ? gracias

Claro que si Antonio,

Checando...

[wmormar]

Antonio,

Aquí las modificaciones a la xbrowse para usar la tmysql.

Code: Select all  Expand view

...
DATA oMysql       // TMySQL recordset if Method Setmysql() is used
...
METHOD SetMySql( oMysql, lAddCols, lAutoOrder, aFldNames ) // TMySql object
METHOD SetColFromMySQL( cnCol, cHeader )   // used internally from mysql
...
...

METHOD Initiate( hDlg ) CLASS TXBrowse

   ...
   ...

   if Empty( ::nDataType ) .or. Empty( ::aCols )

      if ! Empty( ::aArrayData )
         if lAnd( ::nDataType, DATATYPE_RDD )
            ::SetRDD( .t., nil, nil, ::aArrayData )
         elseif lAnd( ::nDataType, DATATYPE_ODBF ) .and. !Empty( ::oDbf )
            ::SetODbf( ::oDbf, nil, nil, .t., ::aArrayData )
         else
            ::SetArray( ::aArrayData )
         endif
      elseif ! Empty( ::oRs )
         ::SetADO( ::oRs )
      elseif ! Empty( ::oMysql )
         ::SetMysql( ::oMysql )

   ...
   ...

METHOD SetMySql( oMysql, lAddCols, lAutoOrder, aFldNames )
   LOCAL xField    := NIL
   LOCAL cHeader   := ""
   LOCAL cCol      := ""

   DEFAULT oMysql      := ::oMysql
   DEFAULT aFldNames   := {}
   DEFAULT lAddCols    :=  Empty( ::aCols ) .or. ! Empty( aFldNames )
   DEFAULT lAutoOrder  := ::lAutoSort

   ::oMysql            := oMysql

   DEFAULT ::bGoTop    := {|| If( ::oMysql:RecCount() > 0, ::oMysql:GoTop(), NIL ) },;
           ::bGoBottom := {|| If( ::oMysql:RecCount() > 0, ::oMysql:GoBottom(), nil )  },;
           ::bSkip     := {| n | ::oMysql:Skip( n ) },;
           ::bBof      := {|| ::oMysql:Bof() },;
           ::bEof      := {|| ::oMysql:Eof() },;
           ::bBookMark := {| n | If( n == nil,;
                                 If( ::oMysql:RecCount() > 0, ::oMysql:RecNo(), 0 ), ;
                                 If( ::oMysql:RecCount() > 0, ::oMysql:goto( n ), 0 ) ) }, ;
           ::bKeyNo    := {| n | If( n == nil, ;
                                 If( ::oMysql:RecCount() > 0, ::oMysql:RecNo(), 0 ), ;
                                 If( ::oMysql:RecCount() > 0, ::oMysql:Goto( n ), 0 ) ) },;
           ::bKeyCount := {|| ::oMysql:RecCount() }

   ::nDataType         := DATATYPE_MYSQL

   IF lAddCols

      IF Len(aFldNames) == 0
         aFldNames := ::oMysql:aFieldStruct
      ENDIF

      FOR EACH xField IN aFldNames
         IF Valtype( xField ) == "A" .AND. Len(xField) == 2
            cCol    := xField[1]
            cHeader := xField[2]
         ELSEIF Valtype( xField ) == "A" .AND. Len(xField) # 2
            cCol    := xField[1]
            cHeader := xField[1]
         ELSE
            cCol    := xField
            cHeader := xField
         ENDIF

         ::SetColFromMySQL( cCol, cHeader )
      NEXT

      ::bSeek  := { |c| MysqlSeek( ::oMysql, c, , ::lSeekWild ) }

   ENDIF

   if ::lCreated
      ::Adjust()
      ::Refresh()
   endif

   RETURN Self

//----------------------------------------------------------------------------//

METHOD SetColFromMySQL( cnCol, cHeader )

   LOCAL nType, cType, nLen, nDec, cName
   LOCAL oCol, nCol

   IF ValType( cnCol ) == "C"
      nCol               := ::oMysql:FieldPos( cnCol )
   ENDIF

   nCol                  := cnCol
   oCol                  := ::AddCol()
   oCol:cHeader          := cHeader
   cType                 := ::oMysql:FieldType( nCol )
   nLen                  := 0
   nDec                  := 0

   DO CASE
   CASE cType       == 'N'
      nLen               := ::oMysql:FieldLen( nCol )
      nDec               := ::oMysql:FieldDec( nCol )
      oCol:cEditPicture  := NumPict( nLen, nDec, .F., .f. )

   CASE cType       == 'C'
      nLen               := MIN( 100, ::oMysql:FieldLen( nCol ) )

   CASE cType       == 'M'
      nLen               := MIN( 100, Len(AllTrim(::oMysql:FieldGet( nCol ))) )
      nLen               := IF(nLen < 30, 30, nLen )

   CASE cType       == 'D'
      oCol:nHeadStrAlign := 2
      oCol:nDataStrAlign := 0

   CASE cType       == NIL
      // some types like adChapter( child recset), etc. can not be shown
      // programmer who uses such types should make his own coding for
      // such columns
      oCol:bEditValue    := { || "..." }

   OTHERWISE
      // just in case.  this will not be executed
      oCol:bEditValue    := { || MSGINFO( "Abriendo fronteras, wmormar...", FWDESCRIPTION ) }

   ENDCASE

   oCol:bEditValue       := { || ::oMysql:FieldGet( nCol ) }
   oCol:cDataType        := If( cType == nil, 'C', cType )
   oCol:bOnPostEdit      := { |o,x,n| If( n == VK_RETURN, ::onedit( o, x, n, cType, nCol ), NIL ) }

   RETURN oCol

//----------------------------------------------------------------------------//

static function MysqlSeek( oMysql, uSeek, lSoft, lWildSeek )

   local lFound   := .f.
   local cCol     := oMysql:cSort
   local cExpr    := ''
   local cType, d, uVal

   if ! Empty( cCol ) .and. ! oMysql:Eof() .and. ! oMysql:Bof()

      DEFAULT lSoft := Set(_SET_SOFTSEEK), lWildSeek := .f.

      uVal   := oMysql:FieldGet( cCol )
      cType  := oMysql:FieldType( cCol )

      do case
      case cType == 'C'

         if lWildSeek
            lSoft    := .f.
            cExpr    := cCol + " LIKE '%" + uSeek + "%'"
         else
            cExpr    := If( Set( _SET_EXACT ), cCol + " = '" + uSeek + "'", ;
                                               cCol + " LIKE '" + uSeek + "%'" )
         endif

      case cType == 'N'
         cExpr    := cCol + " >= " + ;
                     LTrim( Str( Val( uSeek ) ) )
      case cType == 'D'

         if Empty( d := CToD( uSeek ) )
            d  := CToD( uSeek + SubStr( DToC( uVal ), Len( uSeek ) + 1 ) )
         endif
         if ! Empty( d )
            cExpr    := cCol + " >= #" + ;
                        StrZero( Year( d ), 4 ) + "-" + ;
                        StrZero( Month( d ), 2 ) + "-" + ;
                        StrZero( Day( d ), 2 ) + "#"

         endif
      endcase

      if ! Empty( cExpr )
         oMysql:WSeekplus( cExpr, oMysql:cSort, oMysql:recno() )
         if oMysql:Eof() .and. lSoft .and. cType == 'C'
            oMysql:GoTop()
            cExpr := cCol + " > '" + uSeek + "'"
            oMysql:WSeekplus( cExpr, oMysql:cSort, oMysql:recno() )
         endif
         if oMysql:Eof()
            oMysql:GoBottom()
         else
            lFound   := .t.
         endif
      endif

   endif


return lFound

//----------------------------------------------------------------------------//

METHOD Adjust() CLASS TXBrwColumn

      ....
      ....
      ....

      DEFAULT ::bOnPostEdit := { |o,x,n| If( n != VK_ESCAPE, ::Value := x,) }

      if ::cSortOrder != nil
         if ValType( ::cSortOrder ) != 'B'
            if ( ::oBrw:nDataType == DATATYPE_RDD )
               if EQ( (::oBrw:cAlias)->( OrdSetFocus() ), ::cSortOrder )
                  ::cOrder       := 'A'
               endif
            elseif ( ::oBrw:nDataType == DATATYPE_ADO )
               if EQ( ::oBrw:oRs:Sort, ::cSortOrder )
                  ::cOrder       := 'A'
               endif
            elseif ( ::oBrw:nDataType == DATATYPE_MYSQL )
               if EQ( ::oBrw:oMysql:cSort, ::cSortOrder )
                  ::cOrder       := 'A'
               endif

....................
............................

METHOD SetOrder() CLASS TXBrwColumn

............................
............................

      elseif nAnd( ::oBrw:nDataType, DATATYPE_ADO ) == DATATYPE_ADO .and. ;
         ::oBrw:oRs != nil

         cSort   := Upper( ::oBrw:oRs:Sort )
         cSort   := TRIM( StrTran( StrTran( cSort, 'DESC', '' ), 'ASC', '' ) )
         if EQ( cSort, ::cSortOrder )
            // Asc -> Desc or Desc -> Asc
            if ::cOrder == 'D'
               ::oBrw:oRs:Sort   := ::cSortOrder
               ::cOrder          := 'A'
            else
               ::oBrw:oRs:Sort   := ::cSortOrder + " DESC"
               ::cOrder          := 'D'
            endif
            lSorted      := .T.
         else
            // Asc Sort
            ::oBrw:oRs:Sort      := ::cSortOrder
            For n := 1 TO Len(::oBrw:aCols)
               oCol   := ::oBrW:aCols[ n ]
               oCol:cOrder       := " "
            Next n
            ::cOrder             := 'A'
            lSorted              := .T.
         endif

      elseif nAnd( ::oBrw:nDataType, DATATYPE_MYSQL ) == DATATYPE_MYSQL .and. ;
         ::oBrw:oMysql != nil

         cSort   := Upper( ::oBrw:oMysql:cSort )
         cSort   := TRIM( StrTran( StrTran( cSort, 'DESC', '' ), 'ASC', '' ) )
         if EQ( cSort, ::cSortOrder )
            // Asc -> Desc or Desc -> Asc
            if ::cOrder == 'D'
               ::oBrw:oMysql:cSort := ::cSortOrder
               ::cOrder            := 'A'
            else
               ::oBrw:oMysql:cSort := ::cSortOrder + " DESC"
               ::cOrder            := 'D'
            endif
            lSorted      := .T.
         else
            // Asc Sort
            ::oBrw:oMysql:Sort      := ::cSortOrder
            For n := 1 TO Len(::oBrw:aCols)
               oCol   := ::oBrW:aCols[ n ]
               oCol:cOrder       := " "
            Next n
            ::cOrder             := 'A'
            lSorted              := .T.
         endif

      elseif nAnd( ::oBrw:nDataType, DATATYPE_ODBF ) == DATATYPE_ODBF .and. ;

............................
............................

static function XbrwSetDataSource( oBrw, uDataSrc, lAddCols, lAutoSort, aCols, aRows  )

............................
............................

   elseif cType == 'O'

      if Upper( uDataSrc:ClassName() ) == "TMYSQL"

         oBrw:nDataType := DATATYPE_MYSQL
         oBrw:oMysql       := uDataSrc
         if lAddCols .or. ! Empty( aCols )
            oBrw:SetMysql( uDataSrc, lAddCols, lAutoSort, aCols )
         endif

      elseif Upper( uDataSrc:ClassName ) == "TOLEAUTO"

............................
............................

Esas son todas las modificaciones para usar tmysql con xbrowse.

A continuación un ejemplo

Code: Select all  Expand view

/*

  INCOS
  William Morales

  http://incos...net
  http://incos...net/fivewin

  wmormar@hotmail.com

  TXBrowse()

*/

#include 'fivewin.ch'

*-------------------*
STATIC oServer
STATIC oQry
STATIC oBrw
STATIC oWnd
STATIC oMenu

FUNCTION main()
   LOCAL cHost  := "localhost"
   LOCAL cUser  := "user"
   LOCAL cPsw   := "psw"
   LOCAL nPort  := 3306
   LOCAL cDb    := "test"
   LOCAL n      := 1
   LOCAL cQuery := ""

   MENU oMenu 2007
      MENUITEM "Pruebas"
      MENU
         MENUITEM "AddRecord 1" ACTION addrecord1() MESSAGE "Adiciona registros a la tabla 1"
         MENUITEM "AddRecord 2" ACTION addrecord2() MESSAGE "Adiciona registros a la tabla 2"
         MENUITEM "UpdateRecord" ACTION updaterecord2() MESSAGE "Modifica registros a la tabla 2"
      ENDMENU
   ENDMENU

   oServer:= TMySQLServer():New( cHost, cUser, cPsw, nPort )
   if oServer:NetErr()
      MsgAlert (oServer:Error(),"MySQL Error")
      quit
   endif

   IF oServer:lError
      ? "No connect"
      RETURN NIL
   ENDIF

   oserver:Selectdb(cDb)

   IF oServer:lError
      ? "No used database"
      RETURN NIL
   ENDIF

   IF !oServer:tableexist( "prueba" )
      cQuery := "CREATE TABLE prueba( "
      cQuery += "clave varchar(3) NOT NULL default '0',"
      cQuery += "nombre varchar(30) default 'x',"
      cQuery += "fecha date default '20091012',"
      cQuery += "saldo decimal(9,2) default 0.00,"
      cQuery += "PRIMARY KEY  (clave) "
      cQuery += ") ENGINE=InnoDB DEFAULT CHARSET=latin1"
      oServer:execute( cQuery )
   ENDIF

   oServer:execute( "TRUNCATE TABLE prueba" )
   oQry   := oServer:Query( "SELECT * FROM prueba" )

   oQry:gotop()
   wmbrowse()

   return nil

/************************************************************/
STATIC FUNCTION wmbrowse()
   DEFINE WINDOW oWnd TITLE "Mi browse" FROM 10, 10 TO 30, 60 MENU oMenu

      wmbrw()
      oWnd:oClient := oBrw

   ACTIVATE WINDOW oWnd

RETURN NIL

STATIC FUNCTION wmbrw()
   LOCAL oCol

   oBrw := TXBrowse():new( oWnd )
   oBrw:Setmysql( oQry )
   oBrw:createfromcode()

   RETURN NIL

STATIC FUNCTION addrecord1()
   LOCAL n, nClv

   FOR n := 1 TO 15
      nClv := alltrim(str( HB_RandomInt( 999 ) ))
      oQry:fieldput( "clave" , nClv )
      oQry:fieldput( "nombre", "prueba1 - " + nClv )
      oQry:fieldput( "fecha" , date() )
      oQry:fieldput( "saldo" , HB_RandomInt( 99999999.99 ) )
      oQry:append()
   NEXT

   oBrw:refresh()

   RETURN NIL

STATIC FUNCTION addrecord2()
   LOCAL n, nClv

   FOR n := 1 TO 15
      nClv := alltrim(str( HB_RandomInt( 999 ) ))
      oQry:blank()
      oQry:clave  := nClv
      oQry:nombre := "prueba2 - " + nClv
      oQry:fecha  := date()
      oQry:saldo  := HB_RandomInt( 99999999.99 )
      oQry:save()
   NEXT

   oBrw:refresh()

   RETURN NIL

STATIC FUNCTION updaterecord2()
   LOCAL n, nClv

   oQry:gotop()
   WHILE !oQry:eof()
      nClv := alltrim(str( HB_RandomInt( 999 ) ))
      oQry:nombre := "CAMBIADO - " + nClv
      oQry:fecha  := date()
      oQry:saldo  := HB_RandomInt( 99999999.99 )
      oQry:save()
      oQry:skip()
   ENDDO

   oBrw:refresh()

   RETURN NIL

Espero sea de ayuda, los errores reportados de bSeek y onmouse.

PD. en el blog FWH TMYSQL Y MAS se encuentra la lib para descarga

[Antonio Linares]

William,

Muchas gracias

Lo incluimos en FWH 9.10 con tu permiso, gracias!

[wmormar]

William,

Muchas gracias

Lo incluimos en FWH 9.10 con tu permiso, gracias!

Antonio,

Es todo un gusto.

y te he enviado el xbrowse.prg completo a tu correo.

[Antonio Linares]

William,

Fichero recibido, gracias nuevamente!

Cuenta con un FWH 9.10 gratuito como muestra de gratitud por tu ayuda, siempre tan valiosa

[wmormar]

William,

Fichero recibido, gracias nuevamente!

Cuenta con un FWH 9.10 gratuito como muestra de gratitud por tu ayuda, siempre tan valiosa

Enterado.

Gracias a ti