xharbour cvs + fivewin 8.01 = GPF ?

[zazibr]

atualizei o cvs 12/03 as 19:00 horário local ... e compilei a minha aplicação... e me deparei com o seguinte problema as minhas telas em fivewin 8.01 ... estao apresentando erro GPF

estou usando o cvs por recomendação do próprio linhares por tem um bug na classe get do xharbour tget.prg ja reportei o problema para 2 programadores brasileiros que atualizam e fazem implementação do xharbour só que ainda não obtive resposta

o que devo fazer ?

compilei com o xharbour 1.1.0 (que também é uma compilação do cvs) recebido junto com o fivewin 8.01 e funciona so que tem o bug da classe get não foi corrigida

será que o meu Fivewin 8.1 ficou incompatível com o cvs do xharbour ?

tenho que atualizar o meu fivewin 8.1 para 8.3 ?

[Antonio Linares]

Daniel,

Te aparece una ventana con el "callstack" cuando se produce el GPF ?

[metaldrummer]

Daniel,

Te aparece una ventana con el "callstack" cuando se produce el GPF ?

Hace años atrás Jorge Masón de Chile publicó un pequeño software que permite recompilar la librería de fivewin utilizando la última versión de xharbour que tengas.

Indícame como te la envío.

Cuando actualizo xharbour desde cvs, inmediatamente recompilo la fwh.lib y listo y cero problemas.
Saludos
David

[zazibr]

nao esta gerando log so da o gpf e fecha a aplicação


poderia me enviar pra compilar a lib ( daniel@lopes.ms )

como compilar as lib´s do fivewin ?

[Antonio Linares]

Daniel,

Nosotros acabamos de publicar la versión 8.03 pero aún no estamos usando el xHarbour más reciente, pues nos han comentado varios usuarios que tienen algunos problemas.

Tan pronto como lo probemos, publicaremos un build de xHarbour, si todas nuestras pruebas funcionan correctamente.

En que línea de tu programa te aparece el GPF ? Prueba a poner algunas trazas usando MsgInfo() e intenta localizar el código que lo produce, gracias

[zazibr]

antonio


so da gpf com o xharbour cvs ... se puderer compilar um xharbour com as alterações no tgtet.prg poderia me enviar um link pra baixar ?

se tiver os fontes do contrib agradeço

estou postando o tget.prg onde esta comendado
* daniel

vc encontra as alterações que voce me passou por e-mail

INICIO
=====
/*
* $Id: tget.prg,v 1.137.2.1 2007/11/06 23:59:43 modalsist Exp $
*/

/*
* Harbour Project source code:
* Get Class
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/

#include "hbclass.ch"
#include "color.ch"
#include "common.ch"
#include "setcurs.ch"
#include "getexit.ch"
#include "inkey.ch"
#include "button.ch"
#include "hblang.ch"

/* TODO: :posInBuffer( <nRow>, <nCol> ) --> nPos
Determines a position within the edit buffer based on screen
coordinates.
Xbase++ compatible method */

#define GET_CLR_UNSELECTED 0
#define GET_CLR_ENHANCED 1
#define GET_CLR_CAPTION 2
#define GET_CLR_ACCEL 3

//----------------------------------------------------------------------------//


CLASS Get

// Exported

DATA BadDate
DATA Block
DATA Buffer
DATA Cargo
DATA Changed
DATA Clear
DATA Col
DATA DecPos
DATA ExitState
DATA HasFocus
DATA Minus
DATA Name
DATA Original
DATA Pos
DATA PostBlock
DATA PreBlock
DATA Reader
DATA Rejected
DATA Row
DATA SubScript
DATA Type
DATA TypeOut

#ifdef HB_COMPAT_C53
DATA Control
DATA Message
DATA Caption
DATA nLastExitState
DATA CapRow
DATA CapCol
#endif

METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec )

METHOD Assign()
#ifdef HB_COMPAT_XPP
MESSAGE _Assign METHOD Assign()
#endif

ACCESS ColorSpec INLINE ::cColorSpec
ASSIGN ColorSpec( cColorSpec ) INLINE ::SetColorSpec( cColorSpec )
//ACCESS Picture INLINE ::cPicture
ACCESS Picture INLINE ::cOrigPicture
ASSIGN Picture( cPicture ) INLINE ::SetPicture( cPicture )

METHOD Display( lForced )
METHOD ColorDisp( cColorSpec ) INLINE ::ColorSpec := cColorSpec, ::Display(), Self
METHOD KillFocus()
METHOD Reset()
METHOD SetFocus()
METHOD Undo()
METHOD UnTransform( cBuffer )
METHOD UpdateBuffer() INLINE if( ::hasfocus, ( ::buffer := ::PutMask( ::VarGet() ), ::Display() ), ), Self
METHOD VarGet()
METHOD VarPut(xValue, lReFormat)

METHOD End()
#ifdef HB_COMPAT_XPP
MESSAGE _End METHOD End()
#endif

METHOD Home()
MESSAGE Left( lDisplay ) METHOD _Left( lDisplay )
MESSAGE Right( lDisplay ) METHOD _Right( lDisplay )
METHOD ToDecPos()
METHOD WordLeft()
METHOD WordRight()

METHOD BackSpace( lDisplay )
MESSAGE Delete( lDisplay ) METHOD _Delete( lDisplay )
METHOD DelEnd()
METHOD DelLeft()
METHOD DelRight()
METHOD DelWordLeft()
METHOD DelWordRight()

METHOD Insert( cChar )
METHOD OverStrike( cChar )

#ifdef HB_COMPAT_C53
METHOD HitTest(mrow, mcol)
#endif


PROTECTED: /* P R O T E C T E D */

DATA cColorSpec // Used only for METHOD ColorSpec
DATA cPicture // Used only for METHOD Picture
DATA cOrigPicture // Original picture supplied by user.

METHOD SetColorSpec( cColorSpec )
METHOD SetPicture( cPicture )


HIDDEN: /* H I D D E N */

DATA cPicMask, cPicFunc, nMaxLen, lEdit, lDecRev, lPicComplex
DATA nDispLen, nDispPos, nOldPos, lCleanZero, cDelimit, nMaxEdit
DATA lMinusPrinted, xVarGet
DATA lDispLen INIT .F.
DATA lUndo INIT .F.
DATA lLeftJust INIT .F. // to "@B" mask

DATA lDispLenChanged INIT .F. // to "@X", "@C", "(" and ")" pictures.
DATA nDispLenReduce INIT 0 // idem.

METHOD ParsePict( cPicture )
METHOD DeleteAll()
METHOD IsEditable( nPos )
METHOD Input( cChar )
METHOD PutMask( cBuffer, lEdit )
METHOD FirstEditable( )
METHOD LastEditable( )

METHOD HasScroll() INLINE ::nDispLen != ::nMaxLen

ENDCLASS

//---------------------------------------------------------------------------//

METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get

DEFAULT nRow TO Row()
DEFAULT nCol TO Col()
DEFAULT cVarName TO ""
DEFAULT bVarBlock TO IIF( ValType( cVarName ) == 'C', MemvarBlock( cVarName ), NIL )
DEFAULT cPicture TO ""
DEFAULT cColorSpec TO BuildGetColor(cColorSpec) // SetColor()

::HasFocus := .F.
::lEdit := .F.
::BadDate := .F.
::Changed := .F.
::Clear := .F.
::lCleanZero := .F.
::lMinusPrinted := .F.
::Minus := .F.
::Rejected := .F.
::TypeOut := .F.

/*
::DecPos := NIL
::Pos := NIL
::PostBlock := NIL
::PreBlock := NIL
::Reader := NIL
::SubScript := NIL
*/

//::ExitState := 0 // NIL in Clipper
::nLastExitState := 0
::nOldPos := 0

::nDispPos := 1
::Block := bVarBlock
::Col := nCol
::Row := nRow
::ColorSpec := cColorSpec
::Picture := cPicture
::cOrigPicture := cPicture

::Name := cVarName
::cDelimit := IIF( SET( _SET_DELIMITERS ), SET( _SET_DELIMCHARS ), NIL )

//::Original := ::VarGet()
//::Type := ValType( ::VarGet() ) // Must know the type at creation
::VarGet() // Must know the type at creation

#ifdef HB_COMPAT_C53
//::CapCol := ;
::CapRow := 0
::Caption := ""
#endif

RETURN Self

//---------------------------------------------------------------------------//

METHOD ParsePict( cPicture ) CLASS Get

Local cChar, cMask
Local nAt
Local nFor
Local cNum := ""
Local nPos := AT("@", cPicture )
Local nLen,nDec
Local nMaxLen

