PSP пишет:

цитата:

Имхо, стандартно - нет. Надо переписывать GetSys и весьма ощутимо

Не смешите мои тапки

написано очччень давно, я даже использовал одну из них (а может и другую) в одном из проектов, но в результате - это оказалось никому не нужно и меня попросили убрать это безобразие. Т.ч. не советую воплощать эту идею.

#include "inkey.ch"
#include "getexit.ch"
PROCEDURE CalcGet(oGet)
LOCAL cKey, nKey, Buffer, LenBuf, cStr

oGet:setFocus()
oGet:exitState := GE_NOEXIT
oGet:End()
Buffer := oGet:Buffer
LenBuf := LEN(Buffer)

IF (oGet:typeOut)
oGet:exitState := GE_ENTER
ENDIF

WHILE (oGet:exitState == GE_NOEXIT)
nKey := INKEY(0)
cKey := CHR(nKey)
DO CASE
CASE nKey == K_ENTER .OR. !SET( _SET_CONFIRM ) .AND. ;
( nKey == K_PGUP .OR. nKey == K_PGDN .OR.;
READEXIT() .AND. ( nKey == K_UP .OR. nKey == K_DOWN ) )
oGet:exitState := GE_ENTER
CASE nKey == K_ESC
oGet:undo()
oGet:exitState := GE_ESCAPE

CASE nKey == K_BS .OR. nKey == K_DEL
oGet:Buffer := ' ' + LEFT( oGet:Buffer, LenBuf-1 )
oGet:assign()
oGet:display()

CASE cKey $ '-0123456789.'
DO CASE
CASE ALLTRIM( oGet:Buffer ) == '0'
oGet:Buffer := STUFF( oGet:Buffer, oGet:pos, 1, cKey )
CASE cKey != '-'
oGet:Buffer := RIGHT( oGet:Buffer, LenBuf-1 ) + cKey
CASE cKey == '-'
cStr := ALLTRIM( oGet:Buffer )
IF LEFT( cStr, 1 ) == '-'
cStr := STUFF( cStr, 1, 1, "" )
ELSE
cStr := '-' + cStr
ENDIF
oGet:Buffer := PADL( cStr, LenBuf )
ENDCASE
// oGet:Buffer := TransForm( oGet:Buffer, oGet:Picture )
oGet:assign()
oGet:display()
IF LEN( ALLTRIM( oGet:Buffer ) ) == LenBuf
IF SET( _SET_BELL )
TONE( 440, 1 )
ENDIF
IF !SET( _SET_CONFIRM )
oGet:exitState := GE_ENTER
ENDIF
ENDIF
OTHERWISE
IF SET( _SET_BELL )
TONE( 110, 1 )
ENDIF
ENDCASE
END

oGet:killFocus()

RETURN

вариант 2

****
* CashGet.prg
*
* Compile with /m/n/w

#include "Inkey.ch"
#include "Getexit.ch"

#define K_UNDO K_CTRL_U

/***
* CashGetReader()
*/
PROCEDURE CashGetReader( oGet )

// read the GET if the WHEN condition is satisfied
IF (GetPreValidate(oGet))

// activate the GET for reading and position
// cursor on the right side
oGet:setFocus()
oGet:pos := LEN(oGet:buffer)
oGet:display()

// if there is no picture, create one so that we
// can safely use TRANSFORM() to create the buffer
IF (oGet:picture == NIL)
oGet:picture := MakeCashPic(oGet:buffer)
ENDIF

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)
CashGetApplyKey(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

/***
* CashGetApplyKey()
*/
STATIC PROCEDURE CashGetApplyKey( oGet, nKey )
LOCAL cKey
LOCAL bKeyBlock

LOCAL nDigit
LOCAL nVal
LOCAL cBuffer, cOldBuffer
LOCAL nDecimals, nDecPos, nPlace

// Determine how many decimal places we are dealing with
// and calculate the divisor that implies
//
nDecPos := AT(".", oGet:picture)
IF (nDecPos == 0)
nDecimals := 0
ELSE
nDecimals := LEN(oGet:picture) - nDecPos
ENDIF
nPlace := 10^nDecimals

// 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:pos := LEN(oGet:buffer)
oGet:display()
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)
// Get:undo() will set Get:clear to .T.
oGet:undo()
oGet:pos := LEN(oGet:buffer)
oGet:display()

