Ctrl+C e Ctrl+V no xHarbour...

Mensagem por **vailton** » 24 Abr 2009 14:14

Alguns "desenvolvedores" do xHB estão copiando código fonte do projeto Harbour sem avaliar corretamente as conseguencias dos atos. Com isto alguns bugs sérios estão sendo introduzidos no kernel do xHarbour.

Um destes bugs já introduzidos como consequencia do CTRL+C e CTRL+V detectados foi no DBSeek que se comporta como se o índice estivesse corrompido.

Leitura interessante esta,
http://lists.harbour-project.org/piperm ... 18630.html

deividdjs · Mensagem por **deividdjs** » 20 Set 2022 10:39

Bom dia..

Estou utilizando um GETSYS.PRG para resolver e resolveu um problema q eu tinha na digitação de campos numericos ... porém não consigo mais utilizar o CRTL + C e CTRL + V para copiar e colar nos gets como funcionava anteriormente ... e já tentei de várias formas e todas sem sucesso .. alguem consegue me dar uma força ??

umas das minhas tentativas ... e nada funciona !

Código: Selecionar todos

//SetKey(K_CTRL_C, {|| Wvt_GetClipboard() } )
//SetKey(K_CTRL_V, {|| WVT_PasteFromClipboard() })

Abraços

Deivid

Mensagem por **alxsts** » 20 Set 2022 13:36

Olá!

Veja este tópico

deividdjs · Mensagem por **deividdjs** » 20 Set 2022 14:17

alxsts escreveu:Olá!

Veja este tópico

tentei compilar o codigo deste topido dá erro .. não funciona para xharbour ??

Mensagem por **alxsts** » 20 Set 2022 14:33

Olá!

Posderia informar qual foi o erro?

deividdjs · Mensagem por **deividdjs** » 20 Set 2022 16:07

Código: Selecionar todos

#include "hbgtinfo.ch"

FUNCTION ACTCOPYPASTE()
//activa COPY / PASTE
  hb_gtInfo( HB_GTI_INKEYFILTER, { | nKey |
      LOCAL nBits, lIsKeyCtrl
      SWITCH nKey
      CASE K_MWBACKWARD
         RETURN K_DOWN
      CASE K_MWFORWARD
         RETURN K_UP
      CASE K_RBUTTONDOWN
         RETURN K_ESC
      CASE K_RDBLCLK
         RETURN K_ESC
      CASE K_LDBLCLK
         RETURN K_ENTER
      CASE K_CTRL_V
         nBits := hb_GtInfo( HB_GTI_KBDSHIFTS )
         lIsKeyCtrl := ( nBits == hb_BitOr( nBits, HB_GTI_KBD_CTRL ) )
         IF lIsKeyCtrl
            hb_GtInfo( HB_GTI_CLIPBOARDPASTE )
            RETURN 0
         ENDIF
      CASE K_CTRL_C
         nBits := hb_gtInfo( HB_GTI_KBDSHIFTS )
         lIsKeyCtrl := ( nBits == hb_BitOr( nBits, HB_GTI_KBD_CTRL ) )
         IF lIsKeyCtrl
             MSGBOX( "Copiado al portapapeles" )
            IF GetActive() != NIL
               hb_gtInfo( HB_GTI_CLIPBOARDDATA, Transform( GetActive():VarGet(), "" ) )
               RETURN 0
            ENDIF
         ENDIF
      ENDSWITCH
      RETURN nKey
       } )  
   SET( _SET_EVENTMASK, INKEY_ALL )
RETURN

DIZ O ERRO q é na DELIMITAÇÃO ( { } )

porem pelo que vejo está tudo ok ... não esta ?

Mensagem por **alxsts** » 20 Set 2022 16:51

Olá!

deividdjs escreveu:DIZ O ERRO q é na DELIMITAÇÃO ( { } )

Nunca vi este erro...

Facilite o processo de ajuda.

Poste o texto da mensagem exatamente como é mostrado. Provavelmente ele contem o código e descrição do erro e o número da linha onde ocorreu. Identifique esta linha no código que postou...

marcosgambeta · Mensagem por **marcosgambeta** » 20 Set 2022 17:43

No xHarbour, codeblock extendido (em mais de 1 linha) tem uma sintaxe diferente. Veja o exemplo extblock.prg da pasta tests:

Código: Selecionar todos

PROCEDURE Main()

    STATIC s_nOuter := 12
    LOCAL bBlock, nOuter := 7

    bBlock := < | x, y |
                     LOCAL InlineLocal := IIF( x > y .AND. x > nOuter, .T., .F. )

                     IF InlineLocal
                        Alert( "Yes" )
                        RETURN 33 + s_nOuter
                     ENDIF

                     RETURN 77 + s_nOuter
              >

    ? Eval( bBlock, 8, 3 )

RETURN

Note que o codeblock é delimitado pelos sinais de MENOR e MAIOR.

deividdjs · Mensagem por **deividdjs** » 20 Set 2022 17:43

alxsts escreveu:Olá!

deividdjs escreveu:DIZ O ERRO q é na DELIMITAÇÃO ( { } )
Nunca vi este erro...

Facilite o processo de ajuda.

Poste o texto da mensagem exatamente como é mostrado. Provavelmente ele contem o código e descrição do erro e o número da linha onde ocorreu. Identifique esta linha no código que postou...

Falei com o dono da função aqui .. ele provou no xharbour não compila mesmo .. somente no harbour ..vai entender !!

marcosgambeta · Mensagem por **marcosgambeta** » 20 Set 2022 18:00

Na função, notei a ausência de um EXIT no bloco abaixo:

Código: Selecionar todos

CASE K_CTRL_V
   nBits := hb_GtInfo( HB_GTI_KBDSHIFTS )
   lIsKeyCtrl := ( nBits == hb_BitOr( nBits, HB_GTI_KBD_CTRL ) )
   IF lIsKeyCtrl
      hb_GtInfo( HB_GTI_CLIPBOARDPASTE )
      RETURN 0
   ENDIF

O RETURN é condicional. Então, o EXIT se faz necessário:

Código: Selecionar todos

CASE K_CTRL_V
   nBits := hb_GtInfo( HB_GTI_KBDSHIFTS )
   lIsKeyCtrl := ( nBits == hb_BitOr( nBits, HB_GTI_KBD_CTRL ) )
   IF lIsKeyCtrl
      hb_GtInfo( HB_GTI_CLIPBOARDPASTE )
      RETURN 0
   ENDIF
   EXIT

Mensagem por **alxsts** » 20 Set 2022 18:12

Olá!

A resposta está acima, fornecida pelo amigo Marcos Gambeta.

Esta função está definida dentro de um code block estendido. No Harbour, code blocks simples (definidos em apenas uma linha), ou estendidos (definidos em várias linhas), tem como delimitadores de início e fim de definição o par de chaves { e }. No xHarbour, estes delimitadores mudam para < e >. Creio que apenas alterando de {} para <> e removendo as chamadas à função MSGBOX() vá funcionar com xHarbour puro

marcosgambeta escreveu:No xHarbour, codeblock extendido (em mais de 1 linha) tem uma sintaxe diferente. Veja o exemplo extblock.prg da pasta tests:

.
Valeu Marcos.

Eu já conhecia esta diferença mas não tinha observado este detalhe no código postado.
Isto está documentado no arquivo [drive]:\harbour\doc\xhb-diff.txt (incluindo os bugs da implementação no xHarbour)

### EXTENDED CODEBLOCKS ###
=================================
Both compilers support compile time extended codeblocks which allow
to use statements but with a little bit different syntax. Harbour uses
standard Clipper codeblock delimiters {}, f.e.:
? eval( { | p1, p2, p3 |
? p1, p2, p3
return p1 + p2 + p3
}, 1, 2, 3 )
and xHarbour <>, f.e.:
? eval( < | p1, p2, p3 |
? p1, p2, p3
return p1 + p2 + p3
>, 1, 2, 3 )

In Harbour extended codeblocks works like nested functions and supports
all function attributes, f.e. they can have own static variables or
other declarations which are local to extended codeblocks only and
do not effect upper function body.

In xHarbour the compiler was not fully updated for such functionality
and extended codeblocks were added to existing compiler structures what
causes that not all language constructs work in extended codeblocks
and creates a set of very serious compiler bugs, f.e., like in this code
with syntax errors but which is compiled by xHarbour without even single
warning giving unexpected results at runtime:
#ifndef __XHARBOUR__
#xtranslate \<|[<x,...>]| => {|<x>|
#xcommand > [<*x*>] => } <x>
#endif
proc main()
local cb, i
for i:=1 to 5
cb := <| p |
? p
exit
return p * 10
>
?? eval( cb, i )
next
return
It's possible to create many other similar examples which are mostly
caused by missing in the compiler infrastructure for nested functions
support.
This can be fixed if someone invest some time to clean xHarbour compiler.

deividdjs · Mensagem por **deividdjs** » 21 Set 2022 10:25

alxsts escreveu:#ifndef __XHARBOUR__
#xtranslate \<|[<x,...>]| => {|<x>|
#xcommand > [<*x*>] => } <x>
#endif

Bem isso mesmo a sintax do bloco en xharbour é diferente ... fiz exatamente isso q vc mencionou trocando {} por <> e compilou normalmente ..... show!

porém ainda estou tendo conflito com o GETSYS.prg bloqueando o CTRL + V e CTRL + C ... alguem tem algum GETSYS aí q esteja funcionando bem junto com essas funções ??

Abs,

OBrigado..

Deivid

deividdjs · Mensagem por **deividdjs** » 21 Set 2022 14:44

Código: Selecionar todos

