get temporizado

[MARCELOG]

Olá companheiros,
estou quase desistindo de criar um get temporizado, todas as mudanças efetuadas em Getsys e TGetlist não surtiram efeito.
Todavia, mais uma vez, recorro aos amigos para saber se alguém pode me ajudar a criar um "get temporizado", ou seja, se o usuário ficar determindo tempo no get sem qualquer ação, ele é abandonado como se a tecla "ESC" tivesse sido acionada.

No Clipper 5.2 era só alterar o GETSYS.PRG e pronto, mas no xHarbour, a coisa não é tão simples assim.

Desde já, obrigado.

MGS

[Marco]

Marcelo tente esse codigo aqui, substitua os seus read´s pela funcao Le()

#define GE_NOEXIT 0 // no exit attempted (blank)
#command READ TIMEOUT AT <n> ;
=> ;
Aeval(GetList, ;
{|o| o:reader := ;
{|oGet| TimedReader(oGet, <n>) } }) ;;
READ


Function Le()
LOCAL vcursor
vcursor:=SETCURSOR(1) // Liga o cursor
READ TIMEOUT AT 10 // 10 significa q em 10s o get eh abortado
SETCURSOR(vcursor) // Volta o cursor ao formato anterior
RETURN(.T.)



proc TimedReader( get, nTimeOut )

LOCAL nKey, string,mode

SetCursor(1)
// read the GET if the WHEN condition is satisfied
IF ( GetPreValidate(get) )
// activate the GET for reading
get:SetFocus()

DO WHILE ( get:exitState == GE_NOEXIT )
// check for initial typeout (no editable positions)
IF ( get:typeOut )
get:exitState := GE_ENTER
ENDIF

// apply keystrokes until exit
DO WHILE ( get:exitState == GE_NOEXIT )
IF (nKey := INKEYY(nTimeOut)) != 0
GetApplyKey(get, nKey)
ELSE
KeyBoard Chr(27)
Get:KillFocus()
ENDIF
ENDDO

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

// de-activate the GET
get:KillFocus()
ENDIF

RETURN

:xau

[MARCELOG]

Companheiros,
eu devia ter insistido um pouco mais.

Mas tudo bem, valeu a atenção, e mesmo a destenção daqueles que ousaram visualizar o tópico.

Obrigado Marco, valeu mesmo!

Mas a sua sugestão não serviria para mim, pois utilizo diversos gets especiais (tbrowse, listbox, checkbox, etc.) que preciam do reader do xHarbour para funcionar.

Todavia, o truque é o seguinte:

No TGetList.prg, é so acrescentar um variável de tempo (no meu caso nTempo) que, se exaurida, retorna o código da tecla ESC que é normalmente avaliado pelos demais métodos.

xx:=inkey(nTempo)


Se o xx for igual a 0, é porque o tempo esgotou-se, assim, eu devo atribuir a xx o valor de ESC(27)

Se alguma tecla for pressionada, nós sabemos que o inkey() retornará o número da tecla.

Então, não sendo zero, xx será o valor da tecla e por aí vai.

Atenção, a critério deve ser utilizado em todos métodos e verificação da teclas.

while oGet:exitState == GE_NOEXIT .and. !::lKillRead
setCursor( iif( ::nSaveCursor == SC_NONE, SC_NORMAL, ::nSaveCursor ) )
nKey := INKEY( nTempo )
If nKey == 0
nKey := 27
Endif
setCursor( SC_NONE )
::GetApplyKey( nKey, oMenu, oGetMsg, lDelEnd )
oGetMsg:Show( oGet )
end
...

Novamente, mais uma vez.

Obrigado.


MGS

[momente]

Companheiros,

Estou com o seguinte problema:
Eu fiz alterações na getlist.prg e na tgetlist.prg do xharbour para ficar com as mesmas funções que eu utilizava no clipper, estou compilando as prgs alteradas junto com meu sistema, mas o xharbour simplesmente ignora. Estou utilizando a xdev para gerar o aplicativo.

Alguém poderia me dizer se precisa ser feito mais alguma coisa para o xharbour acatar minhas alterações?

Obrigado!

[asimoes]

Senhores,

Eu uso get temporizado e funciona perfeitamente, vejam o código abaixo e façam os testes.

Para usar o get temporizado:

Verifiquem as funções no getsys.prg:

