Aproveitar pra mostrar como ajustar os erros da compilação -w3 -es2 (chamo de tolerância zero), e vantagens.
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"
STATIC snMRow, snMCol
STATIC nMRow, nMCol
/***
* 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
PUBLIC nKey2 := SPACE(0)
PRIVATE GetMsg := {},PosMsg:=nPos
FOR nI := 1 TO LEN(GetList)
IF VALTYPE(GetList[nI])<>"O"
AADD(GetMsg ,GetList[nI,2])
GetList[nI] := GetList[nI,1]
ELSE
AADD(GetMsg ,)
ENDIF
NEXT
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 )
PosMsg:=nPos
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 )
PosMsg:=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 )
LOCAL nTempo, nTemp, nCursor1, nCursor2, lRestaura := .F.
PRIVATE cGetMsg, nLINAJU1, nLINAJU2, nCOLAJU1, nCOLAJU2
// 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
// Apply keystrokes until exit
IF ( oGet:type == "N" )
oGet:pos := oGet:decPos()-1
oGet:display()
ENDIF
SETPOS(oGet:row,oGet:col)
WHILE ( oGet:exitState == GE_NOEXIT )
IF ( oGet:type == "N" ) .AND. (oGet:pos < oGet:decPos )
oGet:pos := oGet:decPos()-1
oGet:display()
ENDIF
IF nTempo <> 0
GetApplyKey( oGet, INKEY(0)) // minkey( 0, @snMrow, @snMCol ) )
ELSE
SET CURSOR ON
oGet:display()
ENDIF
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
IF lRestaura
ENDIF
RETURN
/***
*
* GetApplyKey()
*
* Apply a single INKEY() keystroke to a GET
*
* NOTE: GET must have focus.
*
*/
PROCEDURE GetApplyKey( oGet, nKey )
LOCAL cKey
LOCAL bKeyBlock
LOCAL nTemp
LOCAL lTmp, lDec, lDec0
// Check for SET KEY first
IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
GetDoSetKey( bKeyBlock, oGet )
RETURN // NOTE
ENDIF
DO CASE
// CASE ( nKey == 45 ) .AND. SUBSTR(oGet:buffer,oGet:decPos()-1,1) == "0"
// oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-2)+"-"+SUBSTR(oGet:buffer,oGet:decPos()-1)
// oGet:display()
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:changed := .T.
oGet:exitState := GE_ENTER
nKey2 := SPACE(0)
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()
nKey2 := SPACE(0)
CASE ( nKey == K_LEFT )
oGet:left()
nKey2 := SPACE(0)
CASE ( nKey == K_CTRL_RIGHT )
oGet:wordRight()
nKey2 := SPACE(0)
CASE ( nKey == K_CTRL_LEFT )
oGet:wordLeft()
nKey2 := SPACE(0)
CASE ( nKey == K_BS ) .OR. ((nKey == K_DEL) .AND. (oGet:type =="N"))
IF ( oGet:type == "N" ) .AND. (oGet:pos < oGet:decPos )
IF AT(".",oGet:buffer) <> 0 .OR. AT(",",oGet:buffer) <> 0
oGet:pos := oGet:decPos()-1
nTemp := oGet:unTransform()
nTemp := (nTemp-INT(nTemp)) + INT(nTemp / 10)
ELSE
oGet:pos := oGet:decPos()-1
oGet:delete()
nTemp := oGet:unTransform()
ENDIF
oGet:buffer := Transform(nTemp,oGet:picture)
oGet:pos := oGet:decPos()-1
oGet:display()
ELSE
IF (oGet:type="N").AND.(oGet:pos=oGet:decPos+1).AND.(nKey<>K_DEL)
oGet:pos := oGet:decPos()-1
KEYBOARD CHR( K_BS )
ELSE
IF ( nKey == K_DEL )
oGet:delete()
ELSE
oGet:backSpace()
ENDIF
oGet:display()
ENDIF
ENDIF
CASE ( nKey == K_DEL )
oGet:delete()
CASE ( nKey == K_CTRL_T )
oGet:delWordRight()
CASE ( nKey == K_CTRL_Y )
IF oGet:type == "N"
nTmp := oGet:pos
oGet:pos := 01
oGet:delEnd()
oGet:pos := nTmp
oGet:display()
ELSE
oGet:delEnd()
ENDIF
CASE ( nKey == K_CTRL_BS )
oGet:delWordLeft()
OTHERWISE
lIns := .T.
IF ( nKey >= 32 .AND. nKey <= 255 )
IF ! EMPTY(nKey2) .AND. oGet:type == "C"
lIns := Acentos(oGet, nKey2, @nKey)
nKey2 := SPACE(0)
ENDIF
cKey := CHR( nKey )
IF ( oGet:type == "N" .AND. ( cKey == "." .OR. cKey == "," ) )
lTmp := AT("-",oGet:buffer) <> 0
IF oGet:Clear
oGet:buffer := Transform(0,oGet:picture)
ENDIF
oGet:toDecPos()
IF lTmp .AND. AT("-",oGet:buffer) == 0
oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-2)+"-"+SUBSTR(oGet:buffer,oGet:decPos()-1)
oGet:buffer := SUBSTR(oGet:buffer,2)
ENDIF
oGet:display()
ELSEIF ( oGet:type == "N" ) .AND. (oGet:pos < oGet:decPos ) .AND. ;
((nKey >= ASC('0') .AND. nKey <= ASC('9')) .OR. UPPER(CHR(nKey))="C";
.OR. nKey == ASC('+') .OR. nKey == ASC('-'))
nTemp := oGet:unTransform()
IF UPPER(cKey) == "C" .OR. oGet:clear
oGet:clear := .F.
nTemp = 0
oGet:buffer := Transform(nTemp,oGet:picture)
oGet:display()
ENDIF
lDec := AT(".",Transform(0,oGet:picture))
IF(lDec==0,lDec := AT(",",Transform(0,oGet:picture)),lDec)
lDec0 := IF(lDec<>0,IF(LEN(oGet:buffer) > (lDec+1),.T.,.F.),.T.)
lDec := IF(lDec<>0,.T.,.F.)
IF(oGet:picture==NIL,lDec0:=.T.,)
IF LEN((oGet:buffer)) >= (LEN(ALLTRIM(oGet:buffer))+1)
IF oGet:type == "N" .AND. cKey == "-"
nKey2 := ASC("-")
ELSE
lTmp := AT("-",oGet:buffer) <> 0
nTemp := (nTemp-INT(nTemp)) + INT(nTemp * 10)
oGet:buffer := Transform(nTemp,oGet:picture)
IF nTemp = 0 .AND. lTmp
IF LEN(oGet:buffer) < oGet:decPos() .and. 1 = 2
oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-3)+"-"+SUBSTR(oGet:buffer,oGet:decPos()-2)
oGet:buffer := SUBSTR(oGet:buffer,2)
ELSE
oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-IF(lDec0,2,3))+"-"+SUBSTR(oGet:buffer,oGet:decPos()-IF(lDec0,1,2))
oGet:buffer := SUBSTR(oGet:buffer,2)
ENDIF
ENDIF //2 1
oGet:pos := oGet:decPos() -IF(oGet:picture<>NIL .AND. lDec, IF(lTmp .AND. LEN(oGet:buffer) < oGet:decPos(),2,1),0)
oGet:overstrike( cKey ) //2 1
oGet:pos := oGet:decPos() -IF(oGet:picture<>NIL .AND. lDec, IF(lTmp .AND. LEN(oGet:buffer) < oGet:decPos(),2,1),0)
ENDIF
IF VALTYPE(nKey2) == "N" .AND. cKey == "-"
lTmp := AT("-",oGet:buffer) == 0
nTemp := oGet:unTransform()
nTemp *= (-1)
oGet:buffer := Transform(nTemp,oGet:picture)
IF nTemp = 0 .AND. lTmp
IF LEN(oGet:buffer) < oGet:decPos() .and. 1 = 2
oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-3)+"-"+SUBSTR(oGet:buffer,oGet:decPos()-2)
oGet:buffer := SUBSTR(oGet:buffer,2)
ELSE
oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-IF(lDec0,2,3))+"-"+SUBSTR(oGet:buffer,oGet:decPos()-IF(lDec0,1,2))
oGet:buffer := SUBSTR(oGet:buffer,2)
ENDIF
ENDIF
ENDIF
IF VALTYPE(nKey2) == "N"
nKey2 := SPACE(0)
ENDIF
oGet:display()
IF LEN(SUBSTR(oGet:buffer,1,oGet:decpos-1))==LEN(ALLTRIM(SUBSTR(oGet:buffer,1,oGet:decpos-1))) .AND. (!SET(_SET_CONFIRM))
oGet:exitstate:=GE_ENTER
ENDIF
ELSEIF LEN(SUBSTR(oGet:buffer,1,oGet:decpos-1)) == 1 .AND. (oGet:pos < oGet:decPos )
oGet:overstrike(cKey)
oGet:pos := oGet:decPos()
oGet:display()
IF LEN(SUBSTR(oGet:buffer,1,oGet:decpos-1))==1 .AND. (!SET(_SET_CONFIRM))
oGet:exitstate:=GE_ENTER
ENDIF
ELSE
IF ( !SET( _SET_CONFIRM ) )
oGet:exitState := GE_ENTER
ELSE
?? CHR(7)
ENDIF
ENDIF
IF oGet:type == "N" .AND. cKey == "-"
nKey2 := nKey
ENDIF
ELSE
IF ( SET( _SET_INSERT ) ) .AND. lIns
oGet:insert( cKey )
ELSE
oGet:overstrike( cKey )
ENDIF
IF ( oGet:type == "C")
IF EMPTY(nKey2) .AND. (nKey=126 .OR. nKey=39 .OR. nKey=96 .OR. nKey=34 .OR. nKey=94 .OR. nKey=46)
nKey2 := nKey
oGet:left()
ELSE
nKey2 := SPACE(0)
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
oGet:changed := .T.
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 )
**********************************************************************
FUNCTION Mensagem1(nLinh,cTexto,cCor)
LOCAL nCol,nLargJan
nLargJan := LEN(cTexto)
IF nLargJan < 10
nLargJan := 10
ENDIF
nCol := (80 -nLargJan)/2
@ nLinh,nCol CLEAR TO nLinh,nCol + nLargJan
@ nLinh,nCol SAY cTexto COLOR cCor
RETURN NIL
**********************************************************************
// "Ž„ …†ƒ€‡‚ˆ‰Š¡‹Œ“¢™”•£š–¦§"
FUNCTION Acentos(oGet,nKey2,nKey)
LOCAL lIns := .F.
nKey2 := CHR(nKey2)
nKey3 := nKey
nKey := CHR(nKey )
IF nKey2 == "~"
IF nKey=="A" ; nKey:="Ž"
ELSEIF nKey=="O" ; nKey:="™"
ELSEIF nKey=="a" ; nKey:="„"
ELSEIF nKey=="o" ; nKey:="”"
ELSE ; lIns := .T. ; ENDIF
ELSEIF nKey2 == "'"
IF nKey=="A" ; nKey:=""
ELSEIF nKey=="E" ; nKey:=""
ELSEIF nKey=="a" ; nKey:=" "
ELSEIF nKey=="e" ; nKey:="‚"
ELSEIF nKey=="i" ; nKey:="¡"
ELSEIF nKey=="o" ; nKey:="¢"
ELSEIF nKey=="u" ; nKey:="£"
ELSEIF nKey=="C" ; nKey:="€"
ELSEIF nKey=="c" ; nKey:="‡"
ELSE ; lIns := .T. ; ENDIF
ELSEIF nKey2 == "`"
IF nKey=="a" ; nKey:="…"
ELSEIF nKey=="e" ; nKey:="Š"
ELSEIF nKey=="i" ; nKey:=""
ELSEIF nKey=="o" ; nKey:="•"
ELSE ; lIns := .T. ; ENDIF
ELSEIF nKey2 == "^"
IF nKey=="a" ; nKey:="ƒ"
ELSEIF nKey=="e" ; nKey:="ˆ"
ELSEIF nKey=="i" ; nKey:="Œ"
ELSEIF nKey=="o" ; nKey:="“"
ELSEIF nKey=="u" ; nKey:="–"
ELSE ; lIns := .T. ; ENDIF
ELSEIF nKey2 == "."
IF nKey=="a" ; nKey:="¦"
ELSEIF nKey=="o" ; nKey:="§"
ELSE ; lIns := .T. ; ENDIF
ENDIF
nKey2 := ASC(nKey2)
nKey := ASC(nKey )
IF nKey3 == nKey
oGet:right()
ENDIF
RETURN (lIns)
***************************************************************************
FUNCTION _INKEY(nTempo,lTrava)
LOCAL nKey := 0 , nTime := SECONDS()
lTrava:=IF(lTrava==NIL,.F.,.T.)
IF lTrava .AND. nTempo <> NIL .AND. nTempo <> 0
WHILE IF (nTempo > 0, (SECONDS() - nTime) < nTempo, .T.)
ENDDO
nKey := LASTKEY()
ELSE
nKey := INKEY(0) // Minkey(nTempo, @nMRow, @nMCol, .T.)
ENDIF
RETURN (nKey)
***************************************************************************
FUNCTION AJUDADECAMPOATIVA( oGet )
LOCAL nROW := ROW(), nCOL := COL(), nCURSOR := SETCURSOR(), cCOR := SETCOLOR()
LOCAL GetMensg := GetMsg[PosMsg], nCALCULO, nPOSOGET
LOCAL nPOS1 := AT("|",GetMensg), nPOS2, cVAR[3], nTAMAJU
IF nPOS1 # 0
cVAR[1] := SUBSTR(GetMensg,1,nPOS1-1)
GetMensg := SUBSTR(GetMensg,nPOS1+1,LEN(GetMensg))
ELSE
cVAR[1] := GetMensg
GetMensg := SPACE(0)
ENDIF
nPOS2 := AT("|",GetMensg)
IF nPOS2 # 0
cVAR[2] := SUBSTR(GetMensg,1,nPOS2-1)
GetMensg := SUBSTR(GetMensg,nPOS2+1,LEN(GetMensg))
cVAR[3] := GetMensg
ELSEIF nPOS2 == 0 .AND. !EMPTY(GetMensg)
cVAR[2] := GetMensg
ENDIF
IF cVAR[3] # NIL
nCALCULO := 4
ELSEIF cVAR[3] == NIL .AND. cVAR[2] # NIL
nCALCULO := 3
ELSE
nCALCULO := 2
ENDIF
nTAMAJU := LenLargura( cVAR )
nPOSOGET := oGet:col + 4
IF nPOSOGET+4+nTAMAJU > 79
DO WHIL .T.
nPOSOGET--
IF nPOSOGET+4+nTAMAJU <= 79
EXIT
ENDIF
ENDDO
ENDIF
nCOLAJU1 := nPOSOGET
nCOLAJU2 := nPOSOGET+nTAMAJU
IF oGet:row+1+nCALCULO > 24
nLINAJU1 := oGet:row-1-nCALCULO
nLINAJU2 := oGet:row-1
ELSE
nLINAJU1 := oGet:row+1
nLINAJU2 := oGet:row+1+nCALCULO
ENDIF
cGetMsg := SAVESCREEN(nLINAJU1,nCOLAJU1-2,nLINAJU2+1,nCOLAJU2+3)
@ nLINAJU1,nCOLAJU1 TO nLINAJU2,nCOLAJU2+3
@ nLINAJU1+1,nCOLAJU1+1 SAY " "+PAD( cVAR[1], nTAMAJU)+" "
IF cVAR[2] # NIL
@ nLINAJU1+2,nCOLAJU1+1 SAY " "+PAD( cVAR[2], nTAMAJU)+" "
ENDIF
IF cVAR[3] # NIL
@ nLINAJU1+3,nCOLAJU1+1 SAY " "+PAD( cVAR[3], nTAMAJU)+" "
ENDIF
SETPOS(nROW,nCOL)
SETCOLOR(cCOR)
SETCURSOR(nCURSOR)
RETURN NIL
***************************************************************************
STATIC FUNCTION LenLargura( aMenu2 )
LOCAL nLargura, i
nLargura := aMenu2[1]
FOR i = 1 TO LEN(aMenu2)
IF aMenu2[i] # NIL
IF LEN(nLargura) < LEN(aMenu2[i])
nLargura := aMenu2[i]
ENDIF
ENDIF
NEXT
RETURN LEN(nLargura)
***************************************************************************
FUNCTION _ROUND(nValor,nDecimals)
Hb_Default( @nDecimals,2)
RETURN (ROUND(val(str(nValor)),nDecimals))
***************************************************************************
FUNCTION GetPassword(oGet)
LOCAL nKey,nChar,cKey
LOCAL nTempo, nTemp, nCursor1, nCursor2, lRestaura := .F.
PRIVATE cGetMsg, nLINAJU1, nLINAJU2, nCOLAJU1, nCOLAJU2
IF (GetPreValidate(oGet))
// Activate the GET for reading
oGet:setFocus()
IF GetMsg[PosMsg] <> NIL
ENDIF
oGet:SetFocus()
oGet:cargo := ""
Do While(oGet:exitState == GE_NOEXIT)
IF (oGet:typeOut)
oGet:exitState := GE_ENTER
ENDIF
Do While (oGet:exitState == GE_NOEXIT)
nKey := INKEY(0)
IF nKey >= 32 .AND. nKey <= 255
oGet:cargo += Chr(nKey)
GetApplyKey(oGet,Asc("þ"))
ELSEIF nKey == K_BS
oGet:cargo := Substr(oGet:cargo,1,Len(oGet:cargo)-1)
GetApplyKey(oGet,nKey)
ELSEIF nKey == K_ENTER
GetApplyKey(oGet,nKey)
ELSEIF nKey == K_ESC
GetApplyKey(oGet,nKey)
ENDIF
ENDDO
IF (!GetPostValidate(oGet))
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO
oGet:KillFocus()
IF lRestaura
ENDIF
ENDIF
IF oGet:exitState != GE_ESCAPE
oGet:varPut(oGet:cargo)
ENDIF
RETURN
********************************************************************************
* Atualiza um get especifico
FUNCTION Atualiza_Gets( cGetName, uValue )
Local oGet, nPos
If ( nPos:= Ascan( GetList, { |e| Upper(e:name)==Upper(cGetName) } ) ) > 0
oGet := GetList[nPos]
If PCount()>1
oGet:Varput( uValue )
EndIf
oGet:Display()
EndIf
Return( nPos>0 )
********************************************************************************
* Atulizar na tela todos os gets da getlist
Function AtGets()
AEval( GetList, {|oGet| oGet:UpdateBuffers() })
AEval( GetList, {|oGet| oGet:Display() })
Return Nil
Compilação -w3 -es2 não é novidade, existia no Clipper.
No Harbour aumentaram a checagem ainda mais.
warning W0003 Variable 'JUNK' declared but not used in function '1006:RANGECHECK'
warning W0001 Ambiguous reference 'NKEY3'
warning W0001 Ambiguous reference 'NKEY3'
warning W0032 Variable 'NKEY' is assigned but not used in function '1165:_INKEY'
warning W0002 Ambiguous reference, assuming memvar 'GETMSG'
warning W0001 Ambiguous reference 'NCOLAJU1'
warning W0001 Ambiguous reference 'NCOLAJU2'
warning W0001 Ambiguous reference 'NLINAJU1'
warning W0001 Ambiguous reference 'NLINAJU2'
warning W0001 Ambiguous reference 'NLINAJU1'
warning W0001 Ambiguous reference 'NLINAJU2'
warning W0001 Ambiguous reference 'NLINAJU1'
warning W0001 Ambiguous reference 'NLINAJU1'
warning W0001 Ambiguous reference 'NLINAJU1'
warning W0001 Ambiguous reference 'NLINAJU1'
warning W0001 Ambiguous reference 'NLINAJU1'
warning W0002 Ambiguous reference, assuming memvar 'GETMSG'
warning W0005 RETURN statement with no return value in function
warning W0003 Variable 'NCHAR' declared but not used in function '1257:GETPASSWORD'
warning W0001 Ambiguous reference 'GETLIST'
warning W0002 Ambiguous reference, assuming memvar 'GETLIST'
warning W0001 Ambiguous reference 'GETLIST'
warning W0001 Ambiguous reference 'GETLIST'
warning W0002 Ambiguous reference, assuming memvar 'GETMSG'
warning W0005 RETURN statement with no return value in function
warning W0002 Ambiguous reference, assuming memvar 'GETLIST'
warning W0001 Ambiguous reference 'GETLIST'
warning W0003 Variable 'JUNK' declared but not used in function '1005:RANGECHECK'
warning W0032 Variable 'NKEY' is assigned but not used in function '1164:_INKEY'