/*** 
* 
*  Getsys.prg 
* 
*  Standard Clipper 5.2 GET/READ Subsystem 
* 
*  Copyright (c) 1991-1993, Computer Associates International, Inc. 
*  All rights reserved. 
* 
*  This version adds the following public functions: 
* 
*     ReadKill( [<lKill>] )       --> lKill 
*     ReadUpdated( [<lUpdated>] ) --> lUpdated 
*     ReadFormat( [<bFormat>] )   --> bFormat | NIL 
* 
*  NOTE: compile with /m /n /w 
* 
*  Alterada por : Dercide de Freitas Alvarez 
*  Utilize para entrada numerica "@EZ 999,999,999.99" 
*  A Barra de espaco limpa o campo 
*  A acentuacao devera ser feita usando virgula e aspas simples 
*  sempre antes da tecla. 
*  Alterada por : Daniel Denobie 
*  Picture "@M" para letras minuscula (ideia do Toledo) 
* 
*/ 

#include "Inkey.ch" 
#include "Getexit.ch" 

/*** 
*  Nation Message Constants 
*  These constants are used with the NationMsg(<msg>) function. 
*  The <msg> parameter can range from 1-12 and returns the national 
*  version of the system message. 
*/ 
#define _GET_INSERT_ON   7     // "Ins" 
#define _GET_INSERT_OFF  8     // "   " 
#define _GET_INVD_DATE   9     // "Invalid Date" 
#define _GET_RANGE_FROM  10    // "Range: " 
#define _GET_RANGE_TO    11    // " - " 

#define K_UNDO          K_CTRL_U 



// State variables for active READ 

STATIC sbFormat 
STATIC slUpdated := .F. 
STATIC slKillRead 
STATIC slBumpTop 
STATIC slBumpBot 
STATIC snLastExitState 
STATIC snLastPos 
STATIC soActiveGet 
STATIC scReadProcName 
STATIC snReadProcLine 


// Format of array used to preserve state variables 

#define GSV_KILLREAD       1 
#define GSV_BUMPTOP        2 
#define GSV_BUMPBOT        3 
#define GSV_LASTEXIT       4 
#define GSV_LASTPOS        5 
#define GSV_ACTIVEGET      6 
#define GSV_READVAR        7 
#define GSV_READPROCNAME   8 
#define GSV_READPROCLINE   9 

#define GSV_COUNT          9 



/*** 
* 
*  ReadModal() 
* 
*  Standard modal READ on an array of GETs 
* 
*/ 
FUNCTION ReadModal( GetList, nPos ) 
LOCAL oGet
LOCAL aSavGetSysVars
LOCAL nCursor := SetCursor()

IF ( VALTYPE( sbFormat ) == "B" )
   EVAL( sbFormat )
ENDIF

IF ( EMPTY( GetList ) ) // S'87 compatibility
   SETPOS( MAXROW() - 1, 0 )
   RETURN (.F.)                  // NOTE
ENDIF

// Preserve state variables
aSavGetSysVars := ClearGetSysVars()

// Set these for use in SET KEYs
scReadProcName := PROCNAME( 1 )
snReadProcLine := PROCLINE( 1 )

// Set initial GET to be read
IF !( VALTYPE( nPos ) == "N" .AND. nPos > 0 )
   nPos := Settle( Getlist, 0 )
ENDIF
IF READINSERT()
   SETCURSOR(3)    // modo de Inser‡„o 2
ELSE
   SETCURSOR(1)    // modo normal      1
ENDIF
WHILE !( nPos == 0 )
   // Get next GET from list and post it as the active GET
   PostActiveGet( oGet := GetList[ nPos ] )

   // Read the GET
   IF ( VALTYPE( oGet:reader ) == "B" )
      EVAL( oGet:reader, oGet )    // Use custom reader block
   ELSE
      GetReader( oGet )            // Use standard reader
   ENDIF
   // Move to next GET based on exit condition
   nPos := Settle( GetList, nPos )
ENDDO

// Restore state variables
SETCURSOR(nCursor)
RestoreGetSysVars( aSavGetSysVars )

// S'87 compatibility
SETPOS( MAXROW() - 1, 0 )

RETURN ( slUpdated )



/*** 
* 
*  GetReader() 
* 
*  Standard modal read of a single GET 
* 
*/ 
PROCEDURE GetReader( oGet ) 
LOCAL   nKey,cKey,cRet,original
PRIVATE lPrimKey := .T.

// Read the GET if the WHEN condition is satisfied
IF ( GetPreValidate( oGet ) )

   // Activate the GET for reading
   oGet:setFocus()

   WHILE ( oGet:exitState == GE_NOEXIT )

      // Check for initial typeout (no editable positions)
      IF ( oGet:typeOut )
         oGet:exitState := GE_ENTER
      ENDIF

      // Tratamento para entrada Direita -> Esquerda
      IF ( oGet:type == "N" )   .And. ( Len( oGet:buffer ) > oGet:DecPos )
         oGet:Pos := Len( oGet:buffer ) + 1
         oGet:End()
         oGet:ToDecPos()
         oGet:Left()
      ELSEIF ( oGet:type == "N" )
         oGet:Pos := Len( oGet:buffer ) + 1
         oGet:End()
      ENDIF

      cKey := ''
      nKey := 0

      // Apply keystrokes until exit

      original := oGet:buffer

      WHILE ( oGet:exitState == GE_NOEXIT )

         // Armazena a tecla que foi pressionada anteriormente
         cKey := Chr(nKey)

         // Le a Pr¢xima tecla
         nKey := inkey( 0 )

         // Ajusta Caract‚r de Retorno
         IF !READINSERT()
            cRet := CHR(19)
         ELSE
            cRet := CHR(08)
         ENDIF

         // Faz o tratamento dos acentos
         IF ( oGet:type == "C" )
            * @ 24, 10 say oGet:picture
            * Inkey(0)
            // Virgula
            IF ( cKey = CHR(44) )

               IF ( nKey = ASC("c") )
                  KEYBOARD cRet + '‡'
                  LOOP
               ENDIF

               IF ( nKey = ASC("C") )
                  KEYBOARD cRet + '€'
                  LOOP
               ENDIF

            ENDIF

            // Aspas
            IF ( cKey = CHR(34) )

               IF ( nKey = ASC('U') )
                  KEYBOARD cRet + 'š'
                  LOOP
               ENDIF

               IF ( nKey = ASC('u') )
                  KEYBOARD cRet + ''
                  LOOP
               ENDIF

            ENDIF

            // Apostrofo
            IF ( cKey = CHR(39) )

               IF ( nkey = ASC('A') )
                  KEYBOARD cRet + ''
                  LOOP
               ENDIF

               IF ( nkey = ASC('E') )
                  KEYBOARD cRet + ''
                  LOOP
               ENDIF

               IF ( nkey = ASC('a') )
                  KEYBOARD cRet + ' '
                  LOOP
               ENDIF

               IF ( nkey = ASC('e') )
                  KEYBOARD cRet + '‚'
                  LOOP
               ENDIF

               IF ( nkey = ASC('i') ) .OR. ( nkey = ASC('I') )
                  KEYBOARD cRet + '¡'
                  LOOP
               ENDIF

               IF ( nkey = ASC('o') ) .OR. ( nkey = ASC('O') )
                  KEYBOARD cRet + '¢'
                  LOOP
               ENDIF

               IF ( nkey = ASC('u') ) .OR. ( nkey = ASC('U') )
                  KEYBOARD cRet + '£'
                  LOOP
               ENDIF
            ENDIF

            // Crase
            IF ( cKey = CHR(96) )

               IF ( nkey = ASC('a') )
                  KEYBOARD cRet + '…'
                  LOOP
               ENDIF

               IF ( nkey = ASC('A') )
                  KEYBOARD cRet + ''
                  LOOP
               ENDIF

            ENDIF

            // Circunflexo
            IF ( cKey = CHR(94) )

               IF (nkey = ASC('a') ) .OR. ( nkey = ASC('A') )
                  KEYBOARD cRet + 'ƒ'
                  LOOP
               ENDIF

               IF ( nkey = ASC('e') ) .OR. ( nkey = ASC('E') )
                  KEYBOARD cRet + 'ˆ'
                  LOOP
               ENDIF

               IF ( nkey = ASC('o') ) .OR. ( nkey = ASC('O') )
                  KEYBOARD cRet + '“'
                  LOOP
               ENDIF

            ENDIF

            // Til
            IF ( cKey = CHR(126) )

               IF ( nkey = ASC('a') )
                  KEYBOARD cRet + '„'
                  LOOP
               ENDIF

               IF ( nkey = ASC('A') )
                  KEYBOARD cRet + 'Ž'
                  LOOP
               ENDIF

               IF ( nkey = ASC('O') ) .OR. ( nkey = ASC('o') )
                  KEYBOARD cRet + '”'
                  LOOP
               ENDIF

               IF ( nkey = ASC('N') )
                  KEYBOARD cRet + '¥'
                  LOOP
               ENDIF

               IF ( nkey = ASC('n') )
                  KEYBOARD cRet + '¤'
                  LOOP
               ENDIF

            ENDIF

            // Sublinha
            IF ( cKey = CHR(95) )

               IF ( nkey = ASC('A') ) .OR. ( nkey = ASC('a') )
                  KEYBOARD cRet + '¦'
                  LOOP
               ENDIF

               IF ( nkey = ASC('O') ) .OR. ( nkey = ASC('o') )
                  KEYBOARD cRet + '§'
                  LOOP
               ENDIF

            ENDIF

         ENDIF

         // Verifica tecla pressionada
         GetApplyKey( oGet, nkey, original )
         *
         lPrimKey := .F.
         *
      ENDDO

      // Disallow exit if the VALID condition is not satisfied
      IF ( !GetPostValidate( oGet ) )
         oGet:exitState := GE_NOEXIT
      ENDIF
   ENDDO

   // De-activate the GET
   oGet:killFocus()

ENDIF

RETURN

/*** 
* 
*  MostraValor() 
* 
*  Mostra o Valor conforme a Picture 
* 
*/ 
PROCEDURE MostraValor( oGet ) 

LOCAL valor1,valor,ind,ind1,ind2,ind3,mascara 
ind    := Len(oGet:buffer)
valor1 := '' 

For ind1 := Len(oGet:buffer) to 1 step -1 

    If !Empty(Substr(oGet:buffer,ind1,1)) .And. Substr(oGet:buffer,ind1,1) != '.' 

       valor1 := Substr(oGet:buffer,ind1,1) + valor1 

    Endif 

