no me funciona correctamente ON CHANGE

colthop
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

no me funciona correctamente ON CHANGE

Post by colthop »

Hola a todos:

Estoy actualizando unas cosas en un programa para la Pocket y me encuentro con el siguiente problema, cuando pongo un GET con la clausula ON CHANGE funciona aparentemente correctamente pero no me actualiza la variable veamos. El fuente es:

Code: Select all

PROCEDURE BusqClie99()
ShowKeyBoard()
SELECT 8
go top

vb021 = space(9)
vb022 = space(30)
vb023 = space(12)
@  0*ProporV,  0*ProporH say bDlg021 VAR LocaText( 35,4) OF oVentPrinc PIXEL COLOR fondo3, escri3 FONT oFont SIZE 480*ProporH,30*ProPorV CENTER BORDER
@  0*ProporV,  0*ProporH GROUP oDlgwBCl TO  60*ProporV,480*ProporH OF oVentPrinc PIXEL COLOR escri1, fondo1
@ 32*ProporV,  2*ProporH SAY bDlg023 VAR "N"             OF oDlgwBCl PIXEL COLOR escri1, fondo1 FONT oFont SIZE  18*ProporH,26*ProPorV
@ 32*ProporV,124*ProporH SAY bDlg024 VAR "D"             OF oDlgwBCl PIXEL COLOR escri1, fondo1 FONT oFont SIZE  18*ProporH,26*ProPorV
@ 32*ProporV,246*ProporH SAY bDlg025 VAR "C"             OF oDlgwBCl PIXEL COLOR escri1, fondo1 FONT oFont SIZE  18*ProporH,26*ProPorV
@ 32*ProporV, 20*ProporH GET bDlg026 VAR vb021           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!"                      ON CHANGE busqclie992(1)
@ 32*ProporV,140*ProporH GET bDlg027 VAR vb022           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" ON CHANGE busqclie992(2)
@ 32*ProporV,260*ProporH GET bDlg028 VAR vb023           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!!!!"                   ON CHANGE busqclie992(3)
@ 30*ProPorV,382*ProPorH BUTTON bDlg029 PROMPT LocaText( 20,1) OF oDlgwBCl PIXEL SIZE  98*ProPorH,30*ProPorV FONT oFont ACTION BusqClie991()
@ 60*ProporV,  5*ProporH LISTBOX bDlg032 ;
      FIELDS  clientes->codigo, clientes->nombre, clientes->cif   ;
      HEADERS LocaText( 33,2) , LocaText( 33,3) , LocaText( 30,4);
      ON LEFT DBLCLICK BusqClie991();
      SIZE 475*ProporV, 430*ProporH PIXEL UPDATE
bDlg026:SetFocus()
RETURN (NIL)

FUNCTION busqclie991()
HideKeyBoard()
bDlg021:End()
bDlg032:Hide()
bDlg032:Destroy()
oDlgwBCl:Hide()
oDlgwBCl:Destroy()
vb032 = recno()
OrdSetfocus (wea)
go vb032
run (&buscli01)
RETURN (NIL)

FUNCTION ,busqclie992(wOpcPr)
bDlg026:Refresh()
bDlg027:Refresh()
bDlg028:Refresh()
do case
  case wOpcPr = 1

