Alamino,
Fiz umas adaptações para o getcalc onde o usuário não precise digitar a virgula ou ponto decimal, por exemplo o valor 35,48 o getcalc que eu modifiquei já posiciona o 48 na casa decimal.
Estou disponibilizando para criticas e melhorias.
/***
* GetCalc.prg
*
* Calculator style input
*/
#include "Getexit.ch"
#include "Inkey.ch"
#include "Getcalc.ch"
PROCEDURE GetCalc( oGet )
// read the GET if the WHEN condition is satisfied
IF ( GetPreValidate(oGet) )
// activate the GET for reading
oGet:SetFocus()
// RS added this
// Start at last position
oGet:end()
// Just to here
DO WHILE ( oGet:exitState == GE_NOEXIT )
// check for initial typeout (no editable positions)
IF ( oGet:typeOut )
oGet:exitState := GE_ENTER
ENDIF
// apply keystrokes until exit
DO WHILE ( oGet:exitState == GE_NOEXIT )
GetCalcApplyKey(oGet, InKey(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
/***
* GetCalcApplyKey()
* Apply a single Inkey() keystroke to a GET.
*
* NOTE: GET must have focus.
* Standard stuff. RS changed only BS and otherwise
*/
#define K_UNDO K_CTRL_U
proc GetCalcApplyKey(oGet, nKey)
local cKey
local bKeyBlock
local cTemp
local nTemp
// 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
// both ^W and ^End terminate the READ (the default)
CASE nKey == K_CTRL_W
oGet:exitState := GE_WRITE
CASE nKey == K_UNDO
oGet:Undo()
CASE ( nKey = 32 ) // Barra de espaço para limpar o campo
IF oGet:type == "C"
cTemp := oGet:unTransform()
cTemp := ""
oGet:buffer := Transform(cTemp, oGet:picture)
ELSE
nTemp := oGet:unTransform()
nTemp := 0
oGet:buffer := Transform(nTemp, oGet:picture)
ENDIF
oGet:display()
oGet:SetFocus()
CASE nKey == K_BS .OR. nKey == K_DEL
oGet:delete()
IF oGet:type == "C"
cTemp := oGet:unTransform()
cTemp := " " + Substr(cTemp, 1, Len(cTemp) - 1)
oGet:buffer := Transform(cTemp, oGet:picture)
ELSE
nTemp := oGet:unTransform()
nLen:=LEN(LTRIM(STR(nTemp,30,2)))
cTemp := STR(nTemp,nLen,2)
cTemp := Substr(cTemp, 1, Len(cTemp)-1)
nTemp := VAL(cTemp) / 10
IF At(".", oGet:buffer) != 0
// There is a decimal point
//nTemp := nTemp / 10
ELSE
// No decimal point, division already taken place
// by deleting last character
ENDIF
oGet:buffer := Transform(nTemp, oGet:picture)
ENDIF
oGet:display()
OTHERWISE
IF (nKey >= Asc('0') .AND. nKey <= Asc('9')) .OR. ;
(nKey == Asc('.') .AND. ;
oGet:type == "C" .AND. At(".", oGet:buffer) == 0)
cKey := Chr(nKey)
IF oGet:type == "C"
cTemp := oGet:unTransform()
cTemp := SubStr(cTemp, 2) + " "
oGet:buffer := Transform(cTemp, oGet:picture)
ELSE
nTemp := oGet:unTransform()
nTemp := nTemp * 10
oGet:buffer := Transform(nTemp, oGet:picture)
ENDIF
// NOTE - important to use OverStrike here to set changed
// Alternative is to stuff key yourself. However, that does
// not set changed, therefore var is not updated.
oGet:overStrike(cKey)
oGet:end()
oGet:display()
ENDIF
ENDCASE
RETURN
alaminojunior escreveu:Desculpem a pequena demora, mas ta aí a danada ( a rotina e o header ), foi o Rick Spence quem escreveu.
Código: Selecionar todos
/***
* GetCalc.prg
*
* Calculator style input
*/
#include "Getexit.ch"
#include "Inkey.ch"
#include "Getcalc.ch"
FUNCTION GetCalcTest
LOCAL nVar1 := 0, ;
nVar2 := 0, ;
cVar2 := Space(12), ;
nVar3 := 0
LOCAL GetList := {}
CLEAR SCREEN
@ 10, 10 SAY "Enter nVar1" GET nVar1 CALC
@ 11, 10 SAY "Enter nVar2" GET nVar2 CALC
@ 12, 10 SAY "Enter cVar2" GET cVar2 CALC
@ 13, 10 SAY "Enter nVar3" GET nVar3
READ
RETURN NIL
proc GetCalc( oGet )
// read the GET if the WHEN condition is satisfied
IF ( GetPreValidate(oGet) )
// activate the GET for reading
oGet:SetFocus()
// RS added this
// Start at last position
oGet:end()
// Just to here
DO WHILE ( oGet:exitState == GE_NOEXIT )
// check for initial typeout (no editable positions)
IF ( oGet:typeOut )
oGet:exitState := GE_ENTER
ENDIF
// apply keystrokes until exit
DO WHILE ( oGet:exitState == GE_NOEXIT )
GetCalcApplyKey(oGet, InKey(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
/***
* GetCalcApplyKey()
* Apply a single Inkey() keystroke to a GET.
*
* NOTE: GET must have focus.
* Standard stuff. RS changed only BS and otherwise
*/
#define K_UNDO K_CTRL_U
proc GetCalcApplyKey(oGet, nKey)
local cKey
local bKeyBlock
local cTemp
local nTemp
// 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
// both ^W and ^End terminate the READ (the default)
CASE nKey == K_CTRL_W
oGet:exitState := GE_WRITE
CASE nKey == K_UNDO
oGet:Undo()
CASE nKey == K_BS .OR. nKey == K_DEL
oGet:delete()
IF oGet:type == "C"
cTemp := oGet:unTransform()
cTemp := " " + Substr(cTemp, 1, Len(cTemp) - 1)
oGet:buffer := Transform(cTemp, oGet:picture)
ELSE
nTemp := oGet:unTransform()
IF At(".", oGet:buffer) != 0
// There is a decimal point
nTemp := nTemp / 10
ELSE
// No decimal point, division already taken place
// by deleting last character
ENDIF
oGet:buffer := Transform(nTemp, oGet:picture)
ENDIF
oGet:display()
OTHERWISE
IF (nKey >= Asc('0') .AND. nKey <= Asc('9')) .OR. ;
(nKey == Asc('.') .AND. ;
oGet:type == "C" .AND. At(".", oGet:buffer) == 0)
cKey := Chr(nKey)
IF oGet:type == "C"
cTemp := oGet:unTransform()
cTemp := SubStr(cTemp, 2) + " "
oGet:buffer := Transform(cTemp, oGet:picture)
ELSE
nTemp := oGet:unTransform()
nTemp := nTemp * 10
oGet:buffer := Transform(nTemp, oGet:picture)
ENDIF
// NOTE - important to use OverStrike here to set changed
// Alternative is to stuff key yourself. However, that does
// not set changed, therefore var is not updated.
oGet:overStrike(cKey)
oGet:end()
oGet:display()
ENDIF
ENDCASE
RETURN
Código: Selecionar todos
/***
* Getcalc.ch
*
* Definition of GET CALCULATOR command.
*/
#command @ <row>, <col> GET <var> ;
[<clauses,...>] ;
CALCULATOR ;
[<moreClauses,...>] ;
;
=> @ <row>, <col> GET <var> ;
[<clauses>] ;
SEND reader := {|oGet| ;
GetCalc(oGet) } ;
[<moreClauses>]