Next 

valor1 := Space(ind - Len(valor1)) + valor1 
valor  := '' 
ind3   := 0 

For ind := Len(oGet:picture) To 1 Step -1 

    if empty(substr(oGet:picture,ind,1)) 

       exit 

    endif 

    ind3 ++ 

next 

ind3 -- 

mascara := oGet:picture 

if ind3 < Len(oGet:picture) 

   mascara := substr(oGet:picture,Len(oGet:picture) - ind3,ind3+1) 

endif 

ind3 := Len(mascara) 
ind1 := Len(valor1) 
ind2 := ind1 
ind  := ind3 

For ind1 := Len(valor1)  to 1 Step -1 

    If Empty(Substr(valor1,ind1,1)) 

       Exit 

    Endif 

    If Substr(mascara,ind,1) = '.' 

       valor := ',' + valor 

    ElseIf Substr(mascara,ind,1) = ',' 

       valor := '.' + valor 
       ind -- 

    Endif 

    If !Substr(valor1,ind1,1) $ ',.' 

       valor := Substr(valor1,ind1,1) + valor 

    Endif 

    ind -- 

Next 

valor       := Space(ind3 - Len(valor)) + valor 
oGet:buffer := valor 
oGet:display()
valor1   := StrTran(valor,'.',' ')
oGet:buffer := valor 
Return

/*** 
* 
*  GetApplyKey() 
* 
*  Apply a single INKEY() keystroke to a GET 
* 
*  NOTE: GET must have focus. 
* 
*/ 
PROCEDURE GetApplyKey( oGet, nKey, original ) 

LOCAL  cKey
LOCAL  bKeyBlock
LOCAL  Valor
MEMVAR lPrimKey

// Se Campo for num‚rico e pressionada barra de espa‡o zera
IF ( oGet:type == "N" )

   IF ( nKey = 32 ) .OR. (lPrimKey .AND. ( nKey > 47 .AND. nKey < 58 ) )
      *
      IF ( nKey == 32 )
         *
         valor := Str(0,Len(oGet:buffer),;
                        Len(oGet:buffer) - oGet:DecPos)
         *
       ELSE
         *
         valor := Str(Val(CHR( nKey )),Len(oGet:buffer),;
                                       Len(oGet:buffer) - oGet:DecPos)
         *
      ENDIF
      *
      oGet:buffer := valor
      MostraValor(oGet)
      RETURN

   ENDIF

ENDIF

// Check for SET KEY first
IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
   GetDoSetKey( bKeyBlock, oGet )
   RETURN                           // NOTE
ENDIF
		
DO CASE
CASE ( nKey == K_UP )
   oGet:exitState := GE_UP

CASE ( nKey == K_SH_TAB )
   oGet:exitState := GE_UP

CASE ( nKey == K_DOWN )
   oGet:exitState := GE_DOWN

CASE ( nKey == K_TAB )
   oGet:exitState := GE_DOWN

CASE ( nKey == K_ENTER )
   oGet:assign()
   oGet:exitState := GE_ENTER

CASE ( nKey == K_ESC )
   IF ( SET( _SET_ESCAPE ) )

      oGet:undo()
      oGet:exitState := GE_ESCAPE

   ENDIF

CASE ( nKey == K_PGUP )
   oGet:exitState := GE_WRITE

CASE ( nKey == K_PGDN )
   oGet:exitState := GE_WRITE

CASE ( nKey == K_CTRL_HOME )
   oGet:exitState := GE_TOP


#ifdef CTRL_END_SPECIAL 

   // Both ^W and ^End go to the last GET 
   CASE ( nKey == K_CTRL_END ) 
      oGet:exitState := GE_BOTTOM 
#else

   // Both ^W and ^End terminate the READ (the default) 
   CASE ( nKey == K_CTRL_W ) 
      oGet:exitState := GE_WRITE 

#endif 

CASE ( nKey == K_INS )
   SET( _SET_INSERT, !SET( _SET_INSERT ) )
   ShowScoreboard()
		   
CASE ( nKey == K_UNDO )
   oGet:undo()

CASE ( nKey == K_HOME )
   oGet:home()

CASE ( nKey == K_END )
   oGet:end()

CASE ( nKey == K_RIGHT )
   oGet:right()

CASE ( nKey == K_LEFT )

   IF ( oGet:type != "N" )
      oGet:left()
   ELSE

      IF ( oGet:Pos > oGet:DecPos )

         oGet:left()

      ELSE

         IF ( oGet:DecPos > Len( oGet:buffer ) )

            valor := SUBSTR(oGet:buffer, 1, oGet:Pos - 1)

            oGet:buffer := valor

            MostraValor(oGet)

         ELSE

            valor := SUBSTR(oGet:buffer, 1, oGet:Pos - 1 )
            valor += SUBSTR(oGet:buffer, oGet:DecPos, ;
                            LEN(oGet:buffer) - (oGet:DecPos - 1))

            oGet:buffer := valor

            MostraValor(oGet)

         ENDIF

      ENDIF

      oGet:assign()

   ENDIF

CASE ( nKey == K_CTRL_RIGHT )
   oGet:wordRight()

CASE ( nKey == K_CTRL_LEFT )

   IF ( oGet:type != 'N' )
      oGet:wordLeft()
   ENDIF

CASE ( nKey == K_BS )

   IF ( oGet:type != "N" )
      oGet:backSpace()
   ELSE

      IF ( oGet:DecPos > LEN(oGet:Buffer) ).OR.( oGet:Pos > oGet:DecPos )
         // N„o aceita BackSpace
      ELSE
         valor := SUBSTR(oGet:buffer, 1, oGet:Pos - 1 )
         valor += SUBSTR(oGet:buffer, oGet:DecPos, ;
                         LEN(oGet:buffer) - (oGet:DecPos - 1))
         oGet:buffer := valor
         MostraValor(oGet)
      ENDIF

   ENDIF


CASE ( nKey == K_DEL )

   IF ( oGet:type != "N" )
      oGet:delete()
   ELSE

      IF ( oGet:Pos < oGet:DecPos )
         oGet:delete()
      ENDIF

   ENDIF
	 *
CASE ( nKey == K_CTRL_T )
   oGet:delWordRight()

CASE ( nKey == K_CTRL_Y )
   oGet:delEnd()

CASE ( nKey == K_CTRL_BS )
   oGet:delWordLeft()

OTHERWISE

   IF ( nKey >= 32 .AND. nKey <= 255 )

      cKey := CHR( nKey )

      IF !EMPTY(oGet:picture)
         IF AT("@M",oGet:picture)>0
            cKey := LOWER( cKey )
         ENDIF
      ENDIF

      IF ( oGet:type == "N" .AND. ( cKey == "." .OR. cKey == "," ) )
         oGet:toDecPos()
      ELSE

         IF ( oGet:type != "N" )

            IF ( SET( _SET_INSERT ) )
               oGet:insert( cKey )
            ELSE
               oGet:overstrike( cKey )
            ENDIF

         ELSE

            IF !Empty(cKey)

               IF ( nKey < 48 .OR. nKey > 57 )
                  *
                  IF nKey <> 45
                     *
                     RETURN
                     *
                   ELSEIF Val( oGet:Buffer ) <> 0
                     *
                     RETURN
                     *
                  ENDIF
                  *
               ENDIF
               *
               IF Len(oGet:buffer) > oGet:DecPos .And. oGet:pos < oGet:DecPos

                  valor  := oGet:buffer

                  If Len(Ltrim(valor)) < Len(original)

                     valor  := Substr(valor,2,oGet:Pos-1)
                     valor  := If( Val(valor) == 0 .AND. !("-"$valor),Substr(valor,1,Len(valor)-1)+' ',valor)
                     valor  += ' ' + Substr(oGet:buffer,oGet:DecPos,Len(oGet:buffer))

                  Endif

                  If !Len(valor) > Len(original)

                     oGet:buffer := valor

                  Endif

                  oGet:display()

                  IF Empty(SubStr(oGet:Buffer,oGet:pos,1))
                     oGet:overstrike(cKey)
                     oGet:left()
                  Else
                     ? Chr(7)
                  Endif

                  MostraValor(oGet)

               ELSE

                  IF ( oGet:DecPos > Len( oGet:buffer )  )

                     valor  := oGet:buffer

                     If Len(Ltrim(valor)) < Len(original)
                        valor  := Substr(valor,2,oGet:Pos)
                        valor  := If(Val(valor) = 0,Substr(valor,1,Len(valor)-1)+' ',valor)
                        valor  += ' '
                     Endif

                     If !Len(valor) > Len(original)
                        oGet:buffer := valor
                     Endif

                     oGet:display()

                     oGet:overstrike(cKey)

                     MostraValor(oGet)

                     oGet:Pos := Len( oGet:buffer ) + 1
                     oGet:End()

                  ELSE

                     oGet:overstrike(cKey)

                  ENDIF

               ENDIF

            ENDIF

         ENDIF
         IF ( oGet:typeOut )
            IF ( SET( _SET_BELL ) )
               ?? CHR(7)
            ENDIF

            IF ( !SET( _SET_CONFIRM ) )
               oGet:exitState := GE_ENTER
            ENDIF
         ENDIF
      ENDIF
   ENDIF
ENDCASE
RETURN


      
/*** 
* 
*  GetPreValidate() 
* 
*  Test entry condition (WHEN clause) for a GET 
* 
*/ 
FUNCTION GetPreValidate( oGet ) 
LOCAL lSavUpdated
LOCAL lWhen := .T.

IF !( oGet:preBlock == NIL )

   lSavUpdated := slUpdated

   lWhen := EVAL( oGet:preBlock, oGet )

   oGet:display()

   ShowScoreBoard()
   slUpdated := lSavUpdated

ENDIF

IF ( slKillRead )

   lWhen := .F.
   oGet:exitState := GE_ESCAPE       // Provokes ReadModal() exit