msginfo(vb021)

    xOp = bDlg026:nPos()
    bDlg026:End()
    bDlg027:End()
    bDlg028:End()
    vb022 = space(30)
    vb023 = space(12)
    OrdSetfocus(wea)
    seek trim(vb021)
    if ! eof()
      bDlg032:Refresh()
    endif
    @ 32*ProporV, 20*ProporH GET bDlg026 VAR vb021           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 110*ProporH,26*ProPorV PICT "!!!!!!!!!"                      ON CHANGE busqclie992(1)
    @ 32*ProporV,150*ProporH GET bDlg027 VAR vb022           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 110*ProporH,26*ProPorV PICT "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" ON CHANGE busqclie992(2)
    @ 32*ProporV,280*ProporH GET bDlg028 VAR vb023           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 110*ProporH,26*ProPorV PICT "!!!!!!!!!!!!"                   ON CHANGE busqclie992(3)
    bDlg026:SetPos(xOp)
    bDlg026:SetFocus()
  case wOpcPr = 2
    xOp = bDlg027:nPos()
    bDlg026:End()
    bDlg027:End()
    bDlg028:End()
    vb021 = space(9)
    vb023 = space(12)
    OrdSetfocus(web)
    seek trim(vb022)
    if ! eof()
      bDlg032:Refresh()
    endif
    @ 32*ProporV, 20*ProporH GET bDlg026 VAR vb021           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 110*ProporH,26*ProPorV PICT "!!!!!!!!!"                      ON CHANGE busqclie992(1)
    @ 32*ProporV,150*ProporH GET bDlg027 VAR vb022           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 110*ProporH,26*ProPorV PICT "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" ON CHANGE busqclie992(2)
    @ 32*ProporV,280*ProporH GET bDlg028 VAR vb023           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 110*ProporH,26*ProPorV PICT "!!!!!!!!!!!!"                   ON CHANGE busqclie992(3)
    bDlg027:SetPos(xOp)
    bDlg027:SetFocus()
  case wOpcPr = 3
    xOp = bDlg028:nPos()
    bDlg026:End()
    bDlg027:End()
    bDlg028:End()
    vb021 = space(9)
    vb022 = space(30)
    OrdSetfocus(wec)
    seek trim(vb023)
    if ! eof()
      bDlg032:Refresh()
    endif
    @ 32*ProporV, 20*ProporH GET bDlg026 VAR vb021           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 110*ProporH,26*ProPorV PICT "!!!!!!!!!"                      ON CHANGE busqclie992(1)
    @ 32*ProporV,150*ProporH GET bDlg027 VAR vb022           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 110*ProporH,26*ProPorV PICT "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" ON CHANGE busqclie992(2)
    @ 32*ProporV,280*ProporH GET bDlg028 VAR vb023           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 110*ProporH,26*ProPorV PICT "!!!!!!!!!!!!"                   ON CHANGE busqclie992(3)
    bDlg028:SetPos(xOp)
    bDlg028:SetFocus()
endcase
RETURN (NIL)
Presenta una pantalla con tres GET y una LISTBOX y el proceso sería que cuando introducimos cualquier tecla en uno de los GET este salte a la función busclie992 y aquí actualice la LISTBOX con el dato introducido pero cuando llega no actualiza el dato que he introducido y deja el anterior, si por ejemplo pongo un "4" en el primer GET cuando llega ala línea donde esta el "MsgInfo(vb021)" me pone blancos en vez de "4" cn ocho blancos.

Alguien me podría ayudar para solucionar este caso.

Un saludo

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: no me funciona correctamente ON CHANGE

Post by Antonio Linares »

Carlos,

Desde la función que llamas en el ON CHANGE recoge el valor de la variable haciendo oGet:GetText() puesto que el evento se dispara antes de que el GET haya cambiado su valor, pero el texto si queda escrito
regards, saludos

Antonio Linares
www.fivetechsoft.com
colthop
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: no me funciona correctamente ON CHANGE

Post by colthop »

Hola Antonio:

Me podrías indicar para torpes como yo la solución ¿es hacer oGet:GetText()? ¿en donde? .

Un saludo

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: no me funciona correctamente ON CHANGE

Post by Antonio Linares »

Carlos,

@ ..., ... GET oGet VAR cValue ... ON CHANGE MiFuncion( oGet )

...

function MiFuncion( oGet )

oGet:GetText() es el valor que tendrá cValue pero que aún no se le ha asignado

return ...
regards, saludos

Antonio Linares
www.fivetechsoft.com
colthop
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: no me funciona correctamente ON CHANGE

Post by colthop »

Hola Antonio:

Siguiendo tus indicaciones he cambiado el código de esta manera:

Code: Select all