/* E.F. 2006/MAY/31 - Search by last occurrence of "@" into picture
* to verify if picture has a function and avoid any char before it.
* E.F. 2006/AUG/14 - Replaced RAT by AT to preserve others pictures, if any.
*/
//if Left( cPicture, 1 ) == "@"
//nPos := RAT("@", cPicture )
//nPos := AT("@", cPicture )
if nPos > 0

if nPos > 1
// extracts any char before "@"
cPicture := SubStr( cPicture, nPos )
::cPicture := cPicture
endif

nAt := At( " ", cPicture )

if nAt == 0
::cPicFunc := Upper( cPicture )
::cPicMask := ""
else
/* The first space after the function symbom is obligatory, but it's
ignored in the mask. */
::cPicFunc := Upper( SubStr( cPicture, 1, nAt - 1 ) )

/* E.F. 2006/JUN/06 Clipper doesn't extract left spaces of the mask
* of any var type. For example: "@E 999.99", "@R 999.999"
* ::cPicMask := LTrim( SubStr( cPicture, nAt + 1 ) )
*/
::cPicMask := SubStr( cPicture, nAt + 1 )
endif

// AnalyzePicture( @::cPicFunc )

if "D" IN ::cPicFunc

::cPicMask := Set( _SET_DATEFORMAT )
::cPicMask := StrTran( ::cPicmask, "y", "9" )
::cPicMask := StrTran( ::cPicmask, "Y", "9" )
::cPicMask := StrTran( ::cPicmask, "m", "9" )
::cPicMask := StrTran( ::cPicmask, "M", "9" )
::cPicMask := StrTran( ::cPicmask, "d", "9" )
::cPicMask := StrTran( ::cPicmask, "D", "9" )

endif

if ( nAt := At( "S", ::cPicFunc ) ) > 0
for nFor := nAt + 1 to Len( ::cPicFunc )
if ! IsDigit( SubStr( ::cPicFunc, nFor, 1 ) )
exit
else
cNum += SubStr( ::cPicFunc, nFor, 1 )
endif
next
if Val(cNum) > 0
::nDispLen := Val(cNum)
::lDispLen := .t.
else
::lDispLen := .f.
endif
::cPicFunc := SubStr( ::cPicFunc, 1, nAt - 1 ) + SubStr( ::cPicFunc, nFor )
else
::lDispLen := .f.
endif

// 2007/JAN/09 - E.F. - Protect ::lCleanzero value before extract "Z" from picture.
if !::lCleanZero
::lCleanZero := ( "Z" IN ::cPicFunc ) // Display zero as blanks.
endif

// 2006/DEC/19 - E.F. - Extracted "Z" from ::cPicture
if ::lCleanZero
::cPicFunc := StrTran(::cPicFunc, "Z", "")
::cPicture := StrTran(::cPicture, "Z", "")
endif

// 2007/MAR/31 - E.F. - Set left-justified behaviour.
if !::lLeftJust
::lLeftJust := ( "B" IN ::cPicFunc )
endif

if ::lLeftJust
::cPicFunc := StrTran(::cPicFunc, "B", "")
::cPicture := StrTran(::cPicture, "B", "")
endif

if ::cPicFunc == "@"
::cPicFunc := ""
endif

// 2006/DEC/19 - E.F. - Extracted "@" from ::cPicture
if ::cPicture == "@"
::cPicture := ""
endif

else
::cPicFunc := ""
::cPicMask := cPicture
::lCleanZero := .f.
::lDispLen := .f.
endif

if ::type == "D"
// ::cPicMask := LTrim( ::cPicMask )
// avoid user date picture to force default date picture in
// accordance with set date format. See below.
::cPicMask := ""
endif

// Comprobar si tiene la , y el . cambiado (Solo en Xbase++)

::lDecRev := "," IN Transform( 1.1, "9.9" )

// Generate default picture mask if not specified

if Empty( ::cPicMask ) .and. !Empty( ::type )

Switch ::type
case "D"

::cPicMask := Set( _SET_DATEFORMAT )
::cPicMask := StrTran( ::cPicmask, "y", "9" )
::cPicMask := StrTran( ::cPicmask, "Y", "9" )
::cPicMask := StrTran( ::cPicmask, "m", "9" )
::cPicMask := StrTran( ::cPicmask, "M", "9" )
::cPicMask := StrTran( ::cPicmask, "d", "9" )
::cPicMask := StrTran( ::cPicmask, "D", "9" )
exit

case "N"

/* E.F. 2007/FEB/03 - Assign default mask format in accordance with
buffer lenght and dec pos. */

if ::nMaxLen != NIL .and. ::DecPos != NIL

/* 2007/MAY/20 - E.F. */
nMaxLen := ::nMaxLen - iif(::lDispLenChanged,::nDispLenReduce,0)

if ::DecPos < nMaxLen .and. ::DecPos > 0
cNum := Str( ::xVarGet, nMaxLen, nMaxLen - ::DecPos )
else
cNum := Str( ::xVarGet, nMaxLen, 0 )
endif

else
cNum := Str( ::xVarGet )
endif

/* E.F. 2006/APRIL/19 - If ::xVarGet is negative and smaller than
* -99999999.99, the Str(::xVarGet) will return a string width
* of 23, instead it's length, increasing the ::cPicMask length.
* cNum := Str( ::xVarGet ) is not better way to do it.
*/
IF ::xVarGet < 0
nDec := Len( cNum) - Rat(".",cNum)
IF nDec >= Len( cNum )
nDec := 0
ENDIF
// 2006/DEC/24 - E.F. Fixed nLen value for negative numbers.
//nLen := 10 + iif(nDec>0,1,0) + nDec
nLen := iif( ::xVarGet < -99999999.99, 10+iif(nDec>0,1,0) + nDec, Len( cNum ) )
cNum := Str( ::xVarGet, nLen, nDec )
ENDIF

if ( nAt := At( iif( ::lDecRev, ",", "." ), cNum ) ) > 0
::cPicMask := Replicate( '9', nAt - 1 ) + iif( ::lDecRev, ",", "." )
::cPicMask += Replicate( '9', Len( cNum ) - Len( ::cPicMask ) )
else
::cPicMask := Replicate( '9', Len( cNum ) )
endif

exit

case "C"
If ::cPicFunc == "@9"
::cPicMask := Replicate( "9", Len( ::VarGet() ) )
::cPicFunc := ""
Endif
exit

end
endif

// Comprobar si tiene caracteres embebidos no modificables en la plantilla

::lPicComplex := .f.

IF ! Empty( ::cPicMask )
For each cChar in ::cPicMask
IF cChar == 'a'
::cPicMask[ HB_EnumIndex() ] := 'A'
ELSEIF cChar == 'n'
::cPicMask[ HB_EnumIndex() ] := 'N'
ELSEIF !(cChar IN "!ANX9#")
::lPicComplex := .t.
EXIT
ENDIF
NEXT
ENDIF

// if ::HasFocus // TODO: Delete this line if the "if ::hasfocus" in ::Picture
// is correct.
if ::type == "N"
::decpos := At( iif( ::lDecRev .or. "E" IN ::cPicFunc, ",", "." ), ;
Transform( 1, if( Empty( ::cPicFunc ), "", ::cPicFunc + " " ) + ::cPicMask ) )
if ::decpos == 0
::decpos := iif( ::buffer == NIL, NIL, Len( ::buffer ) + 1 )
endif
else
::decpos := NIL

// 2006/DEC/11 - EF - changed ::cPicMask to uppercase if ::type is character.
// 2007/NOV/06 - EF - toggle to uppercase only template chars of the mask.
IF ::type == 'L'
::cPicMask := Upper( ::cPicMask )
ELSEIF ::type == 'C'
cMask := ::cPicMask
::cPicMask := ""
FOR EACH cChar IN cMask
if cChar $ "alnxy"
::cPicMask += Upper( cChar )
else
::cPicMask += cChar
endif
NEXT
ENDIF
endif
// endif

return ::cPicFunc + ' ' + ::cPicMask

//---------------------------------------------------------------------------//

METHOD Assign() CLASS Get

if ::hasfocus
::VarPut( ::unTransform(), .f. )
endif

return Self

//---------------------------------------------------------------------------//

METHOD Display( lForced ) CLASS Get

LOCAL nOldCursor := SetCursor( SC_NONE )
LOCAL xBuffer
LOCAL xVar
LOCAL cCaption
LOCAL cClrCap := hb_ColorIndex( ::ColorSpec, GET_CLR_CAPTION )
LOCAL cClrAcc := hb_ColorIndex( ::ColorSpec, GET_CLR_ACCEL )
LOCAL lIsIntense := SET( _SET_INTENSITY)
LOCAL nCol,cDisplay
LOCAL nDispReduce := 0

DEFAULT lForced TO .t.