CASE (nKey == K_CTRL_Y)
oGet:clear := .F.
oGet:pos := 1
oGet:delEnd()
oGet:pos := LEN(oGet:buffer)
oGet:display()

CASE (nKey == K_BS)
oGet:clear := .F.
oGet:changed := .T.

// Divide by 10 to move decimal point by one
nVal := oGet:unTransform() / 10

// And chop off the now insignificant digit
nVal := INT(nVal * nPlace) / nPlace

// Reformat for the buffer and redisplay
oGet:buffer := TRANSFORM(nVal, oGet:picture)
oGet:display()

CASE (nKey == K_DEL)
// Same as BS key
oGet:clear := .F.
oGet:changed := .T.

// Retrieve the value and divide by 10
// to move decimal point by one
nVal := oGet:unTransform() / 10

// And chop off the now insignificant digit
nVal := INT(nVal * nPlace) / nPlace

// Reformat for the buffer and redisplay
oGet:buffer := TRANSFORM(nVal, oGet:picture)
oGet:display()

OTHERWISE

cKey := CHR(nKey)

IF (cKey >= '0' .AND. cKey <= '9')
IF (oGet:clear)
// Clear the get and reposition the cursor
oGet:clear := .F.
oGet:pos := 1
oGet:delEnd()
oGet:pos := LEN(oGet:buffer)
ENDIF

nDigit := VAL(cKey)
nVal := (oGet:unTransform() * 10) + (nDigit / nPlace)
cBuffer := TRANSFORM(nVal, oGet:picture)

cOldBuffer := oGet:buffer
oGet:buffer := cBuffer

// Check to see if we overflowed. If we did, the buffer
// will be filled with asterisks and Get:unTransform will
// return 0--obviously wrong if nVal isn't zero.
//
// Check for nVal against 0 uses ROUND() because it isn't
// safe to do absolute compares of floating point numbers.
//
IF ((ROUND(nVal, nDecimals) == 0) .OR. ;
(oGet:unTransform() != 0))
oGet:display()
oGet:changed := .T.
ELSE
oGet:buffer := cOldBuffer
ENDIF
ELSEIF (cKey == '-')
// Note: This does not support setting the number negative
// before the number is entered.

oGet:clear := .F.
nVal := -oGet:unTransform()

// Convert and redisplay value if it will fit,
// otherwise discard it
cBuffer := TRANSFORM(nVal, oGet:picture)

cOldBuffer := oGet:buffer
oGet:buffer := cBuffer

// Check for overflow (see above)
IF (nVal == 0) .OR. (oGet:unTransform() != 0)
oGet:display()
oGet:changed := .T.
ELSE
oGet:buffer := cOldBuffer
ENDIF
ENDIF

ENDCASE

RETURN

/***
* MakeCashPic()
* Construct picture from number string
* Example:
* '1234.566' -> '9999.999'
*
*/
STATIC FUNCTION MakeCashPic( cNum )
LOCAL nDecPos
LOCAL cPicture

nDecPos := AT('.', cNum)
IF nDecPos > 0
cPicture := REPLICATE("9", nDecPos - 1) + '.'
cPicture += REPLICATE("9", LEN(cNum) - nDecPos)
ELSE
cPicture := REPLICATE("9", LEN(cNum))
ENDIF

RETURN (cPicture)

// display coordinates for SCOREBOARD
#define SCORE_ROW 0
#define SCORE_COL 60

/***
* ShowScoreboard()
*/
STATIC PROCEDURE ShowScoreboard()
LOCAL nRow, nCol

IF (SET(_SET_SCOREBOARD))
nRow := ROW()
nCol := COL()

SETPOS(SCORE_ROW, SCORE_COL)
DISPOUT( IF(SET(_SET_INSERT), "Ins", " ") )
SETPOS(nRow, nCol)
ENDIF
RETURN