FUNC IN_KEY()
PROCEDURE MOSTRA_AN()
FUNCTION SEGUNDOS(cl_time)

Exemplo prático:

Tornar publica a váriavel VX_MOSTRA no seu programa principal.
O tempo está definido para esperar 30 segundos inatividade no campo que é controlado pela função MOSTRA_AN()

PUBLIC VX_MOSTRA := .F.

VX_MOSTRA := .T. //Liga o contador de Tempo no Get
@ 06,08 GET cVar PICTURE "@!" VALID !Empty(cVar) COLOR "W+/B,B/GR*"
Read
VX_MOSTRA := .F. //Desliga o contador de tempo

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
*
*/

#include "Inkey.ch"
#include "Getexit.ch"
#include "setcurs.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()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ReadMODAL(GetList,nPos)

LOCAL oGet
LOCAL aSavGetSysVars

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

While !(nPos == 0)
   SET CURSOR ON
   // 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
RestoreGetSysVars(aSavGetSysVars)

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

RETURN (slUpdated)

/***
*
*  GetReader()
*
*  Standard modal read of a single GET
*
*/

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    PROCEDURE GetReader()
*+
*+    Called from ( getsys.prg   )   1 - function readmodal()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
PROCEDURE GetReader(oGet)

// Read the GET if the WHEN condition is satisfied
SET CURSOR ON
If (GetPreValidate(oGet))

   // Activate the GET for reading
   SET CURSOR ON
   oGet:setFocus()

   While (oGet:exitState == GE_NOExit)

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

      // Apply keystrokes until exit
      While (oGet:exitState == GE_NOExit)
         GetApplyKey(oGet,in_key(0))
      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

/***
*
*  GetApplyKey()
*
*  Apply a single Inkey() keystroke to a GET
*
*  NOTE: GET must have focus.
*
*/

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    PROCEDURE GetApplyKey()
*+
*+    Called from ( getsys.prg   )   1 - procedure getreader()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
PROCEDURE GetApplyKey(oGet,nKey)

LOCAL cKey
LOCAL bKeyBlock

SET CURSOR ON
// 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: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)
   oGet:left()

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

Case (nKey == K_CTRL_LEFT)
   oGet:wordLeft()

Case (nKey == K_BS)
   oGet:backSpace()

Case (nKey == K_DEL)
   oGet:delete()

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 (oGet:type == "N" .And. (cKey == "." .Or. cKey == ","))
         oGet:toDecPos()
      Else

         If (SET(_SET_INSERT))
            oGet:insert(cKey)
         Else
            oGet:overstrike(cKey)
         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()
*+
*+    Called from ( getsys.prg   )   1 - procedure getreader()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
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()
*+
*+    Called from ( getsys.prg   )   1 - procedure getreader()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
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()
*+
*+    Called from ( getsys.prg   )   1 - procedure getapplykey()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
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()
*+
*+    Called from ( getsys.prg   )   2 - function readmodal()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
STATIC FUNCTION Settle(GetList,nPos)

LOCAL nExitState

SET CURSOR ON
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 --
   V_TMPGET1 := Time()

Case (nExitState == GE_DOWN)
   nPos ++
   v_tmpget1 := Time()

Case (nExitState == GE_TOP)
   nPos       := 1
   slBumpTop  := .T.
   nExitState := GE_DOWN
   v_tmpget1  := Time()

Case (nExitState == GE_BOTTOM)
   nPos       := LEN(GetList)
   slBumpBot  := .T.
   nExitState := GE_UP
   v_tmpget1  := Time()

Case (nExitState == GE_ENTER)
   nPos ++
   v_tmpget1 := Time()

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()
*+
*+    Called from ( getsys.prg   )   1 - function readmodal()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
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()
*+
*+    Called from ( getsys.prg   )   1 - function readmodal()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
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()
*+
*+    Called from ( getsys.prg   )   1 - function readmodal()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
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()
*+
*+    Called from ( getsys.prg   )   1 - STATIC procedure postactiveget()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
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()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
PROCEDURE __SetFormat(b)

sbFormat := If(VALType(b) == "B",b,Nil)
RETURN

/***
*
*  __KillRead()
*
*  CLEAR GETS service
*
*/

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    PROCEDURE __KillRead()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
PROCEDURE __KillRead()