IF Empty( cClrCap )
cClrCap := hb_ColorIndex( SetColor(), CLR_STANDARD )
ENDIF

IF Empty( cClrAcc )
cClrAcc := hb_ColorIndex( SetColor(), CLR_BACKGROUND )
ENDIF

IF ::Buffer == NIL
xVar := ::VarGet() // In VarGet() is setting ::xVarGet needed to
// ::Picture.
::Picture := ::cOrigPicture
xBuffer := ::PutMask( xVar, .f. )
ELSE
xBuffer := ::Buffer
ENDIF

HBConsoleLock()


/* E.F. 2006/MAY/23 - Display minus sign in the front of xBuffer value.
* IF ! ::lMinusPrinted .AND. ! Empty( ::DecPos ) .AND. ::minus .AND. SubStr( xBuffer, ::DecPos - 1, 1 ) == "0"
* xBuffer := SubStr( xBuffer, 1, ::DecPos - 2 ) + "-." + SubStr( xBuffer, ::DecPos + 1 )
*/
IF ::Type=="N" .AND. ! ::lMinusPrinted .AND. ::DecPos != NIL .AND. ::Minus
xBuffer := PadL( StrTran(xBuffer,'-',''), Len(xBuffer) )
IF ::DecPos > 0 .AND. ::DecPos < Len( xBuffer)
xBuffer := PadL( '-'+Ltrim(SubStr( xBuffer, 1, ::DecPos - 1 )) + "." + SubStr( xBuffer, ::DecPos + 1 ) , Len(xBuffer) )
ELSE
xBuffer := PadL( '-'+Ltrim( xBuffer), Len(xBuffer) )
ENDIF
ENDIF

IF ::HasScroll() .AND. ::Pos != NIL
IF ::nDispLen > 8
::nDispPos := Max( 1, Min( ::Pos - ::nDispLen + 4, ::nMaxLen - ::nDispLen + 1 ) )
ELSE
::nDispPos := Max( 1, Min( ::Pos - int( ::nDispLen / 2 ), ::nMaxLen - ::nDispLen + 1 ) )
ENDIF
ENDIF

IF xBuffer != NIL .and. ( lForced .or. ( ::nDispPos != ::nOldPos ) )

cDisplay := SubStr( xBuffer, ::nDispPos, ::nDispLen )

IF Len( cDisplay ) < ::nDispLen
/* 2007/MAY/18 - E.F. - Adjust display length
cDisplay := Padr( cDisplay, ::nDispLen ) */
cDisplay := Padr( cDisplay, Min(::nDispLen,::nMaxLen) )
ENDIF

// The get lost the focus. We need left-adjust the content buffer
// if "@B" was used.
//
IF ::Type=="N" .AND. ::lLeftJust .AND. !::HasFocus
cDisplay := Padr( Ltrim( cDisplay ), ::nDispLen )
ENDIF

/* 2007/MAY/19 - E.F. - Reduce display length at "@X","@C","@(" or "@)" picture and final value conditions */
IF ::Type=="N" .AND. !::lDispLenChanged .AND. !::HasFocus .and.;
::Changed .AND. !::Rejected .AND.;
::ExitState != NIL .AND. xBuffer != NIL .AND.;
::ExitState > GE_NOEXIT .AND. ::ExitState != GE_ESCAPE

/* 2007/SEP/24 - EF - Adjust buffer contents.
* if ( "X" IN ::cPicFunc .and. ::Untransform( xBuffer ) >= 0 ) .or.;
* ( "C" IN ::cPicFunc .and. ::Untransform( xBuffer ) < 0 )
*/
if ( "X" IN ::cPicFunc .and. ::Untransform( xBuffer ) >= 0 ) .or.;
( "C" IN ::cPicFunc .and. ::Untransform( xBuffer ) <= 0 )

nDispReduce := 3

endif

if ( "(" IN ::cPicFunc .OR. ")" IN ::cPicFunc .AND. ::Untransform( xBuffer ) >= 0 )

if ")" IN ::cPicFunc
cDisplay := StrTran( cDisplay, "("," ")
cDisplay := StrTran( cDisplay, ")"," ")
endif

nDispReduce := 1

endif

ENDIF

/* 2007/SEP/14 - E.F. - Display buffer content only if not object as
ListBox, CheckCob, PushButton or RadioGroup.
*/
#ifdef HB_COMPAT_C53
if Valtype( ::Control ) != "O"
#endif
DispOutAt( ::Row, ::Col + if( ::cDelimit == NIL, 0, 1 ),;
cDisplay,;
hb_ColorIndex( ::ColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ), .T. )

if nDispReduce > 0

DispOutAt( ::Row, ::Col + if( ::cDelimit == NIL, 0, 1 ) + ::nDispLen,;
space(nDispReduce), hb_ColorIndex( ::ColorSpec, 4 ), .T. )
endif

if ! ( ::cDelimit == NIL )
DispOutAt( ::Row, ::Col, Substr( ::cDelimit, 1, 1), hb_ColorIndex( ::ColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ), .T. )
DispOutAt( ::Row, ::Col + ::nDispLen + 1, Substr( ::cDelimit, 2, 1), hb_ColorIndex( ::ColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ), .T. )
endif

#ifdef HB_COMPAT_C53
Endif
#endif

ENDIF

#ifdef HB_COMPAT_C53
/* 2007/SEP/14 - EF - The Caption below is only for plain get caption,
no object get. This display it's own ones.
*/
if Valtype( ::Control ) != "O"
#endif

IF !Empty( ::Caption )
cCaption := StrTran( ::Caption, "&", "" )
DispOutAt( ::Row, ::Col - Len( cCaption ) - 1, cCaption, cClrCap, .T. )
IF "&" $ ::Caption
DispOutAt( ::Row, ::Col - Len( cCaption ) - 2 + At( "&", ::Caption ), cCaption[At( "&", ::Caption )], cClrAcc, .T. )
ENDIF
ENDIF

#ifdef HB_COMPAT_C53
Endif
#endif

::nOldPos := ::nDispPos

IF ::Pos != NIL

nCol := ::Col + ::Pos - ::nDispPos + if( ::cDelimit == NIL, 0, 1 )

/* E.F. 2006/APRIL/13 - We need adjust cursor column position if user
* has pressed a dot or comma key in the numeric var that haven't
* decimal part.
*/
IF ::Type=="N" .AND. ::hasfocus .AND. (::DecPos=NIL .OR. ::DecPos > ::nMaxLen ) .AND. ( LastKey()=Asc(',') .OR. LastKey()=Asc('.') )
nCol := ::Col + ::nMaxLen - 1
::Left(.F.)
ENDIF

SetPos( ::Row, nCol )

ENDIF

SetCursor( nOldCursor )

HBConsoleUnlock()

return Self

//---------------------------------------------------------------------------//

METHOD End() CLASS Get

local nLastCharPos, nPos, nFor

if ::HasFocus != nil .and. ::HasFocus

/* 2006/JUN/03 - E.F. if cursor is already in last get value entered
* position +1, then go to the end display position.
*/
if ::Pos > ::FirstEditable() .and. ::IsEditable(::Pos) .and. ::Pos < ::nMaxEdit .and. empty( ::buffer[::Pos] )
::Pos := ::nMaxEdit
::TypeOut := .f.
::Clear := .f.
::Display( .f. )
return Self
endif
/**/

nLastCharPos := Min( Len( RTrim( ::buffer ) ) + 1, ::nMaxEdit )

if ::Pos != nLastCharPos
nPos := nLastCharPos
else
nPos := ::nMaxEdit
endif

for nFor := nPos to ::FirstEditable() step -1

/* 2006/JUN/02 - E.F. Adjust cursor positon to valid end position */
if ::IsEditable( nFor ) .and. !empty( ::buffer[nFor] )
nFor++
while !::IsEditable(nFor) .and. nFor < ::nMaxEdit
nFor++
end
::Pos := Min(nFor,::nMaxEdit)
exit
endif
/**/

next

/* 2006/JUN/02 - E.F. if cursor reach first editable position, then go to
* the end display position
*/
if ::Pos == ::FirstEditable()
::Pos := ::nMaxEdit
endif
/**/

::TypeOut := .f.
::Clear := .f.
::Display( .f. )
endif

return Self

//---------------------------------------------------------------------------//

METHOD Home() CLASS Get

if ::HasFocus
::Pos := ::FirstEditable()
::TypeOut := .f.
::Clear := .f.
::Display( .f. )
endif

return Self

//---------------------------------------------------------------------------//

METHOD Reset() CLASS Get

if ::hasfocus
::buffer := ::PutMask( ::VarGet(), .f. )
::Pos := ::FirstEditable()
::TypeOut := .f.
endif

return Self

//---------------------------------------------------------------------------//

METHOD Undo() CLASS Get

