Enviado: 20 Jun 2007 15:22
A biblioteca PTools tem algo assim. Funciona muito bem. Mas não tenho essa função. Tive que fazer a minha.alaminojunior escreveu:Este getcalc que mencionei, vem junto com o livro do Rick Spence.
A biblioteca PTools tem algo assim. Funciona muito bem. Mas não tenho essa função. Tive que fazer a minha.alaminojunior escreveu:Este getcalc que mencionei, vem junto com o livro do Rick Spence.
Olá Marcelo,MARCELOG escreveu:Jânio disse:
"Olá Daniel,
Esse getsys.prg funciona também com xharbour??? Se não, como fazer essa adaptação para que funcione???
Preciso muito disso...
Jânio"
Basta usar o Style ES_RIGHT
MarceloG
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
RETURNCó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>]Daniel,Daniel escreveu:Ola Jâniojanio escreveu:
Olá Daniel,
Esse getsys.prg funciona também com xharbour??? Se não, como fazer essa adaptação para que funcione???
Preciso muito disso...
Jânio
Ela funciona em xHarbour sem ter que mexer em nada.
Tamanho menor??? Não entendi. Variávies NUMERICAS se inicia com ZERO sem especificar tamanho, tipo nVARIAVEL := 0.Daniel escreveu:Jânio
vc pode esta declarando a variavel com tamanho menor.
Colega Daniel,Daniel escreveu:Jânio
usei este exemplo para testar
Cls
x:= Space(6)
x1:= Space(8)
x2:= 0
@ 12, 12 say "Teste" Get x2 Picture "9999999"
Read
@ 18, 12 say x2 Picture "@R 99999-99"
inkey(0)
aqui deu certo
x2:= 0
@ 12, 12 say "Teste" Get x2 Picture "@e 99,999.99"
Read
@ 18, 12 say x2 Picture "@R 9999-99"
inkey(0)
Comigo saiu tudo normal: 12345-6Digite: 123456 e pressione <ENTER>. Vc vai ver que ficou assim: 1234-6, ou seja, 'comeu' o 5.