PROCEDURE BusqClie99()
ShowKeyBoard()
SELECT 8
go top
vb021 = space(9)
vb022 = space(30)
vb023 = space(12)
@  0*ProporV,  0*ProporH say bDlg021 VAR LocaText( 35,4) OF oVentPrinc PIXEL COLOR fondo3, escri3 FONT oFont SIZE 480*ProporH,30*ProPorV CENTER BORDER
@  0*ProporV,  0*ProporH GROUP oDlgwBCl TO  60*ProporV,480*ProporH OF oVentPrinc PIXEL COLOR escri1, fondo1
@ 32*ProporV,  2*ProporH SAY bDlg023 VAR "N"             OF oDlgwBCl PIXEL COLOR escri1, fondo1 FONT oFont SIZE  18*ProporH,26*ProPorV
@ 32*ProporV,124*ProporH SAY bDlg024 VAR "D"             OF oDlgwBCl PIXEL COLOR escri1, fondo1 FONT oFont SIZE  18*ProporH,26*ProPorV
@ 32*ProporV,246*ProporH SAY bDlg025 VAR "C"             OF oDlgwBCl PIXEL COLOR escri1, fondo1 FONT oFont SIZE  18*ProporH,26*ProPorV
@ 32*ProporV, 20*ProporH GET bDlg026 VAR vb021           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!"                      ON CHANGE busqclie992(bDlg026)
@ 32*ProporV,140*ProporH GET bDlg027 VAR vb022           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" ON CHANGE busqclie993(bDlg027)
@ 32*ProporV,260*ProporH GET bDlg028 VAR vb023           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!!!!"                   ON CHANGE busqclie994(bDlg028)
@ 30*ProPorV,382*ProPorH BUTTON bDlg029 PROMPT LocaText( 20,1) OF oDlgwBCl PIXEL SIZE  98*ProPorH,30*ProPorV FONT oFont ACTION BusqClie991()
@ 60*ProporV,  5*ProporH LISTBOX bDlg032 ;
      FIELDS  clientes->codigo, clientes->nombre, clientes->cif   ;
      HEADERS LocaText( 33,2) , LocaText( 33,3) , LocaText( 30,4);
      ON LEFT DBLCLICK BusqClie991();
      SIZE 475*ProporV, 430*ProporH PIXEL UPDATE
bDlg026:SetFocus()
RETURN (NIL)

FUNCTION busqclie991()
HideKeyBoard()
bDlg021:End()
bDlg032:Hide()
bDlg032:Destroy()
oDlgwBCl:Hide()
oDlgwBCl:Destroy()
vb032 = recno()
OrdSetfocus (wea)
go vb032
run (&buscli01)
RETURN (NIL)

FUNCTION busqclie992(bDlg026)
bDlg026:GetText()

msginfo(vb021)

xOp = len(trim(vb021))
bDlg026:End()
bDlg027:End()
bDlg028:End()
vb022 = space(30)
vb023 = space(12)
OrdSetfocus(wea)
seek trim(vb021)
if ! eof()
  bDlg032:Refresh()
endif
@ 32*ProporV, 20*ProporH GET bDlg026 VAR vb021           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!"                      ON CHANGE busqclie992(bDlg026)
@ 32*ProporV,140*ProporH GET bDlg027 VAR vb022           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" ON CHANGE busqclie993(bDlg027)
@ 32*ProporV,260*ProporH GET bDlg028 VAR vb023           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!!!!"                   ON CHANGE busqclie994(bDlg028)
bDlg026:SetPos(xOp)
bDlg026:SetFocus()
RETURN (NIL)

FUNCTION busqclie993(bDlg027)
bDlg027:GetText()

msginfo(vb022)

xOp = len(trim(vb022))
bDlg026:End()
bDlg027:End()
bDlg028:End()
vb021 = space(9)
vb023 = space(12)
OrdSetfocus(web)
seek trim(vb022)
if ! eof()
  bDlg032:Refresh()
endif
@ 32*ProporV, 20*ProporH GET bDlg026 VAR vb021           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!"                      ON CHANGE busqclie992(bDlg026)
@ 32*ProporV,140*ProporH GET bDlg027 VAR vb022           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" ON CHANGE busqclie993(bDlg027)
@ 32*ProporV,260*ProporH GET bDlg028 VAR vb023           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!!!!"                   ON CHANGE busqclie994(bDlg028)
bDlg027:SetPos(xOp)
bDlg027:SetFocus()
RETURN (NIL)

FUNCTION busqclie994(bDlg028)
bDlg028:GetText()

msginfo(vb023)

