Boa tarde amigos .. sei q o topico é antigo .. porem estou migrando meu sistema de xharbour para harbour 3.2 .. e do antes funcionava perfeitamente meu GETSYS modificado em xharbour e agora no harbour 3.2 não consigo colocar um campo de desconto com sinal de "-" (menos) ou seja negativo .. ele até aparece o menos quando digito, porem quando começo a digitar os numeros ele some ... alguem já passou por isso na migração ?? segue meu getsys modificado pra ver se alguem consegue me dar um help ... forte abraço!
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 (nKey == K_CTRL_DEL) // LIMPA PALAVRA POR PALAVRA // K_CTRL_DEL // 403
oGet:delWordRight()
CASE (nKey == K_CTRL_Y) // LIMPA CAMPO // K_CTRL_Y // 537
oGet:delEnd()
CASE (nKey == K_CTRL_BS) // LIMPA PALAVRA POR PALAVRA // K_CTRL_BS // BACKSPACE // 127
oGet:delWordLeft()
/*
CASE (nKey == K_CTRL_C) //para Copiar // CTRL + C // 515
if oGet:type == "N"
WVT_SetClipboard( Alltrim(StrTran(StrTran(get:buffer,'.',''),',','.') ) )
Else
WVT_SetClipboard( Alltrim(oGet:buffer) )
Endif
CASE (nKey == K_CTRL_V) //Para Colar // CTRL + V // 534
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 )
"
