Veja o mey getsys.prg modificado para fazer algumas coisas enquanto ninguém faz nada dentro do get.
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"
/***
* 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
Private GetInAnda:=.f.,o_local5:=0,o_local6:=0,contaloc6:=0,o_baixo:=.f.
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 )
// 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
_c_cursor := setcursor() // Alterado por M rio Ilha
set cursor on
GetReader( oGet , Getlist , npos ) // Use standard reader
setcursor(_c_cursor) // Alterado por M rio Ilha
//Alterado por M rio Ilha
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( oGet , GetMouse , nPosMouse)
// Read the GET if the WHEN condition is satisfied
IF ( GetPreValidate( oGet ) )
// Activate the GET for reading
oGet:setFocus()
// Introdu‡Æo por M rio Ilha
if tipoprog == "ST" .and. search_proc('MENUCAD') .and. ttt=6 .and. (opcao = 1 .or. (opcao = 3 .and. cliente->tp # mmtp)) .and. oget:name = 'MCPF'
oget:picture := if(mmtp <= 1,'999.999.999-99----','99.999.999/9999-99')
oget:buffer := if(mmtp <= 1,' . . - ----',' . . / - ')
end
// Introdu‡Æo por M rio Ilha
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 )
// Introdu‡Æo por M rio Ilha
//minit()
if !GetInAnda
o_local5 := 0
End
ctazero := ctafoca := cta_ok := cta_get := seconds()
//clear typeahead
do while (o_Local5 == 0) .and. !GetInAnda
while .t.
if volta_ao_main
o_local5 := 27
keyboard 27
setlastkey(27)
else
setlastkey(0)
o_Local5=inkey(5) //inkey()
end
if o_local5 = 272
volta_ao_main := .t.
end
olhatarja(o_local5)
refazimag()
if file(fechatudo) .and. type('estacao')="C"
ferase('ok'+estacao+'.txt')
ferase(fechatudo)
clear all
main(2)
end
if file(fech_file) .and. type('estacao')="C"
fechar_file(memoread(fech_file))
end
if file(open_file)
ferase(open_file)
end
if file(derruba)
rastro('derruba','derrubou='+dtoc(date())+'='+time())
ferase(derruba)
saiimed()
end
if (seconds() - cta_get > 1800) .or. volta_ao_main
// 180 --> 1800
o_local5 := 27
keyboard 27
setlastkey(27)
end
if o_Local5 # 0 .and. o_local5 <= 600
_if_contador := seconds()
//mend()
if strzero(o_local5,2) $ '13 27 23'
rastro('getsys',oget:name+'/'+oget:buffer)
end
if strzero(o_local5,3) $ '028 -01 -02 -03 -04 -05 -06 -07 -08 -10 -11 -12 -13 -14 280 -40'
inserta_do_get := o_local5
o_local5 := 13
keyboard 13
end
cta_get := seconds()
exit
end
veseoff()
if (seconds() - _if_cta_hora > 3000 )
rastro('hora','Vend.: ='+strzero(ovendedor,2)+'=/'+dtoc(date())+'/'+time() )
_if_cta_hora := seconds()
end
botmouse := tatico_mous(o_local5) //M_Stat()
if botmouse == 3 // duplo clique
o_local5 := 13
SetLastkey(o_local5)
exit
elseif botmouse == 2 // > 0
o_local5 := 27
SetLastkey(o_local5)
exit
elseif strzero(botmouse,2) == '01' .and. (mrow() > 25 .or. mcol() > 79) .and. tipoprog+tipoempre == "STB"
inserta_do_get := o_local5
o_local5 := 13
keyboard 13
exit
elseif botmouse > 0 // == 8
// o_Local5 := 23 // Ctrl W
o_Local5 := tecmousget(GetMouse,botmouse,mrow(),mcol()) // m_ypos()/8,m_xpos()/8)
if o_Local5 = 100000
o_local5 := setas()
if o_local5 == 272
volta_ao_main := .t.
o_local5 := 27
keyboard 27
setlastkey(27)
exit
end
end
if o_local5 = 0 .and. strzero(botmouse,2) == '01' .and. type('colu_inic') # "U"
_mlinha := mrow() // 0 //m_ypos()/8
_mcolun := mcol() // 0 //m_xpos()/8
_ctelem := 3
_klinhav := 1
while _klinhav <= 2 .and. _ctelem-2 <= colu_inic[_klinhav,2] .and. _ctelem <= len(colu_inic[_klinhav])
if botmouse > 0 .and. _mlinha = colu_inic[_klinhav,1] .and. _mcolun >= colu_inic[_klinhav,_ctelem] .and. _mcolun <= colu_fina[_klinhav,_ctelem]
botmouse := 0
o_local5 := colu_teca[_klinhav,_ctelem]
_if_contador := seconds()
keyboard o_local5
exit
end
_ctelem++
if _ctelem-2 > colu_inic[_klinhav,2]
_ctelem := 3
_klinhav++
end
end
end
botmouse := 0
if o_Local5 # 0
_if_contador := seconds()
if strzero(o_local5,3) $ '028 -01 -02 -03 -04 -05 -06 -07 -08 -10 -11 -12 -13 -14 280 -40'
inserta_do_get := o_local5
o_local5 := 13
keyboard 13
end
SetLastkey(o_local5)
exit
end
end
end
end
// Final de Introdu‡Æo por M rio Ilha
if o_local5 < 100000 .and. !GetInAnda // Altera‡Æo M rio Ilha
/*if o_local5 == 13
rastro( 'get' , o_local5 )*/
GetApplyKey( oGet, o_local5 ) // inkey( 0 ) ) Troquei inkey(0) por o_local5
else // Desse else at‚ o fim
If !GetInAnda
o_local6 := o_local5 - 100000
GetInAnda := .t.
contaloc6 := nposmouse
o_baixo := o_local6 >= contaloc6
End
if o_local6 = contaloc6
GetInAnda := .f.
else
if if(o_baixo,contaloc6 <= o_local6,o_local6 <= contaloc6)
GetApplyKey( oGet, if(o_baixo,24,5) ) // 24 = Seta para baixo
if o_baixo
contaloc6++
else
contaloc6--
end
//if(o_baixo,contaloc6++,contaloc6--)
if if(o_baixo,contaloc6 > o_local6,o_local6 > contaloc6)
GetInAnda := .f.
end
else
GetInAnda := .f.
end
end
//GetApplyKey( oGet, o_local5 ) // inkey( 0 ) ) Troquei inkey(0) por o_local5
end
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( oGet, nKey )
LOCAL cKey
LOCAL bKeyBlock
// In¡cio Altera‡Æo Stoq2000
nkey2 := nkey
// Fim Altera‡Æo Stoq2000
// 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 )
// In¡cio Altera‡Æo STOQ2000
noproc = if(type('noproc')="U",'',noproc)
if tipoprog+tipoempre == "STG" .and. upper(oget:name) = 'ONDEGETA' .and. search_proc('VENDAS') // Editar o total
edita_total()
else
oGet:exitState := GE_WRITE
end
CASE ( nKey == K_PGDN )
// In¡cio Altera‡Æo Stoq2000
noproc = if(type('noproc')="U",'',noproc)
if (noproc = 'MENUCAD' .and. !upper(oget:name) $ "M->NOMINHO SVENDEDOR DBEDIT_ONDEGETA")
lValid256 := EVAL( oGet:postBlock, oGet )
rele lValid256
else
// Fim Altera‡Æo Stoq2000
oGet:exitState := GE_WRITE
end
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 == 535) .or. nKey == 23 // K_CTRL_W ) ou ctrl_end
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 == 532 ) // K_CTRL_T )
oGet:delWordRight()
CASE ( nKey == 537 ) // K_CTRL_Y )
oGet:delEnd()
CASE ( nKey == K_CTRL_BS )
oGet:delWordLeft()
CASE ( nKey == 515 ) // K_CTRL_C )
COPYSTRINGTOCLIPBOARD( trim(oget:buffer) ) // envia para a area de transferˆncia
OTHERWISE
IF ( nKey >= 32 .AND. nKey <= 255 ) .or. nKey == 534 // Ctrl_V
if nkey >= 32 .and. nkey <= 255
cKey := CHR( nKey )
else
cKey := GTGETCLIPBOARD()
end
IF ( oGet:type == "N" .AND. ( cKey == "." .OR. cKey == "," ) )
oGet:toDecPos()
ELSE
trans_si_key := ''
_ct_len_ckey := 1
while _ct_len_ckey <= len(ckey)
// In¡cio Altera‡Æo Stoq2000
sl_oCarac1 = ' ‚¡¢£Æ䃈Œ“–…Š•—„‰‹”‡¤'
if ! oGet:Picture = NIL
if "!" $ oGet:Picture .and. oGet:type == "C" .and. subs(cKey,_ct_len_ckey,1) $ sl_oCarac1
sl_oCarac2 = 'µÖàéÇå¶Ò×âê·ÔÞãëŽÓØ™š€¥'
trans_si_key += subs(sl_oCarac2,at(subs(cKey,_ct_len_ckey,1),sl_oCarac1),1)
release sl_oCarac2
else
trans_si_key += subs(cKey,_ct_len_ckey,1)
End
End
release sl_oCarac1
// Fim Altera‡Æo Stoq2000
_ct_len_ckey++
end
cKey := trans_si_key
_ct_len_ckey := 1
while _ct_len_ckey <= len(ckey)
IF ( SET( _SET_INSERT ) )
oGet:insert( subs(cKey,_ct_len_ckey,1) )
ELSE
oGet:overstrike( subs(cKey,_ct_len_ckey,1) )
ENDIF
_ct_len_ckey++
end
// Altera‡Æo Data-House
if tipoprog == "ST" .and. procname(10)+procname(3)='MENUCADENTRADA' .and. str(ttt,1)+oGet:Name+str(opcao,1) $ '5TIP1 5TIP3 5NOMPC1 6ENDC1'
estavasy := select()
dbselectar(if(ttt=5,'MERCAD','CLIENTE'))
yesrecno := recno()
eraorder := ordnumber()
do case
case oget:name == 'TIP'
mapsetorder(3) ; avargsy := 'TIPMER'
case oget:name == 'NOMPC'
mapsetorder(2) ; avargsy := 'NOMMER'
case oget:name == 'ENDC'
mapsetorder(3) ; avargsy := 'ENDCLI'
end
if !empty(oGet:Buffer) .and. dbseek(semAcento(trim(subs(oGet:Buffer,1,oGet:Pos-1)))) ;
.and. if(opcao == 1 .or. oget:name == 'TIP', .t. , empty(subs(oGet:Buffer,oGet:pos)) ) ;
.and. if (oget:name=='NOMPC' .and. oget:pos > 15, .f., .t.) ;
.and. nkey # 32
oGet:Buffer := &avargsy
do case
case oget:name == 'TIP'
inverso(13,25-1+oGet:Pos,subs(tipmer,oGet:Pos))
case oget:name == 'NOMPC'
inverso(5,25-1+oGet:Pos,subs(nommer,oGet:Pos,30-oGet:pos))
case oget:name == 'ENDC'
inverso(7,21-1+oGet:Pos,subs(endcli,oGet:Pos))
end
end
mapsetorder(eraorder)
dbgoto(yesrecno)
dbselectar(estavasy)
release estavasy,eraorder,yesrecno,avargsy,m_yposalias
end //Final altera‡Æo datahouse
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() )
// In¡cio Altera‡Æo Stoq2000
Tecle('Data Inv lida.')
// Fim Altera‡Æo Stoq2000
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 )
// Fun‡Æo Inclu¡da por Data-House
Static Function TecmousGet(GetMouse,botmouse,limous,comous)
// m_ypos()/8 ‚ linha
// m_xpos()/8 e coluna
Local _ctelem := 1
if botmouse == 2
botmouse := 0
//Mend()
return 23 // Ctrl + W
end
while _ctelem <= len(GetMouse)
os_namer := GetMouse[_ctelem]:name
os_linha := GetMouse[_ctelem]:row
os_colun := GetMouse[_ctelem]:col
if valtype(&os_namer) = "C"
os_lengh := len(&os_namer)
elseif valtype(&os_namer) = "D"
os_lengh := 10
elseif valtype(&os_namer) = "N"
// os_pict := GetMouse[_ctelem]:picture
os_lengh := len(GetMouse[_ctelem]:picture) // len(os_pict)
elseif valtype(&os_namer) = "L"
os_lengh := 2
end
if botmouse > 0 .and. limous = os_linha .and. comous >= os_colun .and. comous <= os_colun + os_lengh - 1
botmouse := 0
//mend()
return 100000+_ctelem
end
_ctelem++
end
return 100000