ELSEIF ( !lWhen )

   oGet:exitState := GE_WHEN         // Indicates failure

ELSE

   oGet:exitState := GE_NOEXIT       // Prepares for editing

END
RETURN ( lWhen )



/*** 
* 
*  GetPostValidate() 
* 
*  Test exit condition (VALID clause) for a GET 
* 
*  NOTE: Bad dates are rejected in such a way as to preserve edit buffer 
* 
*/ 
FUNCTION GetPostValidate( oGet ) 
LOCAL lSavUpdated
LOCAL lValid := .T.


IF ( oGet:exitState == GE_ESCAPE )
   RETURN ( .T. )                   // NOTE
ENDIF

IF ( oGet:badDate() )
   oGet:home()
   DateMsg()
   ShowScoreboard()
   RETURN ( .F. )                   // NOTE
ENDIF

// If editing occurred, assign the new value to the variable
IF ( oGet:changed )
   oGet:assign()
   slUpdated := .T.
ENDIF

// Reform edit buffer, set cursor to home position, redisplay
oGet:reset()

// Check VALID condition if specified
IF !( oGet:postBlock == NIL )

   lSavUpdated := slUpdated

   // S'87 compatibility
   SETPOS( oGet:row, oGet:col + LEN( oGet:buffer ) )

   lValid := EVAL( oGet:postBlock, oGet )

   // Reset S'87 compatibility cursor position
   SETPOS( oGet:row, oGet:col )

   ShowScoreBoard()
   oGet:updateBuffer()

   slUpdated := lSavUpdated

   IF ( slKillRead )
      oGet:exitState := GE_ESCAPE      // Provokes ReadModal() exit
      lValid := .T.

   ENDIF
ENDIF
RETURN ( lValid )



/*** 
* 
*  GetDoSetKey() 
* 
*  Process SET KEY during editing 
* 
*/ 
PROCEDURE GetDoSetKey( keyBlock, oGet ) 
LOCAL lSavUpdated

// If editing has occurred, assign variable
IF ( oGet:changed )
   oGet:assign()
   slUpdated := .T.
ENDIF

lSavUpdated := slUpdated

EVAL( keyBlock, scReadProcName, snReadProcLine, ReadVar() )

ShowScoreboard()
oGet:updateBuffer()

slUpdated := lSavUpdated

IF ( slKillRead )
   oGet:exitState := GE_ESCAPE      // provokes ReadModal() exit
ENDIF
RETURN



/*** 
*              READ services 
*/ 



/*** 
* 
*  Settle() 
* 
*  Returns new position in array of Get objects, based on: 
*     - current position 
*     - exitState of Get object at current position 
* 
*  NOTES: return value of 0 indicates termination of READ 
*         exitState of old Get is transferred to new Get 
* 
*/ 
STATIC FUNCTION Settle( GetList, nPos ) 
LOCAL nExitState

IF ( nPos == 0 )
   nExitState := GE_DOWN
ELSE
   nExitState := GetList[ nPos ]:exitState
ENDIF

IF ( nExitState == GE_ESCAPE .or. nExitState == GE_WRITE )
   RETURN ( 0 )               // NOTE
ENDIF

IF !( nExitState == GE_WHEN )
   // Reset state info
   snLastPos := nPos
   slBumpTop := .F.
   slBumpBot := .F.
ELSE
   // Re-use last exitState, do not disturb state info
   nExitState := snLastExitState
ENDIF

//
// Move
//
DO CASE
CASE ( nExitState == GE_UP )
   nPos--

CASE ( nExitState == GE_DOWN )
   nPos++

CASE ( nExitState == GE_TOP )
   nPos       := 1
   slBumpTop  := .T.
   nExitState := GE_DOWN

CASE ( nExitState == GE_BOTTOM )
   nPos       := LEN( GetList )
   slBumpBot  := .T.
   nExitState := GE_UP

CASE ( nExitState == GE_ENTER )
   nPos++

ENDCASE

//
// Bounce
//
IF ( nPos == 0 )                       // Bumped top
   IF ( !ReadExit() .and. !slBumpBot )
      slBumpTop  := .T.
      nPos       := snLastPos
      nExitState := GE_DOWN
   ENDIF

ELSEIF ( nPos == len( GetList ) + 1 )  // Bumped bottom
   IF ( !ReadExit() .and. !( nExitState == GE_ENTER ) .and. !slBumpTop )
      slBumpBot  := .T.
      nPos       := snLastPos
      nExitState := GE_UP
   ELSE
      nPos := 0
   ENDIF
ENDIF

// Record exit state
snLastExitState := nExitState

IF !( nPos == 0 )
   GetList[ nPos ]:exitState := nExitState
ENDIF
RETURN ( nPos )



/*** 
* 
*  PostActiveGet() 
* 
*  Post active GET for ReadVar(), GetActive() 
* 
*/ 
STATIC PROCEDURE PostActiveGet( oGet ) 
GetActive( oGet )
ReadVar( GetReadVar( oGet ) )
ShowScoreBoard()
RETURN



/*** 
* 
*  ClearGetSysVars() 
* 
*  Save and clear READ state variables. Return array of saved values 
* 
*  NOTE: 'Updated' status is cleared but not saved (S'87 compatibility) 
*/ 
STATIC FUNCTION ClearGetSysVars() 
LOCAL aSavSysVars[ GSV_COUNT ]

// Save current sys vars
aSavSysVars[ GSV_KILLREAD ]     := slKillRead
aSavSysVars[ GSV_BUMPTOP ]      := slBumpTop
aSavSysVars[ GSV_BUMPBOT ]      := slBumpBot
aSavSysVars[ GSV_LASTEXIT ]     := snLastExitState
aSavSysVars[ GSV_LASTPOS ]      := snLastPos
aSavSysVars[ GSV_ACTIVEGET ]    := GetActive( NIL )
aSavSysVars[ GSV_READVAR ]      := ReadVar( "" )
aSavSysVars[ GSV_READPROCNAME ] := scReadProcName
aSavSysVars[ GSV_READPROCLINE ] := snReadProcLine

// Re-init old ones
slKillRead      := .F.
slBumpTop       := .F.
slBumpBot       := .F.
snLastExitState := 0
snLastPos       := 0
scReadProcName  := ""
snReadProcLine  := 0
slUpdated       := .F.

RETURN ( aSavSysVars )



/*** 
* 
*  RestoreGetSysVars() 
* 
*  Restore READ state variables from array of saved values 
* 
*  NOTE: 'Updated' status is not restored (S'87 compatibility) 
* 
*/ 
STATIC PROCEDURE RestoreGetSysVars( aSavSysVars ) 
slKillRead      := aSavSysVars[ GSV_KILLREAD ]
slBumpTop       := aSavSysVars[ GSV_BUMPTOP ]
slBumpBot       := aSavSysVars[ GSV_BUMPBOT ]
snLastExitState := aSavSysVars[ GSV_LASTEXIT ]
snLastPos       := aSavSysVars[ GSV_LASTPOS ]

GetActive( aSavSysVars[ GSV_ACTIVEGET ] )

ReadVar( aSavSysVars[ GSV_READVAR ] )

scReadProcName  := aSavSysVars[ GSV_READPROCNAME ]
snReadProcLine  := aSavSysVars[ GSV_READPROCLINE ]
RETURN



/*** 
* 
*  GetReadVar() 
* 
*  Set READVAR() value from a GET 
* 
*/ 
STATIC FUNCTION GetReadVar( oGet ) 
LOCAL cName := UPPER( oGet:name )
LOCAL i

// The following code includes subscripts in the name returned by
// this FUNCTIONtion, if the get variable is an array element
//
// Subscripts are retrieved from the oGet:subscript instance variable
//
// NOTE: Incompatible with Summer 87
//
IF !( oGet:subscript == NIL )
   FOR i := 1 TO LEN( oGet:subscript )
      cName += "[" + LTRIM( STR( oGet:subscript[i] ) ) + "]"
   NEXT
END

RETURN ( cName )





/*** 
*              System Services 
*/ 



/*** 
* 
*  __SetFormat() 
* 
*  SET FORMAT service 
* 
*/ 
PROCEDURE __SetFormat( b ) 
sbFormat := IF( VALTYPE( b ) == "B", b, NIL )
RETURN



/*** 
* 
*  __KillRead() 
* 
*  CLEAR GETS service 
* 
*/ 
PROCEDURE __KillRead() 
   slKillRead := .T. 
   RETURN 



/*** 
* 
*  GetActive() 
* 
*  Retrieves currently active GET object 
*/ 
FUNCTION GetActive( g ) 
LOCAL oldActive := soActiveGet

IF ( PCOUNT() > 0 )
   soActiveGet := g
ENDIF

RETURN ( oldActive )



/*** 
* 
*  Updated() 
* 
*/ 
FUNCTION Updated() 
RETURN slUpdated



/*** 
* 
*  ReadExit() 
* 
*/ 
FUNCTION ReadExit( lNew ) 
RETURN ( SET( _SET_EXIT, lNew ) )



/*** 
* 
*  ReadInsert() 
* 
*/ 
FUNCTION ReadInsert( lNew ) 
RETURN ( SET( _SET_INSERT, lNew ) )



/*** 
*              Wacky Compatibility Services 
*/ 


// Display coordinates for SCOREBOARD 
#define SCORE_ROW      0 
#define SCORE_COL      60 


/*** 
* 
*  ShowScoreboard() 
* 
*/ 
STATIC PROCEDURE ShowScoreboard() 
LOCAL nRow
LOCAL nCol

IF ( SET( _SET_SCOREBOARD ) )
   nRow := ROW()
   nCol := COL()

   SETPOS( SCORE_ROW, SCORE_COL )
   DISPOUT( IF( SET( _SET_INSERT ), NationMsg(_GET_INSERT_ON),;
                                NationMsg(_GET_INSERT_OFF)) )
   SETPOS( nRow, nCol )
ENDIF
RETURN



/*** 
* 
*  DateMsg() 
* 
*/ 
STATIC PROCEDURE DateMsg() 
LOCAL nRow
LOCAL nCol