if ::hasfocus
/* E.F. 2006/APRIL/14 - reset ::minus flag if ::xVarGet was
* negative number but ::original value not.
*/
IF ::Type=="N" .AND. ::Original != NIL .AND. ::Original >= 0
::minus := .f.
ENDIF
::VarPut( ::Original, .t. )
::Pos := ::FirstEditable()
::UpdateBuffer() // 7/01/2004 9:44a.m. was ::Display()
::lUndo := .t.
endif

return Self

//---------------------------------------------------------------------------//

METHOD SetFocus() CLASS Get

local xVarGet

if !::HasFocus

xVarGet := ::VarGet() // In VarGet() is setting ::xVarGet

::hasfocus := .t.
::rejected := .f.
::typeout := .f.

/* FSG - 16/06/2006 - reset ::lUndo to false to avoid clearing of get in case of reuse of it */
::lUndo := .f.

::Original := xVarGet
::Type := ValType( xVarGet )
::Picture := ::cOrigPicture
::Buffer := ::PutMask( xVarGet, .f. )
::Changed := .f.
::Clear := ( "K" IN ::cPicFunc .or. ::type == "N")
//::nMaxLen := IIF( ::buffer == NIL, 0, Len( ::buffer ) )
::lEdit := .f.
::Pos := ::FirstEditable()

if ::Pos = 0
::TypeOut = .t.
endif

if ::type == "N"
::decpos := At( iif( ::lDecRev .or. "E" IN ::cPicFunc, ",", "." ), ::buffer )
if ::decpos == 0
::decpos := iif( ::buffer == NIL, NIL, Len( ::buffer ) + 1 )
endif
/* No, tested with clipper, ::minus .F. on ::setFocus of a negative variable get
::minus := ( xVarGet < 0 )
*/
::lMinusPrinted := ( xVarGet < 0 )
::minus := .F.
else
::decpos := NIL
::lMinusPrinted := ::minus := .f.
endif


if ::type == "D"
::BadDate := IsBadDate( ::buffer, ::cPicFunc )
else
::BadDate := .f.
endif

if ::buffer != NIL
if ::nDispLen == NIL .or. !::lDispLen
::nDispLen := ::nMaxLen
endif

::Display( .T. )
else
::Display()
endif
else
::Display()
endif

return Self

//---------------------------------------------------------------------------//

METHOD KillFocus() CLASS Get

if ::lEdit
::Assign()
endif

::hasfocus := .f.
// ::buffer := ::PutMask( )
::buffer := NIL
::Original := NIL
::Pos := NIL

::Display()
::xVarGet := NIL

::typeout := .f. /* Clipper compatible */

return Self

//---------------------------------------------------------------------------//

METHOD VarPut( xValue, lReFormat ) CLASS Get

LOCAL nCounter, aGetVar, aIndex, nDim

DEFAULT lReFormat TO .t.

if ::Block != nil .and. xValue != nil

IF ::SubScript == NIL
Eval( ::Block, xValue )
ELSE
aIndex := ::SubScript
nDim := Len( aIndex )
aGetVar := Eval( ::Block )
FOR nCounter := 1 TO nDim - 1
aGetVar := aGetVar[ aIndex[ nCounter ] ]
NEXT
aGetVar[ aIndex[ nCounter ] ] := xValue
ENDIF

if lReFormat
if !::hasfocus
::Original := xValue
endif
::Type := ValType( xValue )
::xVarGet := xValue
::lEdit := .f.
::Picture := ::cOrigPicture
endif
endif

return xValue

//---------------------------------------------------------------------------//

METHOD VarGet() CLASS Get

LOCAL xVarGet, aIndex, nDim, aGetVar, nCounter
LOCAL cVarGet, nDecPos, nLen, nDec

IF ! HB_IsBlock( ::Block )
::xVarGet := NIL
::Type := 'U'
RETURN NIL
ENDIF

IF ::SubScript == NIL
xVarGet := Eval( ::Block )
ELSE
aIndex := ::SubScript
nDim := Len( aIndex )
aGetVar := Eval( ::Block )

FOR nCounter := 1 TO nDim - 1
aGetVar := aGetVar[ aIndex[ nCounter ] ]
NEXT

xVarGet := aGetVar[ aIndex[ nCounter ] ]
ENDIF

::Type := ValType( xVarGet )

/* E.F. 2006/APR/12 - We need adjust get value in any circuntancies.
E.F. 2006/MAY/05 - Added ::hasfocus to maintain ::original value,if
we exit with ESC before start edit get. */
IF ::hasfocus .AND. ::Type == "N" .AND. ::nMaxLen != NIL .AND.;
::DecPos != NIL .AND. ::DecPos > 0 .AND. ::DecPos < ::nMaxLen

nDecPos := ::DecPos

IF !Empty(::cPicMask)
nLen := HowMuchNumeric(::cPicMask) + 1 + iif(::minus,1,0)
nLen := Min(nLen,Len(::cPicMask))
nDec := Len( ::cPicMask) - Rat(".",::cPicMask)
IF nDec >= nLen
nDec := 0
ENDIF
ELSEIF !Empty( ::cPicture)
nLen := HowMuchNumeric(::cPicture) + 1 + iif(::minus,1,0)
nLen := Min(nLen,Len(::cPicture))
nDec := Len( ::cPicture) - Rat(".",::cPicture)
IF nDec >= nLen
nDec := 0
ENDIF
ELSE
cVarGet := Str( xVarGet )
nDec := Len( cVarGet) - Rat(".",cVarGet)
IF nDec >= Len( cVarGet )
nDec := 0
ENDIF
nLen := 10 + iif(nDec>0,1,0) + nDec
ENDIF

cVarGet := Str( xVarGet, nLen, nDec )

// Insert "0" before decimal dot, if empty.
IF Empty( SubStr( cVarGet, 1, nDecPos-1) )
cVarGet := Stuff( cVarGet, nDecPos-1, 1, "0")
ENDIF

// Fill with zeros after decimal dot, if empty.
* daniel
* IF Len(cVarGet) > nDecPos .AND. Empty( SubStr( cVarGet, nDecPos+1 ) )
IF Len(cVarGet) > nDecPos .AND. ! Empty( cVarGet ) .AND. Empty( SubStr( cVarGet, nDecPos+1 ) )
cVarGet := Stuff( cVarGet, nDecPos+1, ::nMaxLen - nDecPos, replicate("0",::nMaxLen - nDecPos) )
ENDIF


xVarGet := Val( cVarGet )

// E.F. 2006/MAY/23 - Avoid minus flag if get value is zero.
IF xVarGet == 0
::minus := .f.
ENDIF

ENDIF

::xVarGet := xVarGet

RETURN xVarGet

//---------------------------------------------------------------------------//

METHOD Untransform( cBuffer ) CLASS Get

local xValue, lUntransform := .T.
local cChar
local nFor, nPad := 0
local cMaskDel := ""

DEFAULT cBuffer TO ::buffer

/*
*if !::lEdit
* return ::VarGet()
* endif
*/
if cBuffer == NIL
return NIL
endif

Switch ::type
case "C"

if "R" IN ::cPicFunc
For each cChar in ::cPicMask
cMaskDel += if( (cChar IN "ANX9#!"), " ", "X" )
Next
cBuffer := StrDel( cBuffer, cMaskDel )

* cBuffer += Substr( ::xVarGet, Len( cBuffer ) + 1 )
* daniel
if ::xVarGet != nil // Nuevo!
cBuffer += Substr( ::xVarGet, Len( cBuffer ) + 1 )
endif // Nuevo!

else

* cBuffer += SubStr( ::xVarGet, ::nMaxLen + 1 )
* daniel
if ::xVarGet != nil // Nuevo!
cBuffer += SubStr( ::xVarGet, ::nMaxLen + 1 )
endif // Nuevo!

endif

xValue := cBuffer
exit

case "N"
if "X" IN ::cPicFunc
if Right( cBuffer, 2 ) == "DB"
::minus := .t.
endif
endif
if ! ::minus
for nFor := 1 to ::nMaxLen
if ::IsEditable( nFor ) .and. IsDigit( SubStr( cBuffer, nFor, 1 ) )
exit
endif
if SubStr( cBuffer, nFor, 1 ) IN "-(" .and. SubStr( cBuffer, nFor, 1 ) != SubStr( ::cPicMask, nFor, 1 )
::minus := .t.
exit
endif
next
endif

/* 14/08/2004 - <maurilio.longo@libero.it>
* If there should be a decimal point (or comma) but this is missing
* re-add it. Clipper does it. A little sample is inside ChangeLog
* for this fix.
*/
if ::decPos < Len( cBuffer ) .and. Empty( cBuffer[ ::decPos ] ) .and. if( ::lDecRev, "," , "." ) IN ::cPicture
cBuffer[ ::decPos ] := if( "E" IN ::cPicFunc .or. ::lDecRev, ",", "." )
endif