xOp = len(trim(vb023))
bDlg026:End()
bDlg027:End()
bDlg028:End()
vb021 = space(9)
vb022 = space(30)
OrdSetfocus(wec)
seek trim(vb023)
if ! eof()
  bDlg032:Refresh()
endif
@ 32*ProporV, 20*ProporH GET bDlg026 VAR vb021           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!"                      ON CHANGE busqclie992(bDlg026)
@ 32*ProporV,140*ProporH GET bDlg027 VAR vb022           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" ON CHANGE busqclie993(bDlg027)
@ 32*ProporV,260*ProporH GET bDlg028 VAR vb023           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!!!!"                   ON CHANGE busqclie994(bDlg028)
bDlg028:SetPos(xOp)
bDlg028:SetFocus()
RETURN (NIL)
Creo que es lo que tu me has indicado pero sigue sin traspasar el valor. Donde he cometido ahora el error.

Un saludo

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
User avatar
cnavarro
Posts: 5792
Joined: Wed Feb 15, 2012 8:25 pm
Location: España

Re: no me funciona correctamente ON CHANGE

Post by cnavarro »

Prueba asi

Code: Select all

FUNCTION busqclie992(bDlg026)
vb021 := bDlg026:GetText()

.../...
 
C. Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
Si alguien te dice que algo no se puede hacer, recuerda que esta hablando de sus limitaciones, no de las tuyas.
colthop
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: no me funciona correctamente ON CHANGE

Post by colthop »

Hola Cristóbal:

Gracias por tu interés lo he probado y sigue igual, he puesto :

Code: Select all

@ 32*ProporV, 20*ProporH GET bDlg026 VAR vb021           OF oDlgwBCl PIXEL COLOR escri2, fondo2 FONT oFont SIZE 100*ProporH,26*ProPorV PICT "!!!!!!!!!"                      ON CHANGE msginfo(bDlg026:GetText())
Para ver que valor pasa y da igualmente el que había al principio.

Un saludo

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
colthop
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: no me funciona correctamente ON CHANGE

Post by colthop »

Hola Antonio:

¿Lo he realizado correctamente?

Un saludo

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: no me funciona correctamente ON CHANGE

Post by Antonio Linares »

Que te aparece en el GET y que aparece en el MsgInfo() ?
regards, saludos

Antonio Linares
www.fivetechsoft.com
colthop
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: no me funciona correctamente ON CHANGE

Post by colthop »

Hola Antonio:

Analizando lo que me has dicho que hace antes el ON CHANGE que el reemplazar el GET, he cogido la clase tGet y la he modificado para que me funcione. Estoy modificando esta parte:

Code: Select all

METHOD KeyChar( nKey, nFlags ) CLASS TGet

...
...
...

      case nKey >= 32 .and. nKey < 256

           #ifdef __HARBOUR__
           // <lk> deadkey+tab [or enter] previously pressed will cause a r/t error
              if ::oGet:buffer == nil
                 return 0
              endif
           #endif

           ::GetSelPos( @nLo, @nHi )
           // Delete selection
           if nHi != nLo
              ::GetDelSel( nLo, nHi )
              ::EditUpdate()
           endif
           if ::oGet:Type == "N" .and. ;
              ( Chr( nKey ) == "." .or. Chr( nKey ) == "," )
              ::oGet:ToDecPos()
           else

desde aqui

              if ::bChange != nil
                 lAccept = Eval( ::bChange, nKey, nFlags, Self )
                 if ValType( lAccept ) == "L" .and. ! lAccept
                    return 0
                 endif
              endif

hasta aqui

              if Set( _SET_INSERT )             // many thanks to HMP
                 ::oGet:Insert( Chr( nKey ) )
              else
                 ::oGet:Overstrike( Chr( nKey ) )
              end
           endif
           if ::oGet:Rejected
              MsgBeep()
           endif
           ::EditUpdate()
           if ::oGet:TypeOut
              if ! Set( _SET_CONFIRM )
                 ::oWnd:nLastKey = VK_RETURN  // VK_DOWN 17/10/95
                 ::oWnd:GoNextCtrl( ::hWnd )
              else
                 MsgBeep()
              endif
           endif

      otherwise
           return Super:KeyChar( nKey, nFlags )
   endcase