IF ( SET( _SET_SCOREBOARD ) )

   nRow := ROW()
   nCol := COL()

   SETPOS( SCORE_ROW, SCORE_COL )
   DISPOUT( NationMsg(_GET_INVD_DATE) )
   SETPOS( nRow, nCol )

   WHILE ( NEXTKEY() == 0 )
   END

   SETPOS( SCORE_ROW, SCORE_COL )
   DISPOUT( SPACE( LEN( NationMsg(_GET_INVD_DATE) ) ) )
   SETPOS( nRow, nCol )

ENDIF
RETURN



/*** 
* 
*  RangeCheck() 
* 
*  NOTE: Unused second param for 5.00 compatibility. 
* 
*/ 
FUNCTION RangeCheck( oGet, junk, lo, hi ) 
LOCAL cMsg, nRow, nCol
LOCAL xValue

IF ( !oGet:changed )
   RETURN ( .T. )          // NOTE
ENDIF

xValue := oGet:varGet()

IF ( xValue >= lo .and. xValue <= hi )
   RETURN ( .T. )          // NOTE
ENDIF

IF ( SET(_SET_SCOREBOARD) )

   cMsg := NationMsg(_GET_RANGE_FROM) + LTRIM( TRANSFORM( lo, "" ) ) + ;
           NationMsg(_GET_RANGE_TO) + LTRIM( TRANSFORM( hi, "" ) )

   IF ( LEN( cMsg ) > MAXCOL() )
      cMsg := SUBSTR( cMsg, 1, MAXCOL() )
   ENDIF

   nRow := ROW()
   nCol := COL()

   SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - LEN( cMsg ) ) )
   DISPOUT( cMsg )
   SETPOS( nRow, nCol )

   WHILE ( NEXTKEY() == 0 )
   END

   SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - LEN( cMsg ) ) )
   DISPOUT( SPACE( LEN( cMsg ) ) )
   SETPOS( nRow, nCol )

ENDIF
RETURN ( .F. )



/*** 
* 
*  ReadKill() 
* 
*/ 
FUNCTION ReadKill( lKill ) 
LOCAL lSavKill := slKillRead

IF ( PCOUNT() > 0 )
   slKillRead := lKill
ENDIF

RETURN ( lSavKill )



/*** 
* 
*  ReadUpdated() 
* 
*/ 
FUNCTION ReadUpdated( lUpdated ) 
LOCAL lSavUpdated := slUpdated

IF ( PCOUNT() > 0 )
   slUpdated := lUpdated
ENDIF

RETURN ( lSavUpdated )



/*** 
* 
*  ReadFormat() 
* 
*/ 
FUNCTION ReadFormat( b ) 
LOCAL bSavFormat := sbFormat

IF ( PCOUNT() > 0 )
   sbFormat := b
ENDIF

RETURN ( bSavFormat )

*

aqui está o codigo GETSYS que bloqueia a utilização do CTRL + C e CTRL + V... alguem pode me dar uma luz o que pode estar bloqueando .. porque procurei e não tem nenhuma referencia no codido que faz mensão dessas teclas ...

Att,
Deivid

deividdjs · Mensagem por **deividdjs** » 22 Set 2022 16:01

alguem saberia me explicar por que eu alterei no getsys para F2 para copiar e F3 pra colar e funciona perfeitamente ... porem com CTRL + C e CTRL + V não funciona ... alguem sabe me dizer porque ??

Código: Selecionar todos

   CASE (nkey == K_F2) //para Copiar
  
	   If oGet:type == "N"
         WVT_SetClipboard( Alltrim(StrTran(StrTran(get:buffer,'.',''),',','.') ) )
      Else   
         WVT_SetClipboard( Alltrim(oGet:buffer) )
      Endif
   
	CASE (nkey == K_F3) //Para Colar

      If oGet:type == "N"
         //get:pos := 1
         //inkey(0)
         //Get:Buffer := space(Len(Get:Buffer) )
         Keyboard WVT_GetClipboard()
      Else
         WVT_SetClipboard( left(WVT_GetClipboard(), len(oget:buffer) ) )
         WVT_PasteFromClipboard()
      Endif

Saludos a todos ...

deividdjs · Mensagem por **deividdjs** » 28 Set 2022 14:32

Bom dia amigos ... caso alguem busque ainda solução para o CTRL + C e CTRL + V ... está aí GETSYS.PRG modificado funcionando perfeitamente .. basta compilar junto com a aplicação e mais nada ..

Código: Selecionar todos

/*** 
* 
*  Getsys.prg 
* 
*  Standard Clipper 5.2 GET/READ Subsystem 
* 
*  Copyright (c) 1991-1993, Computer Associates International, Inc. 
*  All rights reserved. 
* 
*  This version adds the following public functions: 
* 
*     ReadKill( [<lKill>] )       --> lKill 
*     ReadUpdated( [<lUpdated>] ) --> lUpdated 
*     ReadFormat( [<bFormat>] )   --> bFormat | NIL 
* 
*  NOTE: compile with /m /n /w 
* 
*  Alterada por : Dercide de Freitas Alvarez 
*  Utilize para entrada numerica "@EZ 999,999,999.99" 
*  A Barra de espaco limpa o campo 
*  A acentuacao devera ser feita usando virgula e aspas simples 
*  sempre antes da tecla. 
*  Alterada por : Daniel Denobie 
*  Picture "@M" para letras minuscula (ideia do Toledo) 
* 
*/ 

#INCLUDE "INKEY.CH" 
#include "Getexit.ch" 

/*** 
*  Nation Message Constants 
*  These constants are used with the NationMsg(<msg>) function. 
*  The <msg> parameter can range from 1-12 and returns the national 
*  version of the system message. 
*/ 
#define _GET_INSERT_ON   7     // "Ins" 
#define _GET_INSERT_OFF  8     // "   " 
#define _GET_INVD_DATE   9     // "Invalid Date" 
#define _GET_RANGE_FROM  10    // "Range: " 
#define _GET_RANGE_TO    11    // " - " 

#define K_UNDO          K_CTRL_U 



// State variables for active READ 

STATIC sbFormat 
STATIC slUpdated := .F. 
STATIC slKillRead 
STATIC slBumpTop 
STATIC slBumpBot 
STATIC snLastExitState 
STATIC snLastPos 
STATIC soActiveGet 
STATIC scReadProcName 
STATIC snReadProcLine 


// Format of array used to preserve state variables 

#define GSV_KILLREAD       1 
#define GSV_BUMPTOP        2 
#define GSV_BUMPBOT        3 
#define GSV_LASTEXIT       4 
#define GSV_LASTPOS        5 
#define GSV_ACTIVEGET      6 
#define GSV_READVAR        7 
#define GSV_READPROCNAME   8 
#define GSV_READPROCLINE   9 

#define GSV_COUNT          9 

/*** 
* 
*  ReadModal() 
* 
*  Standard modal READ on an array of GETs 
* 
*/ 
FUNCTION ReadModal( GetList, nPos ) 
LOCAL oGet
LOCAL aSavGetSysVars
LOCAL nCursor := SetCursor()

IF ( VALTYPE( sbFormat ) == "B" )
   EVAL( sbFormat )
ENDIF

IF ( EMPTY( GetList ) ) // S'87 compatibility
   SETPOS( MAXROW() - 1, 0 )
   RETURN (.F.)                  // NOTE
ENDIF

// Preserve state variables
aSavGetSysVars := ClearGetSysVars()

// Set these for use in SET KEYs
scReadProcName := PROCNAME( 1 )
snReadProcLine := PROCLINE( 1 )

// Set initial GET to be read
IF !( VALTYPE( nPos ) == "N" .AND. nPos > 0 )
   nPos := Settle( Getlist, 0 )
ENDIF
IF READINSERT()
   SETCURSOR(3)    // modo de Inser‡„o 2
ELSE
   SETCURSOR(1)    // modo normal      1
ENDIF
WHILE !( nPos == 0 )
   // Get next GET from list and post it as the active GET
   PostActiveGet( oGet := GetList[ nPos ] )

   // Read the GET
   IF ( VALTYPE( oGet:reader ) == "B" )
      EVAL( oGet:reader, oGet )    // Use custom reader block
   ELSE
      GetReader( oGet )            // Use standard reader
   ENDIF
   // Move to next GET based on exit condition
   nPos := Settle( GetList, nPos )
ENDDO

// Restore state variables
SETCURSOR(nCursor)
RestoreGetSysVars( aSavGetSysVars )

// S'87 compatibility
SETPOS( MAXROW() - 1, 0 )

RETURN ( slUpdated )



/*** 
* 
*  GetReader() 
* 
*  Standard modal read of a single GET 
* 
*/ 
PROCEDURE GetReader( oGet ) 
LOCAL   nKey,cKey,cRet,original
PRIVATE lPrimKey := .T.