cBuffer := Space( ::FirstEditable() - 1 ) + ;
SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 )

if "D" IN ::cPicFunc
for nFor := ::FirstEditable( ) to ::LastEditable( )
cMaskDel += if( ::IsEditable( nFor ), " ", "X" )
next
else
if "E" IN ::cPicFunc .or. ::lDecRev
cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) + ;
StrTran( SubStr( cBuffer, ::FirstEditable( ), ;
::LastEditable( ) - ::FirstEditable( ) + 1 ), ;
".", " " ) +;
SubStr( cBuffer, ::LastEditable() + 1 )

cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) + ;
StrTran( SubStr( cBuffer, ::FirstEditable( ), ;
::LastEditable( ) - ::FirstEditable( ) + 1 ), ;
",", "." ) + ;
SubStr( cBuffer, ::LastEditable() + 1 )

else
/*
* 2005/07/30 - Eduardo Fernandes <modalsist@yahoo.com.br>
* The two IFs below was disabled because cause wrong get value
* if we type a numeric var greater than 999 in the picture
* "@R 9,999.99".
* Added: lUntransform := ( "R" IN ::cPicFunc ) instead.
*
* if "R" IN ::cPicFunc
* lUntransform := Empty( ::buffer )
* endif
*
* if ":" IN ::cPicture
* lUntransform := .T.
* endif
*/
lUntransform := ( "R" IN ::cPicFunc )


if lUntransform
cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) + ;
StrTran( SubStr( cBuffer, ::FirstEditable( ), ;
::LastEditable( ) - ::FirstEditable( ) + 1 ), ;
",", " " ) + ;
SubStr( cBuffer, ::LastEditable() + 1 )
endif

endif

/* Tony (ABC) 12/22/2005 3:53PM
* The mask to delete has to be created according to the whole buffer!!
* Because it is applied below as: cBuffer := StrDel( cBuffer, cMaskDel )
*/
for nFor := 1 to len(cBuffer)
// for nFor := ::FirstEditable( ) to ::LastEditable( )
cMaskDel += iif( ::IsEditable( nFor ) .or. SubStr( cBuffer, nFor, 1 ) == ".", " ", "X" )
if ::IsEditable( nFor ) .or. SubStr( cBuffer, nFor, 1 ) == "."
nPad ++
endif
next
endif

/* Tony (ABC) 12/22/2005 3:53PM
* I found that cMaskDel was shorter than cBuffer. Fixed bug.
*/
cBuffer := StrDel( cBuffer, cMaskDel )

cBuffer := StrTran( cBuffer, "$", " " )
cBuffer := StrTran( cBuffer, "*", " " )
cBuffer := StrTran( cBuffer, "-", " " )
cBuffer := StrTran( cBuffer, "(", " " )
cBuffer := StrTran( cBuffer, ")", " " )

cBuffer := PadL( StrTran( cBuffer, " ", "" ), nPad )

/* cBuffer := PadL( StrTran( cBuffer, " ", "" ), Len( cBuffer ) )
* It replace left, right and medium spaces.
* Don't replace for Alltrim()
* xValue := 0 + Val( cBuffer ) // 0 + ... avoids setting the
*/

/* 13/08/2004 - <maurilio.longo@libero.it>
* We're talking about a number and a few lines of code before this
* point ::minus is set to .T. if there is a "-(" inside number and
* a few lines after we make a Val(cBuffer), so, this buffer has to
* contain only numbers (and a "-" or ".", at max);
* that said, while there was this loop?
* I've replaced it with the iif( ::minus... ) which is shorter and
* evaluates correctly a buffer containing " -.10"
*
* if ::minus
* For each cChar in cBuffer
* if IsDigit( cChar )
* nFor := HB_EnumIndex()
* exit
* endif
* Next
* nFor--
* if nFor > 0
* cBuffer := Left( cBuffer, nFor-1 ) + "-" + SubStr( cBuffer, nFor+1 )
* else
* cBuffer := "-" + cBuffer
* endif
* endif
*/

/* 2006/JUN/07 - E.F. Adjust buffer string in case of var get without
* picture and empty buffer. Without this adjust, xValue returned will be
* 0 instead 0.0, 0.00, 0.000 if decimal point exist.
*/
if empty(::cPicture ) .and. empty( StrTran(cBuffer,".","" ) )
cBuffer := PadL( "0."+ replicate("0",::nMaxLen - ::Decpos), ::nMaxLen )
endif

xValue := iif( ::minus, -Val( cBuffer ), Val( cBuffer ) )
exit

case "L"
cBuffer := Upper( cBuffer )
xValue := "T" IN cBuffer .or. "Y" IN cBuffer .or. hb_langmessage( HB_LANG_ITEM_BASE_TEXT + 1 ) IN cBuffer
exit

case "D"
if "E" IN ::cPicFunc
//cBuffer := SubStr( cBuffer, 4, 3 ) + SubStr( cBuffer, 1, 3 ) + SubStr( cBuffer, 7 )
cBuffer := InvertDwM( cBuffer )
endif
xValue := CToD( cBuffer )
exit

end

return xValue

//---------------------------------------------------------------------------//

METHOD overstrike( cChar ) CLASS Get

if ::Type == "N" .and. ! ::lEdit .and. ::Clear
::Pos := ::FirstEditable()
endif

if ::Pos > ::nMaxEdit
::Rejected := .t.
return Self
endif

cChar := ::Input( cChar )

if cChar == ""
::Rejected := .t.
return Self
else
::Rejected := .f.
endif


if ::lUndo .OR. ( ::Clear .AND. ::Pos == ::FirstEditable() )
::DeleteAll()
::Clear := .f.
::lEdit := .f.
endif

if ! ::lEdit
::lEdit := .t.
//::buffer := ::PutMask( ::VarGet(), .t. )
endif

if ::Pos == 0
::Pos = 1
endif

do while ! ::IsEditable( ::Pos ) .and. ::Pos <= ::nMaxEdit
::Pos++
enddo

if ::Pos > ::nMaxEdit
::Pos := ::FirstEditable()
endif

::buffer := SubStr( ::buffer, 1, ::Pos - 1 ) + cChar + SubStr( ::buffer, ::Pos + 1 )

// To conform UPDATED() behaviour with that of Clipper
::Changed := .T.

// UPDATED() function previously did not return .T. even if a key press is
// accepted.
// ::Changed := ValType( ::Original ) != ValType( ::unTransform() ) .or.;
// !( ::unTransform() == ::Original )
::Right( .f. )

if ::type == "D"
::BadDate := IsBadDate( ::buffer, ::cPicFunc )
else
::BadDate := .f.
endif

::Display()

return Self

//---------------------------------------------------------------------------//

METHOD Insert( cChar ) CLASS Get

local n
local nMaxEdit := ::nMaxEdit

if ::Type == "N" .and. ! ::lEdit .and. ::Clear
::Pos := ::FirstEditable()
endif

if ::Pos > ::nMaxEdit
::Rejected := .t.
return Self
endif

cChar := ::Input( cChar )

if cChar == ""
::Rejected := .t.
return Self
else
::Rejected := .f.
endif

if ::lUndo .OR. ( ::Clear .AND. ::Pos == ::FirstEditable() )
::DeleteAll()
::Clear := .f.
::lEdit := .f.
endif

if ! ::lEdit
::lEdit := .t.
//::buffer := ::PutMask( ::VarGet(), .t. )
endif

if ::Pos == 0
::Pos = 1
endif

do while ! ::IsEditable( ::Pos ) .and. ::Pos <= ::nMaxEdit
::Pos++
enddo

if ::Pos > ::nMaxEdit
::Pos := ::FirstEditable()
endif

if ::lPicComplex
// Calculating diferent nMaxEdit for ::lPicComplex

for n := ::Pos to nMaxEdit
if !::IsEditable( n )
exit
endif
next
nMaxEdit := n
::buffer := Left( Substr( ::buffer, 1, ::Pos-1 ) + cChar +;
Substr( ::buffer, ::Pos, nMaxEdit-1-::Pos ) +;
Substr( ::buffer, nMaxEdit ), ::nMaxLen )
else
::buffer := Left( Substr( ::buffer, 1, ::Pos-1 ) + cChar + Substr( ::buffer, ::Pos ), ::nMaxEdit )
endif

// To conform UPDATED() behaviour with that of Clipper
::Changed := .T.

// UPDATED() function previously did not return .T. even if a key press is
// accepted.
// ::Changed := ValType( ::Original ) != ValType( ::unTransform() ) .or.;
// !( ::unTransform() == ::Original )
::Right( .f. )