return 0
Lo he cambiado de sitio y lo he dejado así:

Code: Select all

METHOD KeyChar( nKey, nFlags ) CLASS TGet
...
...
...

      case nKey >= 32 .and. nKey < 256

           #ifdef __HARBOUR__
           // <lk> deadkey+tab [or enter] previously pressed will cause a r/t error
              if ::oGet:buffer == nil
                 return 0
              endif
           #endif

           ::GetSelPos( @nLo, @nHi )
           // Delete selection
           if nHi != nLo
              ::GetDelSel( nLo, nHi )
              ::EditUpdate()
           endif
           if ::oGet:Type == "N" .and. ;
              ( Chr( nKey ) == "." .or. Chr( nKey ) == "," )
              ::oGet:ToDecPos()
           else
              if Set( _SET_INSERT )             // many thanks to HMP
                 ::oGet:Insert( Chr( nKey ) )
              else
                 ::oGet:Overstrike( Chr( nKey ) )
              end
           endif
           if ::oGet:Rejected
              MsgBeep()
           endif
           ::EditUpdate()
           if ::oGet:TypeOut
              if ! Set( _SET_CONFIRM )
                 ::oWnd:nLastKey = VK_RETURN  // VK_DOWN 17/10/95
                 ::oWnd:GoNextCtrl( ::hWnd )
              else
                 MsgBeep()
              endif
           endif

lo he puesto aquí

           if ::bChange != nil
                lAccept = Eval( ::bChange, nKey, nFlags, Self )
                if ValType( lAccept ) == "L" .and. ! lAccept
                   return 0
                endif
           endif...
...
...

return 0
Y parece que lo hace bien. Solo me falta que si es el INTRO o el punto decimal no lo haga.

Un saludo

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: no me funciona correctamente ON CHANGE

Post by Antonio Linares »

Carlos,

Insisto:
Que te aparece en el GET y que aparece en el MsgInfo() ?

bChange recibe nKey como primer parámetro y ahi es donde puedes comprobar si es Intro ó el punto decimal
regards, saludos

Antonio Linares
www.fivetechsoft.com
colthop
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: no me funciona correctamente ON CHANGE

Post by colthop »

Hola Antonio:

Disculpa que no te contestase a tu pregunta. En el Msginfgo y en el Get se quedaban como estaban si entraban en blanco en blanco y si al iniciar le ponía un 4 era un 4.

Lo del Intro ya lo he solucionado y ha sido de la siguiente manera:

Code: Select all

METHOD KeyChar( nKey, nFlags ) CLASS TGet

   local nHi, nLo
   local lAccept
   local bKeyAction := SetKey( nKey )
   local nDefButton

   if ! Empty( ::cPicture ) .and. '@!' $ ::cPicture
        nKey = Asc( Upper( Chr( nKey ) ) )
   endif

   if bKeyAction != nil .and. lAnd( nFlags, 16777216 ) // function Key
      Eval( bKeyAction, ProcName( 4 ), ProcLine( 4 ), Self )
      return 0         // Already processed, API do nothing
   endif

   if ::lReadOnly
      if nKey == VK_ESCAPE
         ::oWnd:End()
      endif
      return 0
   endif

   do case
      case nKey == VK_BACK       // Already processed at KeyDown
           return 0

      //case nKey == VK_ESCAPE
      //     return 0

      case nKey == VK_TAB .and. GetKeyState( VK_SHIFT )
*           if ::bChange != nil
*              lAccept = Eval( ::bChange, nKey, nFlags, Self )
*              if ValType( lAccept ) == "L" .and. lAccept
*                 if Upper( ::oWnd:ClassName() ) == "TCOMBOBOX"
*                    ::oWnd:oWnd:GoPrevCtrl( ::hWnd )
*                 else
*                    ::oWnd:GoPrevCtrl( ::hWnd )
*                 endif
*              endif
*           else
              if Upper( ::oWnd:ClassName() ) == "TCOMBOBOX"
                 ::oWnd:oWnd:GoPrevCtrl( ::hWnd )
              else
                 ::oWnd:GoPrevCtrl( ::hWnd )
              endif