// Read the GET if the WHEN condition is satisfied
IF ( GetPreValidate( oGet ) )

   // Activate the GET for reading
   oGet:setFocus()

   WHILE ( oGet:exitState == GE_NOEXIT )

      // Check for initial typeout (no editable positions)
      IF ( oGet:typeOut )
         oGet:exitState := GE_ENTER
      ENDIF

      // Tratamento para entrada Direita -> Esquerda
      IF ( oGet:type == "N" )   .And. ( Len( oGet:buffer ) > oGet:DecPos )
         oGet:Pos := Len( oGet:buffer ) + 1
         oGet:End()
         oGet:ToDecPos()
         oGet:Left()
      ELSEIF ( oGet:type == "N" )
         oGet:Pos := Len( oGet:buffer ) + 1
         oGet:End()
      ENDIF

      cKey := ''
      nKey := 0

      // Apply keystrokes until exit

      original := oGet:buffer

      WHILE ( oGet:exitState == GE_NOEXIT )

         // Armazena a tecla que foi pressionada anteriormente
         cKey := Chr(nKey)

         // Le a Pr¢xima tecla
         nKey := inkey( 0 )

         // Ajusta Caract‚r de Retorno
         IF !READINSERT()
            cRet := CHR(19)
         ELSE
            cRet := CHR(08)
         ENDIF

         // Faz o tratamento dos acentos
         IF ( oGet:type == "C" )
            * @ 24, 10 say oGet:picture
            * Inkey(0)
            // Virgula
            IF ( cKey = CHR(44) )

               IF ( nKey = ASC("c") )
                  KEYBOARD cRet + '‡'
                  LOOP
               ENDIF

               IF ( nKey = ASC("C") )
                  KEYBOARD cRet + '€'
                  LOOP
               ENDIF

            ENDIF

            // Aspas
            IF ( cKey = CHR(34) )

               IF ( nKey = ASC('U') )
                  KEYBOARD cRet + 'š'
                  LOOP
               ENDIF

               IF ( nKey = ASC('u') )
                  KEYBOARD cRet + ''
                  LOOP
               ENDIF

            ENDIF

            // Apostrofo
            IF ( cKey = CHR(39) )

               IF ( nkey = ASC('A') )
                  KEYBOARD cRet + ''
                  LOOP
               ENDIF

               IF ( nkey = ASC('E') )
                  KEYBOARD cRet + ''
                  LOOP
               ENDIF

               IF ( nkey = ASC('a') )
                  KEYBOARD cRet + ' '
                  LOOP
               ENDIF

               IF ( nkey = ASC('e') )
                  KEYBOARD cRet + '‚'
                  LOOP
               ENDIF

               IF ( nkey = ASC('i') ) .OR. ( nkey = ASC('I') )
                  KEYBOARD cRet + '¡'
                  LOOP
               ENDIF

               IF ( nkey = ASC('o') ) .OR. ( nkey = ASC('O') )
                  KEYBOARD cRet + '¢'
                  LOOP
               ENDIF

               IF ( nkey = ASC('u') ) .OR. ( nkey = ASC('U') )
                  KEYBOARD cRet + '£'
                  LOOP
               ENDIF
            ENDIF

            // Crase
            IF ( cKey = CHR(96) )

               IF ( nkey = ASC('a') )
                  KEYBOARD cRet + '…'
                  LOOP
               ENDIF

               IF ( nkey = ASC('A') )
                  KEYBOARD cRet + ''
                  LOOP
               ENDIF

            ENDIF

            // Circunflexo
            IF ( cKey = CHR(94) )

               IF (nkey = ASC('a') ) .OR. ( nkey = ASC('A') )
                  KEYBOARD cRet + 'ƒ'
                  LOOP
               ENDIF

               IF ( nkey = ASC('e') ) .OR. ( nkey = ASC('E') )
                  KEYBOARD cRet + 'ˆ'
                  LOOP
               ENDIF

               IF ( nkey = ASC('o') ) .OR. ( nkey = ASC('O') )
                  KEYBOARD cRet + '“'
                  LOOP
               ENDIF

            ENDIF

            // Til
            IF ( cKey = CHR(126) )

               IF ( nkey = ASC('a') )
                  KEYBOARD cRet + '„'
                  LOOP
               ENDIF

               IF ( nkey = ASC('A') )
                  KEYBOARD cRet + 'Ž'
                  LOOP
               ENDIF

               IF ( nkey = ASC('O') ) .OR. ( nkey = ASC('o') )
                  KEYBOARD cRet + '”'
                  LOOP
               ENDIF

               IF ( nkey = ASC('N') )
                  KEYBOARD cRet + '¥'
                  LOOP
               ENDIF

               IF ( nkey = ASC('n') )
                  KEYBOARD cRet + '¤'
                  LOOP
               ENDIF

            ENDIF

            // Sublinha
            IF ( cKey = CHR(95) )

               IF ( nkey = ASC('A') ) .OR. ( nkey = ASC('a') )
                  KEYBOARD cRet + '¦'
                  LOOP
               ENDIF

               IF ( nkey = ASC('O') ) .OR. ( nkey = ASC('o') )
                  KEYBOARD cRet + '§'
                  LOOP
               ENDIF

            ENDIF

         ENDIF

         // Verifica tecla pressionada
         GetApplyKey( oGet, nkey, original )
         *
         lPrimKey := .F.
         *
      ENDDO

      // Disallow exit if the VALID condition is not satisfied
      IF ( !GetPostValidate( oGet ) )
         oGet:exitState := GE_NOEXIT
      ENDIF
   ENDDO

   // De-activate the GET
   oGet:killFocus()

ENDIF

RETURN

/*** 
* 
*  MostraValor() 
* 
*  Mostra o Valor conforme a Picture 
* 
*/ 
PROCEDURE MostraValor( oGet ) 

LOCAL valor1,valor,ind,ind1,ind2,ind3,mascara 
ind    := Len(oGet:buffer)
valor1 := '' 

For ind1 := Len(oGet:buffer) to 1 step -1 

    If !Empty(Substr(oGet:buffer,ind1,1)) .And. Substr(oGet:buffer,ind1,1) != '.' 

       valor1 := Substr(oGet:buffer,ind1,1) + valor1 

    Endif 

Next 

valor1 := Space(ind - Len(valor1)) + valor1 
valor  := '' 
ind3   := 0 

For ind := Len(oGet:picture) To 1 Step -1 

    if empty(substr(oGet:picture,ind,1)) 

       exit 

    endif 

    ind3 ++ 

next 

ind3 -- 

mascara := oGet:picture 

if ind3 < Len(oGet:picture) 

   mascara := substr(oGet:picture,Len(oGet:picture) - ind3,ind3+1) 

endif 

ind3 := Len(mascara) 
ind1 := Len(valor1) 
ind2 := ind1 
ind  := ind3 

For ind1 := Len(valor1)  to 1 Step -1 

    If Empty(Substr(valor1,ind1,1)) 

       Exit 

    Endif 

    If Substr(mascara,ind,1) = '.' 

       valor := ',' + valor 

    ElseIf Substr(mascara,ind,1) = ',' 

       valor := '.' + valor 
       ind -- 

    Endif 

    If !Substr(valor1,ind1,1) $ ',.' 

       valor := Substr(valor1,ind1,1) + valor 

    Endif 

    ind -- 

Next 

valor       := Space(ind3 - Len(valor)) + valor 
oGet:buffer := valor 
oGet:display()
valor1   := StrTran(valor,'.',' ')
oGet:buffer := valor 
Return

/*** 
* 
*  GetApplyKey() 
* 
*  Apply a single INKEY() keystroke to a GET 
* 
*  NOTE: GET must have focus. 
* 
*/ 
PROCEDURE GetApplyKey( oGet, nKey, original ) 

LOCAL  cKey
LOCAL  bKeyBlock
LOCAL  Valor
MEMVAR lPrimKey

// Se Campo for num‚rico e pressionada barra de espa‡o zera
IF ( oGet:type == "N" )

   IF ( nKey = 32 ) .OR. (lPrimKey .AND. ( nKey > 47 .AND. nKey < 58 ) )
      *
      IF ( nKey == 32 )
         *
         valor := Str(0,Len(oGet:buffer),;
                        Len(oGet:buffer) - oGet:DecPos)
         *
       ELSE
         *
         valor := Str(Val(CHR( nKey )),Len(oGet:buffer),;
                                       Len(oGet:buffer) - oGet:DecPos)
         *
      ENDIF
      *
      oGet:buffer := valor
      MostraValor(oGet)
      RETURN

   ENDIF

ENDIF

// Check for SET KEY first
IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
   GetDoSetKey( bKeyBlock, oGet )
   RETURN                           // NOTE
ENDIF
		
DO CASE
CASE ( nKey == K_UP )
   oGet:exitState := GE_UP

CASE ( nKey == K_SH_TAB )
   oGet:exitState := GE_UP

CASE ( nKey == K_DOWN )
   oGet:exitState := GE_DOWN

CASE ( nKey == K_TAB )
   oGet:exitState := GE_DOWN

CASE ( nKey == K_ENTER )
   oGet:assign()
   oGet:exitState := GE_ENTER

CASE ( nKey == K_ESC )
   IF ( SET( _SET_ESCAPE ) )

      oGet:undo()
      oGet:exitState := GE_ESCAPE

   ENDIF

CASE ( nKey == K_PGUP )
   oGet:exitState := GE_WRITE

CASE ( nKey == K_PGDN )
   oGet:exitState := GE_WRITE

CASE ( nKey == K_CTRL_HOME )
   oGet:exitState := GE_TOP


#ifdef CTRL_END_SPECIAL 

   // Both ^W and ^End go to the last GET 
   CASE ( nKey == K_CTRL_END ) 
      oGet:exitState := GE_BOTTOM 
#else

   // Both ^W and ^End terminate the READ (the default) 
   CASE ( nKey == K_CTRL_W ) 
      oGet:exitState := GE_WRITE 

#endif 

CASE ( nKey == K_INS )
   SET( _SET_INSERT, !SET( _SET_INSERT ) )
   ShowScoreboard()
		   
CASE ( nKey == K_UNDO )
   oGet:undo()

CASE ( nKey == K_HOME )
   oGet:home()

CASE ( nKey == K_END )
   oGet:end()

CASE ( nKey == K_RIGHT )
   oGet:right()

CASE ( nKey == K_LEFT )

   IF ( oGet:type != "N" )
      oGet:left()
   ELSE

      IF ( oGet:Pos > oGet:DecPos )
         
         oGet:left()

      ELSE

         IF ( oGet:DecPos > Len( oGet:buffer ) )

            valor := SUBSTR(oGet:buffer, 1, oGet:Pos - 1)

            oGet:buffer := valor

            MostraValor(oGet)

         ELSE

            valor := SUBSTR(oGet:buffer, 1, oGet:Pos - 1 )
            valor += SUBSTR(oGet:buffer, oGet:DecPos, ;
                            LEN(oGet:buffer) - (oGet:DecPos - 1))

            oGet:buffer := valor

            MostraValor(oGet)

         ENDIF

      ENDIF

      oGet:assign()

   ENDIF