if ::type == "D"
::BadDate := IsBadDate( ::buffer, ::cPicFunc )
else
::BadDate := .f.
endif

::Display()

return Self

//---------------------------------------------------------------------------//

METHOD _Right( lDisplay ) CLASS Get

local nPos

DEFAULT lDisplay TO .t.

if ! ::hasfocus
return Self
endif

::TypeOut := .f.
::Clear := .f.

if ::Pos == ::nMaxEdit
::TypeOut := .t.
return Self
endif

nPos := ::Pos + 1

do while ! ::IsEditable( nPos ) .and. nPos <= ::nMaxEdit
nPos++
Enddo

if nPos <= ::nMaxEdit
::Pos := nPos
else
::TypeOut := .t.
endif

if lDisplay
::Display( .f. )
endif

return Self

//---------------------------------------------------------------------------//

METHOD _Left( lDisplay ) CLASS Get

local nPos

DEFAULT lDisplay TO .t.

if ! ::hasfocus
return Self
endif

::TypeOut := .f.
::Clear := .f.

if ::Pos == ::FirstEditable()
::TypeOut := .t.
return Self
endif

nPos := ::Pos - 1

do while ! ::IsEditable( nPos ) .and. nPos > 0
nPos--
Enddo

if nPos > 0
::Pos := nPos
else
::TypeOut := .t.
endif

if lDisplay
::Display( .f. )
endif

return Self

//---------------------------------------------------------------------------//

METHOD WordLeft() CLASS Get

local nPos, nFirstEditable

if ! ::hasfocus
return Self
endif

::TypeOut := .f.
::Clear := .f.

nFirstEditable := ::FirstEditable()

if ::Pos == nFirstEditable
::TypeOut := .t.
return Self
endif

nPos := ::Pos

do while nPos > nFirstEditable .and. ( SubStr( ::buffer, nPos - 1, 1 ) == " " .or. ! ::IsEditable( nPos - 1 ) )
nPos--
enddo

do while nPos > nFirstEditable .and. ! ( SubStr( ::buffer, nPos - 1, 1 ) == " " .or. ! ::IsEditable( nPos - 1 ) )
nPos--
enddo

::Pos := nPos

::Display( .f. )

return Self

//---------------------------------------------------------------------------//

METHOD WordRight() CLASS Get

local nPos, nLastEditable

if ! ::hasfocus
return Self
endif

::TypeOut := .f.
::Clear := .f.

nLastEditable := ::LastEditable()

if ::Pos == nLastEditable
::TypeOut := .t.
return Self
endif

nPos := ::Pos

do while nPos < nLastEditable .and. ! ( SubStr( ::buffer, nPos, 1 ) == " " .or. ! ::IsEditable( nPos ) )
nPos++
enddo

do while nPos < nLastEditable .and. ( SubStr( ::buffer, nPos, 1 ) == " " .or. ! ::IsEditable( nPos ) )
nPos++
enddo

::Pos := nPos

::Display( .f. )

return Self

//---------------------------------------------------------------------------//

METHOD ToDecPos() CLASS Get

LOCAL xBuffer

if ! ::HasFocus .or. ::DecPos == NIL
return Self
endif

/* 2006/JUN/05 - E.F. Delete all only if we press dot or comma in a numeric
var. */
if ::Pos == ::FirstEditable() .and. ::Type == 'N' .and.;
( Lastkey()=asc('.') .or. Lastkey()==asc(',') )
::DeleteAll()
endif

::TypeOut := .f.
::Clear := .f.
::lEdit := .t.
xBuffer := ::UnTransform()
::Buffer := ::PutMask( xBuffer, .f. )
::Pos := ::DecPos + 1

::Display( .t. )

/* E.F. 2006/APRIL/12 - Re-entrance of buffer value to update ::xVarGet
* into VarGet()
*/
::VarPut( xBuffer, .t. )

return Self

//---------------------------------------------------------------------------//

METHOD IsEditable( nPos ) CLASS Get

local cChar

if Empty( ::cPicMask )
return .t.
endif

if ::nMaxEdit == NIL .or. nPos > ::nMaxEdit
return .f.
endif

cChar := UPPER( SubStr( ::cPicMask, nPos, 1 ) )

Switch ::type
case "C"
return cChar IN "!ANXLY9#"
case "N"
return cChar IN "9#$*"
case "D"
return cChar IN "9"
case "L"
return cChar IN "LY"
end

return .f.

//---------------------------------------------------------------------------//

METHOD Input( cChar ) CLASS Get

local cPic

Switch ::type
case "N"

Switch cChar
case "-"
/* 2006/JUN/07 - E.F. The minus sign can not be write in any place,
* instead, can be write up to 1 position before
* decimal point. Example: -.99 not -99 or 9.-9 or
* 9.9-
* Clipper allow it, but it's wrong.
*/
if ::decpos > 0 .and. ::Pos > ::decpos
::ToDecPos()
return ""
else
::minus := .t.
endif
exit

case "."
case ","
::ToDecPos()
return ""

case "0"
case "1"
case "2"
case "3"
case "4"
case "5"
case "6"
case "7"
case "8"
case "9"
exit

Default
return ""

end
exit

case "D"

if !( cChar IN "0123456789" )
return ""
endif
exit

case "L"

if !( Upper( cChar ) IN "YNTF"+hb_langmessage( HB_LANG_ITEM_BASE_TEXT + 1 )+hb_langmessage( HB_LANG_ITEM_BASE_TEXT + 2 ) )
return ""
endif
Do Case
case UPPER( cChar ) == hb_langmessage( HB_LANG_ITEM_BASE_TEXT + 1 )
cChar := "Y"
case UPPER( cChar ) == hb_langmessage( HB_LANG_ITEM_BASE_TEXT + 2 )
cChar := "N"
endcase
exit

end

if ! Empty( ::cPicFunc )
// Dirty HACK for solve the the "@RE" TRANSFORMation... "N" -> " /N / "
if "R" IN ::cPicFunc .AND. "E" IN ::cPicFunc
cChar := SubStr( Transform( cChar, ::cPicFunc ), 4, 1 ) // Needed for @RE
else
cChar := Left( Transform( cChar, ::cPicFunc ), 1 ) // Left needed for @D
endif
endif

if ! Empty( ::cPicMask )
cPic := Substr( ::cPicMask, ::Pos, 1 )

// cChar := Transform( cChar, cPic )
// Above line eliminated because some get picture template symbols for
// numeric input not work in text input. eg: $ and *

Switch cPic
case "A"
if ! IsAlpha( cChar )
cChar := ""
endif
exit

case "N"
if ! IsAlpha( cChar ) .and. ! IsDigit( cChar )
cChar := ""
endif
exit

case "9"
if ! IsDigit( cChar )
If cChar != "-" .OR. ::Type != "N"
cChar := ""
EndIf
endif
exit

case "#"
if ! IsDigit( cChar ) .and. !( cChar == " " ) .and. !( cChar IN ".+-" )
cChar := ""
endif
exit

case "L"
if !( Upper( cChar ) IN "YNTF"+;
hb_langmessage( HB_LANG_ITEM_BASE_TEXT + 1 )+;
hb_langmessage( HB_LANG_ITEM_BASE_TEXT + 2 ) )
cChar := ""
endif
exit

case "Y"
if !( Upper( cChar ) IN "YN" )
cChar := ""
endif
exit

case "$"
case "*"
if ::type == "N"
if ! IsDigit( cChar ) .and. cChar != "-"
cChar := ""
endif
else
cChar := Transform( cChar, cPic )
endif
exit

Default
cChar := Transform( cChar, cPic )
end
endif
return cChar

//---------------------------------------------------------------------------//

METHOD PutMask( xValue, lEdit ) CLASS Get

local cChar
local cBuffer
local cPicFunc
local cMask
local cMaskDel

local nFor
local nAt
local nNoEditable := 0

DEFAULT lEdit TO ::HasFocus
DEFAULT xValue TO ::UnTransform()
DEFAULT xValue TO ::xVarGet
DEFAULT xValue TO ::VarGet()

IF ::Type == NIL
::Type := ValType( xValue )
::Picture := ::cOrigPicture
ENDIF

cPicFunc := ::cPicFunc
cMask := ::cPicMask

DEFAULT cMask TO ""

if xValue == NIL .OR. ValType( xValue ) IN "AB"
::nMaxLen := 0
return NIL
endif

if ::HasFocus
cPicFunc := StrTran( cPicfunc, "B", "" )
if cPicFunc == "@"
cPicFunc := ""
endif
endif
if lEdit .and. ::lEdit
if ( "*" IN cMask ) .or. ( "$" IN cMask )
cMask := StrTran( StrTran( cMask, "*", "9" ), "$", "9" )
endif
endif