slKillRead := .T.
RETURN

/***
*
*  GetActive()
*
*  Retrieves currently active GET object
*/

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    FUNCTION GetActive()
*+
*+    Called from ( getsys.prg   )   1 - STATIC procedure postactiveget()
*+                                   1 - STATIC function cleargetsysvars()
*+                                   1 - STATIC procedure restoregetsysvars()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION GetActive(g)

LOCAL oldActive := soActiveGet

If (PCount() > 0)
   soActiveGet := g
EndIf

RETURN (oldActive)

/***
*
*  Updated()
*
*/

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    FUNCTION UPDateD()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION UPDateD()

RETURN slUpdated

/***
*
*  ReadExit()
*
*/

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    FUNCTION ReadExit()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ReadExit(lNew)

RETURN (SET(_SET_Exit,lNew))

/***
*
*  ReadInsert()
*
*/

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    FUNCTION 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()
*+
*+    Called from ( getsys.prg   )   1 - procedure getapplykey()
*+                                   1 - function getprevalidate()
*+                                   2 - function getpostvalidate()
*+                                   1 - procedure getdosetkey()
*+                                   1 - STATIC procedure postactiveget()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
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()
*+
*+    Called from ( getsys.prg   )   1 - function getpostvalidate()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
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()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION RangeCheck(oGet,junk,lo,hi)

LOCAL cMsg
LOCAL nRow
LOCAL 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()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ReadKill(lKill)

LOCAL lSavKill := slKillRead

If (PCount() > 0)
   slKillRead := lKill
EndIf

RETURN (lSavKill)

/***
*
*  ReadUpdated()
*
*/

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    FUNCTION ReadUpdated()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ReadUpdated(lUpdated)

LOCAL lSavUpdated := slUpdated

If (PCount() > 0)
   slUpdated := lUpdated
EndIf

RETURN (lSavUpdated)

/***
*
*  ReadFormat()
*
*/

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    FUNCTION ReadFormat()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ReadFormat(b)

LOCAL bSavFormat := sbFormat

If (PCount() > 0)
   sbFormat := b
EndIf

RETURN (bSavFormat)

// ****************************************************

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    FUNCTION IN_KEY()
*+
*+    Called from ( getsys.prg   )   1 - procedure getreader()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNC IN_KEY(N_seg)

LOCAL ret_orno
LOCAL nRow     := ROW()
LOCAL nCol     := COL()
Do While .T.
   If VALType(N_seg) != 'N'
      ret_orno := Inkey()
      Exit
   ElseIf (N_seg == 0)
      ret_orno := Inkey()
      If ret_orno != 0
         Exit
      EndIf
   Else
      ret_orno := Inkey(N_seg)
      Exit
   EndIf
   If VX_MOSTRA
      If !MOSTRA_AN()
         Keyboard CHR(27)+"S"
         Exit
      EndIf
   EndIf
EndDo
CURSOR("ON")
SETPOS(nRow,nCol)
RETURN ret_orno
// ***************************************************
PROCEDURE MOSTRA_AN()
LOCAL vCorAnt
LOCAL OK      := .T.
v_tmptot2 := Time()
vTemp_and := SEGUNDOS(v_tmptot2) - SEGUNDOS(v_tmptot1)
vTemp_and := SEGUNDOS(v_tmptot2) - SEGUNDOS(v_tmpget1)
If vTemp_and > 30
   OK := .F.
EndIf
SETCOLOR(vCorAnt)
RETURN OK

FUNCTION SEGUNDOS(cl_time)

RETURN VAL(cl_time) * 3600+;
                  VAL(SUBSTR(cl_time,4)) * 60+;
                  VAL(SUBSTR(cl_time,7))

*+ Eof: GETSYS.PRG

[momente]

Colega asimoes,

Meu sistema nem reconhece a getlist que estou compilando junto, fiz vários testes, e nada.

este exemplo que vc deixou, vc esta conseguindo compilar no xharbour? vc esta usando a xdev?

valeu!

[asimoes]

Olá Momente,

Este exemplo funciona com meus sistemas em xHarbour e também em clipper.
Com xharbour uso somente o hbmake. Não dá erro nenhum.

Um detalhe, o meu fonte está getsys2.prg, experimente usar este nome.

Se for usar o hbmake acrescente ele na lista de prgs.

[]´s