CASE ( nKey == K_CTRL_RIGHT )
   oGet:wordRight()

CASE ( nKey == K_CTRL_LEFT )

   IF ( oGet:type != 'N' )
      oGet:wordLeft()
   ENDIF
/*
CASE ( nKey == K_BS )

   IF ( oGet:type != "N" )
      oGet:backSpace()
   ELSE

      IF ( oGet:DecPos > LEN(oGet:Buffer) ).OR.( oGet:Pos > oGet:DecPos )
         // N„o aceita BackSpace
      ELSE
         valor := SUBSTR(oGet:buffer, 1, oGet:Pos - 1 )
         valor += SUBSTR(oGet:buffer, oGet:DecPos, ;
                         LEN(oGet:buffer) - (oGet:DecPos - 1))
         oGet:buffer := valor
         MostraValor(oGet)
      ENDIF

   ENDIF

*/

CASE ( nKey == K_BS )

   IF ( oGet:type != "N" )
      oGet:backSpace()
   ELSE

         IF ( oGet:DecPos > Len( oGet:buffer ) )

            valor := SUBSTR(oGet:buffer, 1, oGet:Pos - 1)

            oGet:buffer := valor

            MostraValor(oGet)

         ELSE

            valor := SUBSTR(oGet:buffer, 1, oGet:Pos - 1 )
            valor += SUBSTR(oGet:buffer, oGet:DecPos, ;
                            LEN(oGet:buffer) - (oGet:DecPos - 1))

            oGet:buffer := valor

            MostraValor(oGet)

         ENDIF

      ENDIF

      oGet:assign()


CASE ( nKey == K_DEL )

   IF ( oGet:type != "N" )
      oGet:delete()
   ELSE

         IF ( oGet:DecPos > Len( oGet:buffer ) )

            valor := SUBSTR(oGet:buffer, 1, oGet:Pos - 1)

            oGet:buffer := valor

            MostraValor(oGet)

         ELSE

            valor := SUBSTR(oGet:buffer, 1, oGet:Pos - 1 )
            valor += SUBSTR(oGet:buffer, oGet:DecPos, ;
                            LEN(oGet:buffer) - (oGet:DecPos - 1))

            oGet:buffer := valor

            MostraValor(oGet)

         ENDIF

      ENDIF

      oGet:assign()

/*
CASE ( nKey == K_DEL )

   IF ( oGet:type != "N" )
      oGet:delete()
   ELSE

      IF ( oGet:Pos < oGet:DecPos )
         oGet:delete()
      ENDIF

   ENDIF
	 *

*/

CASE (lastkey() == 403)  // LIMPA PALAVRA POR PALAVRA  // K_CTRL_DEL //
   oGet:delWordRight()

CASE (lastkey() == 537)   // LIMPA CAMPO // K_CTRL_Y // 
   oGet:delEnd()

CASE (lastkey() == 127)  // LIMPA PALAVRA POR PALAVRA //  K_CTRL_BS // BACKSPACE
   oGet:delWordLeft()

CASE (lastkey() == 515) //para Copiar // CTRL + C

   if oGet:type == "N"
      WVT_SetClipboard( Alltrim(StrTran(StrTran(get:buffer,'.',''),',','.') ) )
   Else   
      WVT_SetClipboard( Alltrim(oGet:buffer) )
   Endif

CASE (lastkey() == 534) //Para Colar // CTRL + V
				  
   If oGet:type == "N"
      Keyboard WVT_GetClipboard()
   Else
      WVT_SetClipboard( left(WVT_GetClipboard(), len(oget:buffer) ) )
      WVT_PasteFromClipboard()
   Endif
		         
OTHERWISE
 
   IF ( nKey >= 32 .AND. nKey <= 255 )

      cKey := CHR( nKey )

      IF !EMPTY(oGet:picture)
         IF AT("@M",oGet:picture)>0
            cKey := LOWER( cKey )
         ENDIF
      ENDIF

      IF ( oGet:type == "N" .AND. ( cKey == "." .OR. cKey == "," ) )
         oGet:toDecPos()
      ELSE

         IF ( oGet:type != "N" )

            IF ( SET( _SET_INSERT ) )
               oGet:insert( cKey )
            ELSE
               oGet:overstrike( cKey )
            ENDIF

         ELSE

            IF !Empty(cKey)

               IF ( nKey < 48 .OR. nKey > 57 )
                  *
                  IF nKey <> 45
                     *
                     RETURN
                     *
                   ELSEIF Val( oGet:Buffer ) <> 0
                     *
                     RETURN
                     *
                  ENDIF
                  *
               ENDIF
               *
               IF Len(oGet:buffer) > oGet:DecPos .And. oGet:pos < oGet:DecPos

                  valor  := oGet:buffer

                  If Len(Ltrim(valor)) < Len(original)

                     valor  := Substr(valor,2,oGet:Pos-1)
                     valor  := If( Val(valor) == 0 .AND. !("-"$valor),Substr(valor,1,Len(valor)-1)+' ',valor)
                     valor  += ' ' + Substr(oGet:buffer,oGet:DecPos,Len(oGet:buffer))

                  Endif

                  If !Len(valor) > Len(original)

                     oGet:buffer := valor

                  Endif

                  oGet:display()

                  IF Empty(SubStr(oGet:Buffer,oGet:pos,1))
                     oGet:overstrike(cKey)
                     oGet:left()
                  Else
                     ? Chr(7)
                  Endif

                  MostraValor(oGet)

               ELSE

                  IF ( oGet:DecPos > Len( oGet:buffer )  )

                     valor  := oGet:buffer

                     If Len(Ltrim(valor)) < Len(original)
                        valor  := Substr(valor,2,oGet:Pos)
                        valor  := If(Val(valor) = 0,Substr(valor,1,Len(valor)-1)+' ',valor)
                        valor  += ' '
                     Endif

                     If !Len(valor) > Len(original)
                        oGet:buffer := valor
                     Endif

                     oGet:display()

                     oGet:overstrike(cKey)

                     MostraValor(oGet)

                     oGet:Pos := Len( oGet:buffer ) + 1
                     oGet:End()

                  ELSE

                     oGet:overstrike(cKey)

                  ENDIF

               ENDIF

            ENDIF

         ENDIF
         IF ( oGet:typeOut )
            IF ( SET( _SET_BELL ) )
               ?? CHR(7)
            ENDIF

            IF ( !SET( _SET_CONFIRM ) )
               oGet:exitState := GE_ENTER
            ENDIF
         ENDIF
      ENDIF
   ENDIF
ENDCASE
RETURN


      
/*** 
* 
*  GetPreValidate() 
* 
*  Test entry condition (WHEN clause) for a GET 
* 
*/ 
FUNCTION GetPreValidate( oGet ) 
LOCAL lSavUpdated
LOCAL lWhen := .T.

IF !( oGet:preBlock == NIL )

   lSavUpdated := slUpdated

   lWhen := EVAL( oGet:preBlock, oGet )

   oGet:display()

   ShowScoreBoard()
   slUpdated := lSavUpdated

ENDIF

IF ( slKillRead )

   lWhen := .F.
   oGet:exitState := GE_ESCAPE       // Provokes ReadModal() exit

ELSEIF ( !lWhen )

   oGet:exitState := GE_WHEN         // Indicates failure

ELSE

   oGet:exitState := GE_NOEXIT       // Prepares for editing

END
RETURN ( lWhen )



/*** 
* 
*  GetPostValidate() 
* 
*  Test exit condition (VALID clause) for a GET 
* 
*  NOTE: Bad dates are rejected in such a way as to preserve edit buffer 
* 
*/ 
FUNCTION GetPostValidate( oGet ) 
LOCAL lSavUpdated
LOCAL lValid := .T.


IF ( oGet:exitState == GE_ESCAPE )
   RETURN ( .T. )                   // NOTE
ENDIF

IF ( oGet:badDate() )
   oGet:home()
   DateMsg()
   ShowScoreboard()
   RETURN ( .F. )                   // NOTE
ENDIF

// If editing occurred, assign the new value to the variable
IF ( oGet:changed )
   oGet:assign()
   slUpdated := .T.
ENDIF

// Reform edit buffer, set cursor to home position, redisplay
oGet:reset()

// Check VALID condition if specified
IF !( oGet:postBlock == NIL )

   lSavUpdated := slUpdated

   // S'87 compatibility
   SETPOS( oGet:row, oGet:col + LEN( oGet:buffer ) )

   lValid := EVAL( oGet:postBlock, oGet )

   // Reset S'87 compatibility cursor position
   SETPOS( oGet:row, oGet:col )

   ShowScoreBoard()
   oGet:updateBuffer()

   slUpdated := lSavUpdated

   IF ( slKillRead )
      oGet:exitState := GE_ESCAPE      // Provokes ReadModal() exit
      lValid := .T.

   ENDIF
ENDIF
RETURN ( lValid )



/*** 
* 
*  GetDoSetKey() 
* 
*  Process SET KEY during editing 
* 
*/ 
PROCEDURE GetDoSetKey( keyBlock, oGet ) 
LOCAL lSavUpdated

// If editing has occurred, assign variable
IF ( oGet:changed )
   oGet:assign()
   slUpdated := .T.
ENDIF

lSavUpdated := slUpdated

EVAL( keyBlock, scReadProcName, snReadProcLine, ReadVar() )

ShowScoreboard()
oGet:updateBuffer()

slUpdated := lSavUpdated

IF ( slKillRead )
   oGet:exitState := GE_ESCAPE      // provokes ReadModal() exit
ENDIF
RETURN



/*** 
*              READ services 
*/ 



/*** 
* 
*  Settle() 
* 
*  Returns new position in array of Get objects, based on: 
*     - current position 
*     - exitState of Get object at current position 
* 
*  NOTES: return value of 0 indicates termination of READ 
*         exitState of old Get is transferred to new Get 
* 
*/ 
STATIC FUNCTION Settle( GetList, nPos ) 
LOCAL nExitState

IF ( nPos == 0 )
   nExitState := GE_DOWN