cBuffer := Transform( xValue, if( Empty( cPicFunc ), if( ::lCleanZero .and. !::HasFocus, "@Z ", "" ), cPicFunc + if( ::lCleanZero .and. !::HasFocus, "Z", "" ) + " " ) + cMask )

/* 2007/MAY/20 - E.F. */
::lDispLenChanged := ( ::Type=="N" .AND. ("DB" IN cBuffer .OR. "CR" IN cBuffer .OR. "(" IN cBuffer .OR. ")" IN cBuffer ) )

if ::type == "N"

if ::lDispLenChanged

if "(" IN cPicFunc .or. ")" IN cPicFunc

::nDispLenReduce := 1

if xValue >= 0
cBuffer := Padr( cBuffer, iif(::nMaxLen != NIL, ::nMaxLen, iif(cMask!=NIL,Len(cMask),10) ) )
endif

elseif "C" IN cPicFunc

::nDispLenReduce := 3

if xValue < 0
cBuffer := Padr( cBuffer, iif(::nMaxLen != NIL, ::nMaxLen, iif(cMask!=NIL,Len(cMask),10) ) )
endif

elseif "X" IN cPicFunc

::nDispLenReduce := 3

if xValue >= 0
cBuffer := Padr( cBuffer, iif(::nMaxLen != NIL, ::nMaxLen, iif(cMask!=NIL,Len(cMask),10) ) )
endif

endif

endif

::lMinusPrinted := ( xValue < 0 )

endif

::nMaxLen := Len( cBuffer )
::nMaxEdit := ::nMaxLen

if ::nDispLen == NIL .or. !::lDispLen
::nDispLen := ::nMaxLen
endif

if lEdit .and. ::type == "N" .and. ! Empty( cMask )

if "E" IN cPicFunc
cMask := Left( cMask, ::FirstEditable() - 1 ) + StrTran( SubStr( cMask, ::FirstEditable( ), ::LastEditable( ) - ::FirstEditable( ) + 1 ), ",", chr(1) ) + SubStr( cMask, ::LastEditable() + 1 )
cMask := Left( cMask, ::FirstEditable() - 1 ) + StrTran( SubStr( cMask, ::FirstEditable( ), ::LastEditable( ) - ::FirstEditable( ) + 1 ), ".", "," ) + SubStr( cMask, ::LastEditable() + 1 )
cMask := Left( cMask, ::FirstEditable() - 1 ) + StrTran( SubStr( cMask, ::FirstEditable( ), ::LastEditable( ) - ::FirstEditable( ) + 1 ), chr(1), "." ) + SubStr( cMask, ::LastEditable() + 1 )
endif

for each cChar in cMask
if cChar IN ",." .and. SubStr( cBuffer, HB_EnumIndex(), 1 ) IN ",."
cBuffer := Substr( cBuffer, 1, HB_EnumIndex() - 1 ) + cChar + Substr( cBuffer, HB_EnumIndex() + 1 )
endif
next

if ::lEdit .and. Empty(xValue)
cBuffer := StrTran(cBuffer, "0", " ")
endif

if ::lDecRev
cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) + StrTran( SubStr( cBuffer, ::FirstEditable( ), ::LastEditable( ) - ::FirstEditable( ) + 1 ), ",", chr(1) ) + SubStr( cBuffer, ::LastEditable() + 1 )
cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) + StrTran( SubStr( cBuffer, ::FirstEditable( ), ::LastEditable( ) - ::FirstEditable( ) + 1 ), ".", "," ) + SubStr( cBuffer, ::LastEditable() + 1 )
cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) + StrTran( SubStr( cBuffer, ::FirstEditable( ), ::LastEditable( ) - ::FirstEditable( ) + 1 ), chr(1), "." ) + SubStr( cBuffer, ::LastEditable() + 1 )
endif

endif

/* 2007/MAY/20 - E.F. */
if ::type == "N"

if ::lDispLenChanged

if ( "(" IN ::cPicFunc .OR. ")" IN ::cPicFunc .OR.;
"C" IN ::cPicFunc .OR. "X" IN ::cPicFunc )

::nMaxEdit := ::nMaxLen - ::nDispLenReduce

endif

endif

/* 2006/OCT/28 - E.F. - fixed a bug when we set century on after set date
* and use get with picture "@E" in date variable.
* If ::type == "D" .and. ::BadDate .and. ::Buffer != nil
* cBuffer := ::Buffer
* Endif
*/
elseif ::type == "D"
If ::BadDate .and. ::Buffer != nil
cBuffer := ::Buffer
Elseif ::Buffer == NIL .and. "E" IN ::cPicFunc
cBuffer := InvertDwM( DtoC( xValue ) )
Endif
Endif

return cBuffer

//---------------------------------------------------------------------------//

METHOD BackSpace( lDisplay ) CLASS Get

local nPos := ::Pos, nMinus

DEFAULT lDisplay TO .t.

if nPos > 1 .and. nPos == ::FirstEditable() .and. ::minus
/* For delete the parenthesis (negative indicator) in a non editable position */

nMinus := At( "(", SubStr( ::buffer, 1, nPos-1 ) )

if nMinus > 0 .and. SubStr( ::cPicMask, nMinus, 1 ) != "("

::lEdit := .t.

::buffer := SubStr( ::buffer, 1, nMinus - 1 ) + " " +;
SubStr( ::buffer, nMinus + 1 )

::Changed := .T.

if lDisplay
::Display()
endif

return Self

endif

endif

::Left()

if ::Pos < nPos
::Delete( lDisplay )
endif

return Self

//---------------------------------------------------------------------------//

METHOD _Delete( lDisplay ) CLASS Get

LOCAL nMaxLen := ::nMaxLen, n

DEFAULT lDisplay TO .t.

::Clear := .f.
::lEdit := .t.

if ::lPicComplex
// Calculating diferent nMaxLen for ::lPicComplex
for n := ::Pos to nMaxLen
if !::IsEditable( n )
exit
endif
next
nMaxLen := n - 1
endif

if ::type == "N" .and. SubStr( ::buffer, ::Pos, 1 ) IN "(-"
::minus := .f.
endif

/* 2006/OCT/06 - E.F. Added new @K+ functionality to empty
* get buffer if first key pressed is DEL key.
*/
if "K+" IN ::cPicFunc .AND. ::Pos == ::FirstEditable()
::DeleteAll()
else
::buffer := PadR( SubStr( ::buffer, 1, ::Pos - 1 ) + ;
SubStr( ::buffer, ::Pos + 1, nMaxLen - ::Pos ) + " " +;
SubStr( ::buffer, nMaxLen + 1 ), ::nMaxLen )
endif


if ::type == "D"
::BadDate := IsBadDate( ::buffer, ::cPicFunc )
else
::BadDate := .f.
endif

::Changed := .T.

if lDisplay
::Display()
endif

return Self

//---------------------------------------------------------------------------//

PROCEDURE DeleteAll() CLASS Get

local xValue

::lEdit := .t.
::lUndo := .f.

Switch ::type
case "C"
xValue := Space( ::nMaxlen )
exit
case "N"
xValue := 0
::minus := .f.
exit
case "D"
xValue := CToD( "" )
::BadDate := .f.
exit
case "L"
xValue := .f.
exit
end

::buffer := ::PutMask( xValue, .t. )
::Pos := ::FirstEditable()

/* E.F. 2006/APRIL/14 - Clipper show all commas and dots of '@E','@R'
* masks of numeric vars, into display edit buffer after first key number
* is entered.
* E.F. 2006/MAY/31 - Idem for numeric mask without '@E' or '@R' as
* pict '999,999,999.99' also.
*/
IF ::type=="N" .AND. ::buffer != NIL .AND. !empty(::cPicture) .AND.;
("," IN ::cPicture .AND. "." IN ::cPicture)
IF "R" IN ::cPicFunc .AND. !("E" IN ::cPicFunc) .OR. Empty( ::cPicFunc )
::buffer := StrTran(::buffer, ".", "" )
::buffer := StrTran(::buffer, ",", "" )
::buffer := Transform( ::buffer, ::cPicture )
ELSEIF "E" IN ::cPicFunc
IF "R" IN ::cPicFunc
::buffer := Transform( ::buffer, ::cPicMask )
ELSE
::buffer := Transform( ::buffer, ::cPicture )
ENDIF
::buffer := StrTran(::buffer, ".", chr(1) )
::buffer := StrTran(::buffer, ",", "." )
::buffer := StrTran(::buffer, chr(1), "," )
ENDIF
ENDIF

return

//---------------------------------------------------------------------------//

METHOD DelEnd() CLASS Get

local nPos := ::Pos

if ! ::hasfocus
return Self
endif

::Pos := ::nMaxEdit

::Delete( .f. )
do while ::Pos > nPos
::BackSpace( .f. )
enddo