*           endif
           return 0

      case nKey == VK_TAB .or. nKey == VK_RETURN
*           if ::bChange != nil
*              lAccept = Eval( ::bChange, nKey, nFlags, Self )
*              if ValType( lAccept ) == "L" .and. lAccept
*                 ::oWnd:GoNextCtrl( ::hWnd )
*              endif
*           else
              ::oWnd:GoNextCtrl( ::hWnd )
*           endif

           #ifdef __HARBOUR__
               if nKey == VK_RETURN  // Execute DEFPUSHBUTTON Action
                  Super:KeyChar( nKey, nFlags )
               endif
           #endif

           return 0

      case nKey >= 32 .and. nKey < 256

           #ifdef __HARBOUR__
           // <lk> deadkey+tab [or enter] previously pressed will cause a r/t error
              if ::oGet:buffer == nil
                 return 0
              endif
           #endif

           ::GetSelPos( @nLo, @nHi )
           // Delete selection
           if nHi != nLo
              ::GetDelSel( nLo, nHi )
              ::EditUpdate()
           endif
           if ::oGet:Type == "N" .and. ;
              ( Chr( nKey ) == "." .or. Chr( nKey ) == "," )
              ::oGet:ToDecPos()
           else
              if Set( _SET_INSERT )             // many thanks to HMP
                 ::oGet:Insert( Chr( nKey ) )
              else
                 ::oGet:Overstrike( Chr( nKey ) )
              end
           endif
           if ::oGet:Rejected
              MsgBeep()
           endif
           ::EditUpdate()
           if ::oGet:TypeOut
              if ! Set( _SET_CONFIRM )
                 ::oWnd:nLastKey = VK_RETURN  // VK_DOWN 17/10/95
                 ::oWnd:GoNextCtrl( ::hWnd )
              else
                 MsgBeep()
              endif
           endif

           if ::bChange != nil .AND. ::oWnd:nLastKey <> VK_RETURN  // VK_DOWN 17/10/95
             lAccept = Eval( ::bChange, nKey, nFlags, Self )
             if ValType( lAccept ) == "L" .and. ! lAccept
                return 0
             endif
           endif...


      otherwise
           return Super:KeyChar( nKey, nFlags )
   endcase

return 0
 
En el mismo METHOD cuando se pulsaba el INTRO chequeaba el ON CHANGE cosa que creo no se debería hacer ya que si pulsamos INTRO no cambia nada solo aceptamos lo que hay y por el mismo motivo quite el ON CHANGE del TABULADOR. Lo del punto decimal lo he dejado por no afectarme, pero creo que sería fácil ya que bastaría chequear si el campo es Númerico y se ha pulsado "." o "," igual que haces un poco mas arriba:

Code: Select all

 
if ::oGet:Type == "N" .and. ( Chr( nKey ) == "." .or. Chr( nKey ) == "," )
 
Míralo y si existe algún problema que yo no veo por favor dímelo.

Un saludo y gracias por tu ayuda.

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: no me funciona correctamente ON CHANGE

Post by Antonio Linares »

Carlos,

Aunque ON CHANGE parece que se debiera procesar solo cuando cambia el GET, en realidad se evalúa para cualquier tecla que se procese.

Tus cambios me parecen correctos, aunque no se si puedan darle problemas a otros usuarios si lo cambiamos en la librería.

Si te funciona bien así, pues perfecto :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
colthop
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: no me funciona correctamente ON CHANGE

Post by colthop »

Hola Antonio:

OK. Te comento lo del INTRO por lo que me pasaba a mi, que yo evaluaba el cambio y volvía al mismo GET y cuando pulsaba INTRO pasaba al siguiente y al evaluar el ON CHANGE volvía atrás y nunca salía del GET. Pero me parece correcto no modificar las librerías sino lo ves oportuno sabiendo la solución se puede siempre aplicar.

Un saludo

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: no me funciona correctamente ON CHANGE

Post by Antonio Linares »

Carlos,

Es que tocar la clase TGet es delicado ya que afecta a muchos usuarios en muchas aplicaciones.

Salvo que sea un problema generalizado que otros usuarios estén teniendo.

Si a ti te funciona bien asi, perfecto :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
Post Reply