ELSE
   nExitState := GetList[ nPos ]:exitState
ENDIF

IF ( nExitState == GE_ESCAPE .or. nExitState == GE_WRITE )
   RETURN ( 0 )               // NOTE
ENDIF

IF !( nExitState == GE_WHEN )
   // Reset state info
   snLastPos := nPos
   slBumpTop := .F.
   slBumpBot := .F.
ELSE
   // Re-use last exitState, do not disturb state info
   nExitState := snLastExitState
ENDIF

//
// Move
//
DO CASE
CASE ( nExitState == GE_UP )
   nPos--

CASE ( nExitState == GE_DOWN )
   nPos++

CASE ( nExitState == GE_TOP )
   nPos       := 1
   slBumpTop  := .T.
   nExitState := GE_DOWN

CASE ( nExitState == GE_BOTTOM )
   nPos       := LEN( GetList )
   slBumpBot  := .T.
   nExitState := GE_UP

CASE ( nExitState == GE_ENTER )
   nPos++

ENDCASE

//
// Bounce
//
IF ( nPos == 0 )                       // Bumped top
   IF ( !ReadExit() .and. !slBumpBot )
      slBumpTop  := .T.
      nPos       := snLastPos
      nExitState := GE_DOWN
   ENDIF

ELSEIF ( nPos == len( GetList ) + 1 )  // Bumped bottom
   IF ( !ReadExit() .and. !( nExitState == GE_ENTER ) .and. !slBumpTop )
      slBumpBot  := .T.
      nPos       := snLastPos
      nExitState := GE_UP
   ELSE
      nPos := 0
   ENDIF
ENDIF

// Record exit state
snLastExitState := nExitState

IF !( nPos == 0 )
   GetList[ nPos ]:exitState := nExitState
ENDIF
RETURN ( nPos )



/*** 
* 
*  PostActiveGet() 
* 
*  Post active GET for ReadVar(), GetActive() 
* 
*/ 
STATIC PROCEDURE PostActiveGet( oGet ) 
GetActive( oGet )
ReadVar( GetReadVar( oGet ) )
ShowScoreBoard()
RETURN



/*** 
* 
*  ClearGetSysVars() 
* 
*  Save and clear READ state variables. Return array of saved values 
* 
*  NOTE: 'Updated' status is cleared but not saved (S'87 compatibility) 
*/ 
STATIC FUNCTION ClearGetSysVars() 
LOCAL aSavSysVars[ GSV_COUNT ]

// Save current sys vars
aSavSysVars[ GSV_KILLREAD ]     := slKillRead
aSavSysVars[ GSV_BUMPTOP ]      := slBumpTop
aSavSysVars[ GSV_BUMPBOT ]      := slBumpBot
aSavSysVars[ GSV_LASTEXIT ]     := snLastExitState
aSavSysVars[ GSV_LASTPOS ]      := snLastPos
aSavSysVars[ GSV_ACTIVEGET ]    := GetActive( NIL )
aSavSysVars[ GSV_READVAR ]      := ReadVar( "" )
aSavSysVars[ GSV_READPROCNAME ] := scReadProcName
aSavSysVars[ GSV_READPROCLINE ] := snReadProcLine

// Re-init old ones
slKillRead      := .F.
slBumpTop       := .F.
slBumpBot       := .F.
snLastExitState := 0
snLastPos       := 0
scReadProcName  := ""
snReadProcLine  := 0
slUpdated       := .F.

RETURN ( aSavSysVars )



/*** 
* 
*  RestoreGetSysVars() 
* 
*  Restore READ state variables from array of saved values 
* 
*  NOTE: 'Updated' status is not restored (S'87 compatibility) 
* 
*/ 
STATIC PROCEDURE RestoreGetSysVars( aSavSysVars ) 
slKillRead      := aSavSysVars[ GSV_KILLREAD ]
slBumpTop       := aSavSysVars[ GSV_BUMPTOP ]
slBumpBot       := aSavSysVars[ GSV_BUMPBOT ]
snLastExitState := aSavSysVars[ GSV_LASTEXIT ]
snLastPos       := aSavSysVars[ GSV_LASTPOS ]

GetActive( aSavSysVars[ GSV_ACTIVEGET ] )

ReadVar( aSavSysVars[ GSV_READVAR ] )

scReadProcName  := aSavSysVars[ GSV_READPROCNAME ]
snReadProcLine  := aSavSysVars[ GSV_READPROCLINE ]
RETURN



/*** 
* 
*  GetReadVar() 
* 
*  Set READVAR() value from a GET 
* 
*/ 
STATIC FUNCTION GetReadVar( oGet ) 
LOCAL cName := UPPER( oGet:name )
LOCAL i

// The following code includes subscripts in the name returned by
// this FUNCTIONtion, if the get variable is an array element
//
// Subscripts are retrieved from the oGet:subscript instance variable
//
// NOTE: Incompatible with Summer 87
//
IF !( oGet:subscript == NIL )
   FOR i := 1 TO LEN( oGet:subscript )
      cName += "[" + LTRIM( STR( oGet:subscript[i] ) ) + "]"
   NEXT
END

RETURN ( cName )





/*** 
*              System Services 
*/ 



/*** 
* 
*  __SetFormat() 
* 
*  SET FORMAT service 
* 
*/ 
PROCEDURE __SetFormat( b ) 
sbFormat := IF( VALTYPE( b ) == "B", b, NIL )
RETURN



/*** 
* 
*  __KillRead() 
* 
*  CLEAR GETS service 
* 
*/ 
PROCEDURE __KillRead() 
   slKillRead := .T. 
   RETURN 



/*** 
* 
*  GetActive() 
* 
*  Retrieves currently active GET object 
*/ 
FUNCTION GetActive( g ) 
LOCAL oldActive := soActiveGet

IF ( PCOUNT() > 0 )
   soActiveGet := g
ENDIF

RETURN ( oldActive )



/*** 
* 
*  Updated() 
* 
*/ 
FUNCTION Updated() 
RETURN slUpdated



/*** 
* 
*  ReadExit() 
* 
*/ 
FUNCTION ReadExit( lNew ) 
RETURN ( SET( _SET_EXIT, lNew ) )



/*** 
* 
*  ReadInsert() 
* 
*/ 
FUNCTION ReadInsert( lNew ) 
RETURN ( SET( _SET_INSERT, lNew ) )



/*** 
*              Wacky Compatibility Services 
*/ 


// Display coordinates for SCOREBOARD 
#define SCORE_ROW      0 
#define SCORE_COL      60 


/*** 
* 
*  ShowScoreboard() 
* 
*/ 
STATIC PROCEDURE ShowScoreboard() 
LOCAL nRow
LOCAL nCol

IF ( SET( _SET_SCOREBOARD ) )
   nRow := ROW()
   nCol := COL()

   SETPOS( SCORE_ROW, SCORE_COL )
   DISPOUT( IF( SET( _SET_INSERT ), NationMsg(_GET_INSERT_ON),;
                                NationMsg(_GET_INSERT_OFF)) )
   SETPOS( nRow, nCol )
ENDIF
RETURN



/*** 
* 
*  DateMsg() 
* 
*/ 
STATIC PROCEDURE DateMsg() 
LOCAL nRow
LOCAL nCol

IF ( SET( _SET_SCOREBOARD ) )

   nRow := ROW()
   nCol := COL()

   SETPOS( SCORE_ROW, SCORE_COL )
   DISPOUT( NationMsg(_GET_INVD_DATE) )
   SETPOS( nRow, nCol )

   WHILE ( NEXTKEY() == 0 )
   END

   SETPOS( SCORE_ROW, SCORE_COL )
   DISPOUT( SPACE( LEN( NationMsg(_GET_INVD_DATE) ) ) )
   SETPOS( nRow, nCol )

ENDIF
RETURN



/*** 
* 
*  RangeCheck() 
* 
*  NOTE: Unused second param for 5.00 compatibility. 
* 
*/ 
FUNCTION RangeCheck( oGet, junk, lo, hi ) 
LOCAL cMsg, nRow, nCol
LOCAL xValue

IF ( !oGet:changed )
   RETURN ( .T. )          // NOTE
ENDIF

xValue := oGet:varGet()

IF ( xValue >= lo .and. xValue <= hi )
   RETURN ( .T. )          // NOTE
ENDIF

IF ( SET(_SET_SCOREBOARD) )

   cMsg := NationMsg(_GET_RANGE_FROM) + LTRIM( TRANSFORM( lo, "" ) ) + ;
           NationMsg(_GET_RANGE_TO) + LTRIM( TRANSFORM( hi, "" ) )

   IF ( LEN( cMsg ) > MAXCOL() )
      cMsg := SUBSTR( cMsg, 1, MAXCOL() )
   ENDIF

   nRow := ROW()
   nCol := COL()

   SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - LEN( cMsg ) ) )
   DISPOUT( cMsg )
   SETPOS( nRow, nCol )

   WHILE ( NEXTKEY() == 0 )
   END

   SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - LEN( cMsg ) ) )
   DISPOUT( SPACE( LEN( cMsg ) ) )
   SETPOS( nRow, nCol )

ENDIF
RETURN ( .F. )



/*** 
* 
*  ReadKill() 
* 
*/ 
FUNCTION ReadKill( lKill ) 
LOCAL lSavKill := slKillRead

IF ( PCOUNT() > 0 )
   slKillRead := lKill
ENDIF

RETURN ( lSavKill )



/*** 
* 
*  ReadUpdated() 
* 
*/ 
FUNCTION ReadUpdated( lUpdated ) 
LOCAL lSavUpdated := slUpdated

IF ( PCOUNT() > 0 )
   slUpdated := lUpdated
ENDIF

RETURN ( lSavUpdated )



/*** 
* 
*  ReadFormat() 
* 
*/ 
FUNCTION ReadFormat( b ) 
LOCAL bSavFormat := sbFormat

IF ( PCOUNT() > 0 )
   sbFormat := b
ENDIF

RETURN ( bSavFormat )

Abraços,

Deivid