::Display()

return Self

//---------------------------------------------------------------------------//

METHOD DelLeft() CLASS Get

::Left( .f. )
::Delete( .f. )
::Right()

return Self

//---------------------------------------------------------------------------//

METHOD DelRight() CLASS Get

::Right( .f. )
::Delete( .f. )
::Left()

return Self

//---------------------------------------------------------------------------//

METHOD DelWordLeft() CLASS Get

if ! ::hasfocus
return Self
endif

::WordLeft()
::DelWordRight()

return Self

//---------------------------------------------------------------------------//

METHOD DelWordRight() CLASS Get

local nCount, nPos

if ! ::hasfocus
return Self
endif

::TypeOut := .f.
::Clear := .f.

if ::Pos == ::nMaxEdit
::TypeOut := .t.
return Self
endif

// Counts how many characters must be deleted
nPos := ::Pos
nCount := 0
do while nPos <= ::nMaxEdit .and. ! SubStr( ::buffer, nPos, 1 ) == " " .and. ::IsEditable( nPos )
nPos++
nCount++
enddo
do while nPos <= ::nMaxEdit .and. SubStr( ::buffer, nPos, 1 ) == " " .and. ::IsEditable( nPos )
nPos++
nCount++
enddo

do while nCount > 0
::Delete( .f. )
nCount--
Enddo

::Display()

return Self

//---------------------------------------------------------------------------//

/* The METHOD ColorSpec and DATA cColorSpec allow to replace the
* property ColorSpec for a function to control the content and
* to carry out certain actions to normalize the data.
* The particular case is that the function receives a single color and
* be used for GET_CLR_UNSELECTED and GET_CLR_ENHANCED.
*
// QUESTIONS, is realy necessary this method? the ::colorspec generated was
not clipper 5.x compatible, and also was not respecting SET INTENSITY
*/
METHOD SetColorSpec( cColorSpec ) CLASS Get

// local cClrUnSel, cClrEnh

if cColorSpec != NIL

/* cClrUnSel := iif( !Empty( hb_ColorIndex( cColorSpec, GET_CLR_UNSELECTED ) ),;
hb_ColorIndex( cColorSpec, GET_CLR_UNSELECTED ),;
hb_ColorIndex( SetColor(), GET_CLR_UNSELECTED ) )

cClrEnh := iif( !Empty( hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ) ),;
hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ),;
cClrUnSel )
*/

::cColorSpec := buildGetColor(cColorSpec)

endif

return ::cColorSpec

//---------------------------------------------------------------------------//

/* The METHOD Picture and DATA cPicture allow to replace the
* property Picture for a function to control the content and
* to carry out certain actions to normalize the data.
* The particular case is that the Picture is loaded later on
* to the creation of the object, being necessary to carry out
* several tasks to adjust the internal data of the object.
*/

METHOD SetPicture( cPicture ) CLASS Get

if cPicture != NIL

::nDispLen := NIL

::cPicture := cPicture

::ParsePict( cPicture )

if ::nDispLen == NIL .or. !::lDispLen
::nDispLen := ::nMaxLen
endif

//if empty( ::cOrigPicture )
if !(::cOrigPicture == cPicture)
::cOrigPicture := cPicture
endif

endif

return ::cPicture

//---------------------------------------------------------------------------//

#ifdef HB_COMPAT_C53
METHOD HitTest( mRow, mCol ) CLASS GET

IF ( Valtype( ::Control ) == "O" )
Return ::Control:HitTest( mRow, mCol )
ENDIF

IF ::Row != mRow
return HTNOWHERE
ENDIF

IF ::nDispLen == NIL
::nDispLen := 1
ENDIF

IF mCol >= ::Col .AND. mCol <= ::Col + ::nDispLen + IIF( ::cDelimit == NIL, 0, 2 )
return HTCLIENT
ENDIF

return HTNOWHERE
#endif

//---------------------------------------------------------------------------//

METHOD FirstEditable( ) CLASS GET

Local nFor

If ::nMaxLen != NIL

If ::IsEditable( 1 )
return 1
Endif

For nFor := 2 to ::nMaxLen
If ::IsEditable( nFor )
Return nFor
Endif
Next

Endif

::TypeOut := .t.

Return 0

//---------------------------------------------------------------------------//

METHOD LastEditable( ) CLASS GET

Local nFor

If ::nMaxLen != NIL

For nFor := ::nMaxLen to 1 step -1
If ::IsEditable( nFor )
Return nFor
Endif
Next

Endif

::TypeOut := .t.

Return 0

//---------------------------------------------------------------------------//
/*
*STATIC FUNCTION IsBadDate( cBuffer, cPicFunc )
*
* local nFor, nLen
*
* if "E" IN cPicFunc
* cBuffer := InvertDwM( cBuffer )
* endif
*
* If !Empty( Ctod( cBuffer ) )
* return .f.
* Endif
*
* nLen := len( cBuffer )
*
* For nFor := 1 to nLen
* If IsDigit( Substr( cBuffer, nFor, 1 ) )
* return .t.
* Endif
* Next
*
* return .f.
*/

STATIC FUNCTION IsBadDate( cBuffer, cPicFunc )
LOCAL cBuffer2

If Empty( cBuffer )
return .F.
Endif

If "E" IN cPicFunc
cBuffer := InvertDwM( cBuffer )
Endif

cBuffer2 := StrTran( cBuffer,"/","")
cBuffer2 := StrTran( cBuffer2,"-","")
cBuffer2 := StrTran( cBuffer2,".","")

If Empty( cBuffer2 )
return .F.
Endif

If Empty( CtoD( cBuffer ) )
return .T.
Endif

RETURN .F.


STATIC FUNCTION InvertDwM( cDate )
/* 2003/03/25 - Eduardo Fernandes <modalsist@yahoo.com.br>
Invert day with month to date format if "@E" picture is used.*/

IF SubStr( SET(_SET_DATEFORMAT),1,2) == "yy" // set date ANSI and JAPAN
IF __SetCentury()
cDate := SubStr( cDate, 1, 5 ) + SubStr( cDate, 9, 2 ) + SubStr( cDate, 8, 1 ) + SubStr( cDate, 6, 2 )
ELSE
cDate := SubStr( cDate, 1, 3 ) + SubStr( cDate, 7, 2 ) + SubStr( cDate, 6, 1 ) + SubStr( cDate, 4, 2 )
ENDIF
ELSE // all others set date
cDate := SubStr( cDate, 4, 3 ) + SubStr( cDate, 1, 3 ) + SubStr( cDate, 7 )
ENDIF

RETURN cDate

/*
*static procedure AnalyzePicture( cPicture )
* Local cChar, lS := .f.
*
* For each cChar in Substr( cPicture, 2 )
* do case
* case cChar == "S"
* lS := .t.
* case cChar $ "!()L0ABCDEKRXZ"
* lS := .f.
* case cChar $ "0123456789" .and. lS
* other
* cPicture := Left( cPicture, HB_EnumIndex() )
* endcase
* Next
*Return
*/

STATIC FUNCTION BuildGetColor( cColorSpec )
Local cCur
Local aTokens

If ! ValType( cColorSpec ) == "C"
cColorSpec := Nil // Clipper compatibility
Endif

cCur := SetColor()

If Set( _SET_INTENSITY )

Default cColorSpec To __guiColor( cCur, CLR_UNSELECTED + 1 ) +","+;
__guiColor( cCur, CLR_ENHANCED + 1 ) +","+;
__guiColor( cCur, CLR_STANDARD + 1 ) +","+;
__guiColor( cCur, CLR_BACKGROUND + 1 )

Else
Default cColorSpec To __guiColor( cCur, CLR_STANDARD + 1 )

Endif

/* NOTE */
aTokens := HB_ATOKENS( cCur := Upper( cColorSpec ), "," )

If Len( aTokens ) == 1
cColorSpec := cCur + Replicate( "," + cCur, 3 )

[Antonio Linares]

Daniel,

Envíame el PRG modificado por email, gracias

[zazibr]

acabei de evniar por e-mail se puder compilar o contrib agradeço pois uso algumas lib´s do contrib


gtwvw
what32


muito obrigado

[Antonio Linares]

Daniel,

Descarga el build actual de FiveTech de xHarbour desde:
www.fivetechsoft.com/files/xharbour.exe

y reemplaza rtl.lib con esta librería:
http://rapidshare.com/files/99447785/rtl.zip.html
contiene la clase TGet que nos has enviado

[zazibr]

ola contem somente as alterações ?


com o seu tget.prg voce so fez as modificações certo ?


consegui compilar a lib e funcionou com o cvs


assim que chegar em minha cidade de origem devo entrar em contato com o gilmer revendedor do brasil


obrigado pela ajuda e dedicação