diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 46cccee835..d80c64feff 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,49 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-04-20 04:05 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * harbour/source/rtl/tget.prg + * harbour/tests/Makefile + + harbour/tests/rto_get.prg + ; Fixed lots of minor bugs and differences between + CA-Cl*pper and Harbour Get system. The following + methods got most of the fixes: + + ::Reform() undocumented C52 method added. + ! ::Display() fixed when not having focus. (old TOFIX) + ! ::UpdateBuffer() fixed when not having focus. + ! ::SetFocus() fixed to do nothing when already having focus. + ! ::KillFocus() made almost fully compatible. + (the ::Assign() call is still raising questions) + ! ::Reset() made compatible. + ! ::VarPut() fixed when not having focus. + ! ::Undo() made compatible. + ! ::Type() behaviour now fully C5x compatible. + ! ::Block() assignment now fully C5x compatible. + ! ::OverStrike() fixed RTE when not having focus. + ! ::Insert() fixed RTE when not having focus. + ! ::ToDecPos() fixed to set ::Changed. + ! ::PutMask() fixed to not pad the string to ::nMaxLen to + be fully compatible with C5x. + ! ::DecPos, ::Pos initialization made compatible. + (here the CA-Cl*pper NG is wrong in stating that these + vars ever hold NIL, they don't and they hold 0s instead) + ! ::Minus more compatible but still far from perfect. + % ::ParsePict() integrated into ::Picture() + - ::HasScroll() internal method removed. + ! ::HitTest() guarded with HB_COMPAT_C53. + + Propely marked Get vars/methods as PROTECTED/VISIBLE. + % Several minor optimizations, meaningless code elimination. + ; Formatting, removed many old commented code snippets. + + Added regression style tests for basic Get methods. + All the above fixes was the result of comparing + Get object var dumps after calling different methods + in different order. + ; Notice that there could be new/rare cases when any of + the above methods would need more fixes, in that case + the regression test is there to check if the existing + behaviour stayed the same after the fix and it's also + very useful to add the new cases to the test. + 2007-04-19 00:15 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/contrib/gd/gdwrp.c * harbour/contrib/libmisc/hb_f.c diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 7bc8f3381a..b030120319 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -65,15 +65,16 @@ coordinates. Xbase++ compatible method */ +/* TOFIX: ::Minus [vszakats] */ + #define GET_CLR_UNSELECTED 0 #define GET_CLR_ENHANCED 1 -//----------------------------------------------------------------------------// - +/* ------------------------------------------------------------------------- */ CLASS Get - // Exported + EXPORTED: DATA BadDate DATA Buffer @@ -95,25 +96,38 @@ CLASS Get DATA Row DATA SubScript DATA TypeOut - #ifdef HB_COMPAT_C53 +#ifdef HB_COMPAT_C53 DATA Control DATA Message DATA Caption - DATA nLastExitState DATA CapRow DATA CapCol - #endif +#endif - DATA cColorSpec HIDDEN // Used only for METHOD ColorSpec - DATA cPicture HIDDEN // Used only for METHOD Picture - DATA bBlock HIDDEN // Used only for METHOD Block - DATA cType HIDDEN // Used only for METHOD Type + PROTECTED: - // Protected + DATA cColorSpec + DATA cPicture + DATA bBlock + DATA cType - DATA cPicMask, cPicFunc, nMaxLen, lEdit, lDecRev, lPicComplex - DATA nDispLen, nDispPos, nOldPos, lCleanZero, cDelimit, nMaxEdit - DATA lMinusPrinted, xVarGet + DATA cPicMask + DATA cPicFunc + DATA nMaxLen + DATA lEdit + DATA lDecRev + DATA lPicComplex + DATA nDispLen + DATA nDispPos + DATA nOldPos + DATA lCleanZero + DATA cDelimit + DATA nMaxEdit + DATA lMinus + DATA lMinusPrinted + DATA xVarGet + + VISIBLE: METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) @@ -122,22 +136,26 @@ CLASS Get MESSAGE _Assign METHOD Assign() #endif METHOD Type() - METHOD HitTest( mrow, mcol ) +#ifdef HB_COMPAT_C53 + METHOD HitTest( nMRow, nMCol ) +#endif METHOD Block( bBlock ) SETGET // Replace to DATA bBlock METHOD ColorSpec( cColorSpec ) SETGET // Replace to DATA cColorSpec METHOD Picture( cPicture ) SETGET // Replace to DATA cPicture METHOD Display( lForced ) METHOD ColorDisp( cColorSpec ) INLINE ::ColorSpec := cColorSpec, ::Display(), Self METHOD KillFocus() - METHOD ParsePict( cPicture ) METHOD Reset() METHOD SetFocus() METHOD Undo() METHOD UnTransform( cBuffer ) METHOD UpdateBuffer() +#ifdef HB_C52_UNDOC + METHOD Reform() +#endif METHOD VarGet() - METHOD VarPut(xValue, lReFormat) + METHOD VarPut( xValue, lReFormat ) METHOD End() #ifdef HB_COMPAT_XPP @@ -161,294 +179,185 @@ CLASS Get METHOD Insert( cChar ) METHOD OverStrike( cChar ) + PROTECTED: + METHOD DeleteAll() METHOD IsEditable( nPos ) METHOD Input( cChar ) - METHOD PutMask( cBuffer, lEdit ) - METHOD FirstEditable( ) - METHOD LastEditable( ) - - METHOD HasScroll() INLINE ::nDispLen != ::nMaxLen + METHOD PutMask( xValue, 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 bVarBlock TO iif( ValType( cVarName ) == "C", MemvarBlock( cVarName ), NIL ) DEFAULT cColorSpec TO hb_ColorIndex( SetColor(), CLR_UNSELECTED ) + "," + hb_ColorIndex( SetColor(), CLR_ENHANCED ) - ::HasFocus := .f. - ::lEdit := .f. - ::BadDate := .f. - ::bBlock := bVarBlock -// ::Block := bVarBlock - ::Changed := .f. - ::Clear := .f. - ::Col := nCol - ::ColorSpec := cColorSpec - ::DecPos := NIL - ::ExitState := 0 - ::nLastExitState := 0 - ::Minus := .f. - ::Name := cVarName - ::Pos := NIL - ::PostBlock := NIL - ::PreBlock := NIL - ::Reader := NIL - ::Rejected := .f. - ::Row := nRow - ::SubScript := NIL -// ::cType := ValType( ::Original ) - ::TypeOut := .f. - ::nDispPos := 1 - ::nOldPos := 0 - ::lCleanZero := .f. - ::cDelimit := iif( SET(_SET_DELIMITERS), SET(_SET_DELIMCHARS), NIL ) - ::lMinusPrinted := .f. + /* NIL assigments commented for speed */ - ::cPicture := cPicture + ::HasFocus := .f. + ::BadDate := .f. + ::bBlock := bVarBlock +// ::Buffer := NIL +// ::Cargo := NIL + ::Changed := .f. + ::Clear := .f. + ::Col := nCol + ::ColorSpec := cColorSpec + ::DecPos := 0 // ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. +// ::ExitState := NIL + ::Minus := .f. + ::Name := cVarName +// ::Original := NIL + ::Picture := cPicture + ::Pos := 0 +// ::PostBlock := NIL +// ::PreBlock := NIL +// ::Reader := NIL + ::Rejected := .f. + ::Row := nRow +// ::SubScript := NIL + ::TypeOut := .f. + + ::nDispPos := 1 + ::nOldPos := 0 + ::lCleanZero := .f. + ::cDelimit := iif( SET(_SET_DELIMITERS), SET(_SET_DELIMCHARS), NIL ) + ::lMinus := .f. + ::lMinusPrinted := .f. + ::lEdit := .f. + ::cPicFunc := "" + ::cPicMask := "" + ::lDecRev := .f. + ::lPicComplex := .f. #ifdef HB_COMPAT_C53 - ::Caption := "" - ::CapRow := 0 - ::CapCol := 0 + ::Caption := "" + ::CapRow := 0 + ::CapCol := 0 #endif + return Self -//---------------------------------------------------------------------------// - -METHOD ParsePict( cPicture ) CLASS Get - - local cChar - local nAt - local nFor - local cNum - - cNum := "" - - if Left( cPicture, 1 ) == "@" - - nAt := At( " ", cPicture ) - - if nAt == 0 - ::cPicFunc := Upper( cPicture ) - ::cPicMask := "" - else - ::cPicFunc := Upper( SubStr( cPicture, 1, nAt - 1 ) ) - ::cPicMask := SubStr( cPicture, nAt + 1 ) - endif - - if "D" $ ::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) - endif - ::cPicFunc := SubStr( ::cPicFunc, 1, nAt - 1 ) + SubStr( ::cPicFunc, nFor ) - endif - - if "Z" $ ::cPicFunc - ::lCleanZero := .t. - else - ::lCleanZero := .f. - endif - ::cPicFunc := StrTran( ::cPicFunc, "Z", "" ) - - if ::cPicFunc == "@" - ::cPicFunc := "" - endif - else - ::cPicFunc := "" - ::cPicMask := cPicture - ::lCleanZero := .f. - endif - - if ::cType == nil - ::Original := ::xVarGet - ::cType := ValType( ::Original ) - endif - - if ::cType == "D" - ::cPicMask := LTrim( ::cPicMask ) - endif - - // Comprobar si tiene la , y el . cambiado (Solo en Xbase++) - - ::lDecRev := "," $ Transform( 1.1, "9.9" ) - - // Generate default picture mask if not specified - - if Empty( ::cPicMask ) - - do case - case ::cType == "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" ) - - case ::cType == "N" - - cNum := Str( ::xVarGet ) - 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 - - case ::cType == "C" .and. ::cPicFunc == "@9" - ::cPicMask := Replicate( "9", Len( ::xVarGet ) ) - ::cPicFunc := "" - - endcase - - endif - - // Comprobar si tiene caracteres embebidos no modificables en la plantilla - - ::lPicComplex := .f. - - if ! Empty( ::cPicMask ) - For nFor := 1 to Len( ::cPicMask ) - cChar := SubStr( ::cPicMask, nFor, 1 ) - if !cChar $ "!ANX9#" - ::lPicComplex := .t. - exit - endif - Next - endif - - if ::HasFocus - if ::cType == "N" - ::decpos := At( iif( ::lDecRev .or. "E" $ ::cPicFunc, ",", "." ), ; - Transform( 1, iif( Empty( ::cPicFunc ), "", ::cPicFunc + " " ) + ::cPicMask ) ) - else - ::decpos := NIL - endif - endif - -return ::cPicFunc + " " + ::cPicMask - -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD Assign() CLASS Get - if ::hasFocus - ::VarPut( ::unTransform(), .f. ) + if ::HasFocus + ::VarPut( ::UnTransform(), .f. ) endif return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD UpdateBuffer() CLASS Get - if ::hasFocus - - ::buffer := ::PutMask( ::VarGet() ) - + if ::HasFocus + ::Buffer := ::PutMask( ::VarGet() ) ::Display() - + else + ::PutMask( ::VarGet() ) endif return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ + +#ifdef HB_C52_UNDOC + +METHOD Reform() CLASS Get + + if ::HasFocus + ::Buffer := ::PutMask( ::xVarGet, .f. ) + endif + +return Self + +#endif + +/* ------------------------------------------------------------------------- */ METHOD Display( lForced ) CLASS Get local nOldCursor := SetCursor( SC_NONE ) - local xBuffer + local cBuffer + local nDispPos DEFAULT lForced TO .t. - // ; TOFIX: VarGet() has to be called everytime here to stay - // CA-Cl*pper compatible. - // Currently the caller needs to set :buffer to NIL - // to force that in Harbour. - // Update: Not everytime actually, but the logic is yet - // to be found out. - // [vszakats] - - if ::buffer == nil - ::Original := ::xVarGet - ::cType := ValType( ::Original ) - ::picture := ::cPicture //this sets also ::buffer + if ::Buffer == NIL + ::cType := ValType( ::xVarGet ) + ::picture := ::cPicture endif - xBuffer := ::buffer //::PutMask( ::VarGet(), .f. ) - - if ::cType == 'N' .AND. ::hasFocus .AND. ! ::lMinusPrinted .and. ; - ! Empty( ::DecPos ) .and. ::minus .AND. ; - ::Pos > ::DecPos .and. VAL(LEFT(xBuffer,::DecPos-1)) == 0 - //display '-.' only in case when value on the left side of - //the decimal point is equal 0 - xBuffer := substr( xBuffer, 1, ::DecPos - 2 ) + "-." + substr( xBuffer, ::DecPos + 1 ) + if ::HasFocus + cBuffer := ::Buffer + else + cBuffer := ::PutMask( ::VarGet() ) endif - if ::HasScroll() .and. ::Pos != NIL + if ::nMaxLen == NIL + ::nMaxLen := iif( cBuffer == NIL, 0, Len( cBuffer ) ) + endif + IF ::nDispLen == NIL + ::nDispLen := ::nMaxLen + ENDIF + + if ::cType == "N" .and. ::HasFocus .and. ! ::lMinusPrinted .and. ; + ::DecPos != 0 .and. ::lMinus .and. ; + ::Pos > ::DecPos .and. Val( Left( cBuffer, ::DecPos - 1 ) ) == 0 + + // display "-." only in case when value on the left side of + // the decimal point is equal 0 + cBuffer := SubStr( cBuffer, 1, ::DecPos - 2 ) + "-." + SubStr( cBuffer, ::DecPos + 1 ) + endif + + if ::nDispLen != ::nMaxLen .and. ::Pos != 0 // ; has scroll? if ::nDispLen > 8 - ::nDispPos := Max( 1, Min( ::Pos - ::nDispLen + 4, ::nMaxLen - ::nDispLen + 1 ) ) + nDispPos := Max( 1, Min( ::Pos - ::nDispLen + 4, ::nMaxLen - ::nDispLen + 1 ) ) else - ::nDispPos := Max( 1, Min( ::Pos - int( ::nDispLen / 2 ), ::nMaxLen - ::nDispLen + 1 ) ) + nDispPos := Max( 1, Min( ::Pos - int( ::nDispLen / 2 ), ::nMaxLen - ::nDispLen + 1 ) ) endif + else + nDispPos := 1 endif - if xBuffer != NIL .and. ( lForced .or. ( ::nDispPos != ::nOldPos ) ) + if cBuffer != NIL .and. ( lForced .or. ( nDispPos != ::nOldPos ) ) DispOutAt( ::Row, ::Col + iif( ::cDelimit == NIL, 0, 1 ),; - Substr( xBuffer, ::nDispPos, ::nDispLen ), ; + SubStr( cBuffer, nDispPos, ::nDispLen ),; hb_ColorIndex( ::cColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) ) - if ! ( ::cDelimit == NIL ) + if ::cDelimit != NIL DispOutAt( ::Row, ::Col, Left( ::cDelimit, 1 ), hb_ColorIndex( ::cColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) ) - DispOutAt( ::Row, ::Col + ::nDispLen + 1, Substr( ::cDelimit, 2, 1 ), hb_ColorIndex( ::cColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) ) + DispOutAt( ::Row, ::Col + ::nDispLen + 1, SubStr( ::cDelimit, 2, 1 ), hb_ColorIndex( ::cColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) ) endif endif - ::nOldPos := ::nDispPos - - if ::Pos != NIL - SetPos( ::Row, ::Col + ::Pos - ::nDispPos + iif( ::cDelimit == NIL, 0, 1 ) ) + if ::Pos != 0 + SetPos( ::Row, ::Col + ::Pos - nDispPos + iif( ::cDelimit == NIL, 0, 1 ) ) endif + ::nOldPos := nDispPos + SetCursor( nOldCursor ) return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD End() CLASS Get local nLastCharPos, nPos, nFor - if ::HasFocus != nil .and. ::HasFocus - nLastCharPos := Min( Len( RTrim( ::buffer ) ) + 1, ::nMaxEdit ) + if ::HasFocus + nLastCharPos := Min( Len( RTrim( ::Buffer ) ) + 1, ::nMaxEdit ) if ::Pos != nLastCharPos nPos := nLastCharPos else @@ -466,191 +375,200 @@ METHOD End() CLASS Get return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD Home() CLASS Get if ::HasFocus - ::Pos := ::FirstEditable( ) + ::Pos := ::FirstEditable() ::Clear := .f. ::Display( .f. ) endif return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD Reset() CLASS Get - if ::hasfocus - ::buffer := ::PutMask( ::VarGet(), .f. ) - ::pos := ::FirstEditable() - ::TypeOut := .f. + if ::HasFocus + ::Buffer := ::PutMask( ::VarGet(), .f. ) + ::Pos := ::FirstEditable() // ; Simple 0 in CA-Cl*pper + ::Clear := ( "K" $ ::cPicFunc .or. ::cType == "N" ) + ::lEdit := .f. + ::Minus := .f. + ::Rejected := .f. + ::TypeOut := ( ::Pos == 0 ) // ; Simple .f. in CA-Cl*pper + ::Display() endif return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD Undo() CLASS Get - if ::hasfocus - ::VarPut( ::Original, .t. ) - ::pos := ::FirstEditable() - ::Display() + if ::HasFocus + ::VarPut( ::Original ) + ::Reset() + ::Changed := .f. endif return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD SetFocus() CLASS Get - local lWasNil := ::buffer == NIL - local xVarGet := ::VarGet() + local lWasNIL + local xVarGet - ::hasfocus := .t. - ::rejected := .f. - ::TypeOut := .f. + if ::HasFocus + return Self + endif + lWasNIL := ::Buffer == NIL + xVarGet := ::VarGet() + + ::HasFocus := .t. + ::Rejected := .f. + ::Original := xVarGet ::cType := ValType( xVarGet ) ::Picture := ::cPicture - ::buffer := ::PutMask( xVarGet, .f. ) - ::changed := .f. - ::clear := ( "K" $ ::cPicFunc .or. ::cType == "N") -// ::nMaxLen := iif( ::buffer == NIL, 0, Len( ::buffer ) ) - ::pos := 0 + ::Buffer := ::PutMask( xVarGet, .f. ) + ::Changed := .f. + ::Clear := ( "K" $ ::cPicFunc .or. ::cType == "N" ) ::lEdit := .f. - - ::pos := ::FirstEditable() - - if ::pos = 0 - ::TypeOut = .t. - endif - + ::Pos := ::FirstEditable() + ::TypeOut := ( ::Pos == 0 ) + if ::cType == "N" - ::decpos := At( iif( ::lDecRev .or. "E" $ ::cPicFunc, ",", "." ), ::buffer ) - ::minus := ( xVarGet < 0 ) + ::DecPos := At( iif( ::lDecRev .or. "E" $ ::cPicFunc, ",", "." ), ::Buffer ) + if ::DecPos == 0 + ::DecPos := Len( ::Buffer ) + 1 + endif + ::lMinus := ( xVarGet < 0 ) else - ::decpos := NIL - ::minus := .f. + ::DecPos := 0 // ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. endif - ::lMinusPrinted := ::minus - - if ::cType == "D" - ::BadDate := IsBadDate( ::buffer, ::cPicFunc ) - else - ::BadDate := .f. - endif - - IF lWasNil .and. ::buffer != NIL - IF ::nDispLen == NIL + + ::lMinusPrinted := .f. + ::Minus := .f. + ::BadDate := ( ::cType == "D" ) .and. IsBadDate( ::Buffer, ::cPicFunc ) + + if lWasNIL .and. ::Buffer != NIL + if ::nDispLen == NIL ::nDispLen := ::nMaxLen - ENDIF - - ::Display( .T. ) - ELSE - ::Display() - ENDIF + endif + endif + + ::Display() return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD KillFocus() CLASS Get + local lHadFocus + if ::lEdit ::Assign() endif - ::hasfocus := .f. - ::buffer := NIL - ::pos := NIL + lHadFocus := ::HasFocus - ::Display() - ::xVarGet := NIL + ::HasFocus := .f. + ::Pos := 0 + ::Clear := .f. + ::Minus := .f. + ::Changed := .f. + ::DecPos := 0 // ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. + + if lHadFocus + ::Display() + endif + + ::xVarGet := NIL + ::Original := NIL + ::Buffer := NIL return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD VarPut( xValue, lReFormat ) CLASS Get - LOCAL aSubs, nLen, aValue - LOCAL i + local aSubs, nLen, aValue + local i DEFAULT lReFormat TO .t. if ValType( ::bBlock ) == "B" - IF ::SubScript == NIL + if ::SubScript == NIL Eval( ::bBlock, xValue ) - ELSE + else aSubs := ::SubScript nLen := Len( aSubs ) aValue := Eval( ::bBlock ) - FOR i:=1 TO nLen - 1 + for i := 1 to nLen - 1 aValue := aValue[ aSubs[ i ] ] - NEXT + next aValue[ aSubs[ i ] ] := xValue - ENDIF + endif if lReFormat - if !::hasfocus - ::Original := xValue - endif - ::cType := ValType( xValue ) + ::cType := ValType( xValue ) ::xVarGet := xValue - ::lEdit := .f. - ::Picture( ::cPicture ) + ::lEdit := .f. + ::Picture := ::cPicture endif endif return xValue -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD VarGet() CLASS Get - LOCAL aSubs, nLen, aValue - LOCAL i - LOCAL xValue + local aSubs, nLen, aValue + local i + local xValue - IF ValType( ::bBlock ) == "B" - IF ::SubScript == NIL + if ValType( ::bBlock ) == "B" + if ::SubScript == NIL xValue := Eval( ::bBlock ) - ELSE + else aSubs := ::SubScript nLen := Len( aSubs ) aValue := Eval( ::bBlock ) - FOR i := 1 TO nLen - 1 + for i := 1 to nLen - 1 aValue := aValue[ aSubs[ i ] ] - NEXT + next xValue := aValue[ aSubs[ i ] ] - ENDIF - ELSE + endif + else xValue := NIL - ENDIF + endif ::xVarGet := xValue return xValue -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ -METHOD Untransform( cBuffer ) CLASS Get +METHOD UnTransform( cBuffer ) CLASS Get local xValue local cChar local nFor - DEFAULT cBuffer TO ::buffer + DEFAULT cBuffer TO ::Buffer -/* - if !::lEdit - return ::VarGet() - endif -*/ +// if !::lEdit +// return ::VarGet() +// endif do case case ::cType == "C" @@ -669,19 +587,19 @@ METHOD Untransform( cBuffer ) CLASS Get case ::cType == "N" - //::minus := .f. + //::lMinus := .f. if "X" $ ::cPicFunc if Right( cBuffer, 2 ) == "DB" - ::minus := .t. + ::lMinus := .t. endif endif - if !::minus + if !::lMinus for nFor := 1 to ::nMaxLen if ::IsEditable( nFor ) .and. IsDigit( SubStr( cBuffer, nFor, 1 ) ) exit endif if SubStr( cBuffer, nFor, 1 ) $ "-(" .and. SubStr( cBuffer, nFor, 1 ) != SubStr( ::cPicMask, nFor, 1 ) - ::minus := .t. + ::lMinus := .t. exit endif next @@ -689,22 +607,22 @@ METHOD Untransform( cBuffer ) CLASS Get cBuffer := Space( ::FirstEditable() - 1 ) + SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 ) if "D" $ ::cPicFunc - for nFor := ::FirstEditable( ) to ::LastEditable( ) + for nFor := ::FirstEditable() to ::LastEditable() if !::IsEditable( nFor ) - cBuffer = Left( cBuffer, nFor-1 ) + Chr( 1 ) + SubStr( cBuffer, nFor+1 ) + cBuffer := Left( cBuffer, nFor-1 ) + Chr( 1 ) + SubStr( cBuffer, nFor+1 ) endif next else if "E" $ ::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 ) + 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 - 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 ) endif - for nFor := ::FirstEditable( ) to ::LastEditable( ) + for nFor := ::FirstEditable() to ::LastEditable() if !::IsEditable( nFor ) .and. SubStr( cBuffer, nFor, 1 ) != "." - cBuffer = Left( cBuffer, nFor-1 ) + Chr( 1 ) + SubStr( cBuffer, nFor+1 ) + cBuffer := Left( cBuffer, nFor-1 ) + Chr( 1 ) + SubStr( cBuffer, nFor+1 ) endif next endif @@ -718,12 +636,8 @@ METHOD Untransform( cBuffer ) CLASS Get cBuffer := StrTran( cBuffer, ")", " " ) 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 - - if ::minus + if ::lMinus for nFor := 1 to Len( cBuffer ) if IsDigit( SubStr( cBuffer, nFor, 1 ) ) exit @@ -741,13 +655,13 @@ METHOD Untransform( cBuffer ) CLASS Get case ::cType == "L" cBuffer := Upper( cBuffer ) - xValue := "T" $ cBuffer .or. "Y" $ cBuffer .or. hb_langmessage( HB_LANG_ITEM_BASE_TEXT + 1 ) $ cBuffer + xValue := "T" $ cBuffer .or. "Y" $ cBuffer .or. hb_LangMessage( HB_LANG_ITEM_BASE_TEXT + 1 ) $ cBuffer case ::cType == "D" if "E" $ ::cPicFunc cBuffer := SubStr( cBuffer, 4, 3 ) + SubStr( cBuffer, 1, 3 ) + SubStr( cBuffer, 7 ) endif - if cBuffer != nil + if cBuffer != NIL xValue := CToD( cBuffer ) endif @@ -755,90 +669,86 @@ METHOD Untransform( cBuffer ) CLASS Get return xValue -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ -METHOD overstrike( cChar ) CLASS Get +METHOD OverStrike( cChar ) CLASS Get - if ::cType == "N" .and. ! ::lEdit .and. ::Clear - ::pos := ::FirstEditable() + if ! ::HasFocus + return Self endif + if ::cType == "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 ::Clear .and. ::pos == ::FirstEditable() + + if ::Clear .and. ::Pos == ::FirstEditable() ::DeleteAll() ::Clear := .f. - ::lEdit := .f. endif - - if ! ::lEdit - ::lEdit := .t. -// ::buffer := ::PutMask( ::xVarGet, .t. ) + + ::lEdit := .t. + + if ::Pos == 0 + ::Pos := 1 endif - - if ::pos == 0 - ::pos = 1 - endif - - do while ! ::IsEditable( ::pos ) .and. ::pos <= ::nMaxEdit - ::pos++ + + do while ! ::IsEditable( ::Pos ) .and. ::Pos <= ::nMaxEdit + ::Pos++ enddo - - if ::pos > ::nMaxEdit - ::pos := ::FirstEditable( ) + + 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 ) - // ::Assign() + ::Buffer := SubStr( ::Buffer, 1, ::Pos - 1 ) + cChar + SubStr( ::Buffer, ::Pos + 1 ) + + ::Changed := .t. + ::Right( .f. ) - - if ::cType == "D" - ::BadDate := IsBadDate( ::buffer, ::cPicFunc ) - else - ::BadDate := .f. - endif - + + ::BadDate := ( ::cType == "D" ) .and. IsBadDate( ::Buffer, ::cPicFunc ) + ::Display() return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD Insert( cChar ) CLASS Get local n - local nMaxEdit := ::nMaxEdit + local nMaxEdit - if ::cType == "N" .and. ! ::lEdit .and. ::Clear - ::pos := ::FirstEditable() + if ! ::HasFocus + return Self endif + nMaxEdit := ::nMaxEdit + + if ::cType == "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 @@ -846,119 +756,105 @@ METHOD Insert( cChar ) CLASS Get ::Rejected := .f. endif - if ::Clear .and. ::pos == ::FirstEditable( ) + if ::Clear .and. ::Pos == ::FirstEditable() ::DeleteAll() ::Clear := .f. - ::lEdit := .f. endif - - if ! ::lEdit - ::lEdit := .t. - // ::buffer := ::PutMask( ::VarGet(), .t. ) + + ::lEdit := .t. + + if ::Pos == 0 + ::Pos := 1 endif - - if ::pos == 0 - ::pos = 1 - endif - - do while ! ::IsEditable( ::pos ) .and. ::pos <= ::nMaxEdit - ::pos++ + + do while ! ::IsEditable( ::Pos ) .and. ::Pos <= ::nMaxEdit + ::Pos++ enddo - - if ::pos > ::nMaxEdit - ::pos := ::FirstEditable( ) + + if ::Pos > ::nMaxEdit + ::Pos := ::FirstEditable() endif - + if ::lPicComplex // Calculating diferent nMaxEdit for ::lPicComplex - + for n := ::Pos to nMaxEdit if !::IsEditable( n ) - exit + exit endif next nMaxEdit := n - ::buffer := Left( Substr( ::buffer, 1, ::Pos-1 ) + cChar +; - Substr( ::buffer, ::Pos, nMaxEdit-1-::Pos ) +; - Substr( ::buffer, nMaxEdit ), ::nMaxLen ) + ::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 ) + ::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 ) - // ::Assign() + + ::Changed := .t. + ::Right( .f. ) - - if ::cType == "D" - ::BadDate := IsBadDate( ::buffer, ::cPicFunc ) - else - ::BadDate := .f. - endif - + + ::BadDate := ( ::cType == "D" ) .and. IsBadDate( ::Buffer, ::cPicFunc ) + ::Display() return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD _Right( lDisplay ) CLASS Get local nPos - DEFAULT lDisplay TO .t. - - if ! ::hasfocus + if ! ::HasFocus return Self endif + DEFAULT lDisplay TO .t. + ::TypeOut := .f. ::Clear := .f. - - if ::pos == ::nMaxEdit + + if ::Pos == ::nMaxEdit ::TypeOut := .t. return Self endif - + nPos := ::Pos + 1 - + do while ! ::IsEditable( nPos ) .and. nPos <= ::nMaxEdit nPos++ - Enddo - + 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 + if ! ::HasFocus return Self endif + DEFAULT lDisplay TO .t. + ::TypeOut := .f. ::Clear := .f. - if ::pos == ::FirstEditable( ) + if ::Pos == ::FirstEditable() ::TypeOut := .t. return Self endif @@ -967,7 +863,7 @@ METHOD _Left( lDisplay ) CLASS Get do while ! ::IsEditable( nPos ) .and. nPos > 0 nPos-- - Enddo + enddo if nPos > 0 ::Pos := nPos @@ -981,20 +877,20 @@ METHOD _Left( lDisplay ) CLASS Get return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD WordLeft() CLASS Get local nPos - if ! ::hasfocus + if ! ::HasFocus return Self endif ::TypeOut := .f. ::Clear := .f. - if ::pos == ::FirstEditable( ) + if ::Pos == ::FirstEditable() ::TypeOut := .t. return Self endif @@ -1002,20 +898,20 @@ METHOD WordLeft() CLASS Get nPos := ::Pos - 1 do while nPos > 0 - if SubStr( ::buffer, nPos, 1 ) == " " - do while nPos > 0 .and. SubStr( ::buffer, nPos, 1 ) == " " + if SubStr( ::Buffer, nPos, 1 ) == " " + do while nPos > 0 .and. SubStr( ::Buffer, nPos, 1 ) == " " nPos-- - Enddo - do while nPos > 0 .and. !( SubStr( ::buffer, nPos, 1 ) == " " ) + enddo + do while nPos > 0 .and. !( SubStr( ::Buffer, nPos, 1 ) == " " ) nPos-- - Enddo + enddo if nPos > 0 nPos++ endif - Exit + exit endif nPos-- - Enddo + enddo if nPos < 1 nPos := 1 @@ -1029,20 +925,20 @@ METHOD WordLeft() CLASS Get return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD WordRight() CLASS Get local nPos - if ! ::hasfocus + if ! ::HasFocus return Self endif ::TypeOut := .f. ::Clear := .f. - if ::pos == ::nMaxEdit + if ::Pos == ::nMaxEdit ::TypeOut := .t. return Self endif @@ -1050,14 +946,14 @@ METHOD WordRight() CLASS Get nPos := ::Pos + 1 do while nPos <= ::nMaxEdit - if SubStr( ::buffer, nPos, 1 ) == " " - do while nPos <= ::nMaxEdit .and. SubStr( ::buffer, nPos, 1 ) == " " + if SubStr( ::Buffer, nPos, 1 ) == " " + do while nPos <= ::nMaxEdit .and. SubStr( ::Buffer, nPos, 1 ) == " " nPos++ - Enddo - Exit + enddo + exit endif nPos++ - Enddo + enddo if nPos > ::nMaxEdit nPos := ::nMaxEdit @@ -1071,37 +967,38 @@ METHOD WordRight() CLASS Get return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD ToDecPos() CLASS Get - if ! ::HasFocus .or. ::DecPos == NIL + if ! ::HasFocus return Self endif - if ::pos == ::FirstEditable( ) + if ::Pos == ::FirstEditable() ::DeleteAll() endif - ::Clear := .f. - ::lEdit := .t. - ::buffer := ::PutMask( ::UnTransform(), .f. ) + ::Clear := .f. + ::lEdit := .t. + ::Buffer := ::PutMask( ::UnTransform(), .f. ) + ::Changed := .t. if ::DecPos != 0 - IF ::DecPos == Len( ::cPicMask ) - ::pos := ::DecPos - 1 //9999. - ELSE - ::pos := ::DecPos + 1 //9999.9 - ENDIF + if ::DecPos == Len( ::cPicMask ) + ::Pos := ::DecPos - 1 //9999. + else + ::Pos := ::DecPos + 1 //9999.9 + endif else - ::pos := ::nDispLen + ::Pos := ::nDispLen endif - ::Display( .t. ) + ::Display() return Self - -//---------------------------------------------------------------------------// + +/* ------------------------------------------------------------------------- */ METHOD IsEditable( nPos ) CLASS Get @@ -1118,19 +1015,19 @@ METHOD IsEditable( nPos ) CLASS Get cChar := SubStr( ::cPicMask, nPos, 1 ) do case - case ::cType == "C" - return cChar $ "!ANX9#" - case ::cType == "N" - return cChar $ "9#$*" - case ::cType == "D" - return cChar == "9" - case ::cType == "L" - return cChar $ "LY#" /* Clipper 5.2 undocumented: # allow T,F,Y,N for Logical [ckedem] */ + case ::cType == "C" + return cChar $ "!ANX9#" + case ::cType == "N" + return cChar $ "9#$*" + case ::cType == "D" + return cChar == "9" + case ::cType == "L" + return cChar $ "LY#" /* Clipper 5.2 undocumented: # allow T,F,Y,N for Logical [ckedem] */ endcase return .f. -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD Input( cChar ) CLASS Get @@ -1140,15 +1037,16 @@ METHOD Input( cChar ) CLASS Get case ::cType == "N" do case - case cChar == "-" - ::minus := .t. /* The minus symbol can be write in any place */ + case cChar == "-" + ::lMinus := .t. /* The minus symbol can be written in any place */ + ::Minus := .t. - case cChar $ ".," - ::toDecPos() - return "" + case cChar $ ".," + ::toDecPos() + return "" - case ! ( cChar $ "0123456789+" ) - return "" + case ! ( cChar $ "0123456789+" ) + return "" endcase case ::cType == "D" @@ -1170,11 +1068,12 @@ METHOD Input( cChar ) CLASS Get endif if ! Empty( ::cPicMask ) - cPic := Substr( ::cPicMask, ::pos, 1 ) + cPic := SubStr( ::cPicMask, ::Pos, 1 ) -// cChar := Transform( cChar, cPic ) +// cChar := Transform( cChar, cPic ) // Above line eliminated because some get picture template symbols for // numeric input not work in text input. eg: $ and * + do case case cPic == "A" if ! IsAlpha( cChar ) @@ -1194,7 +1093,7 @@ METHOD Input( cChar ) CLASS Get cChar := "" endif - /* Clipper 5.2 undocumented: # allow T,F,Y,N for Logical [ckedem] */ + /* Clipper 5.2 undocumented: # allow T,F,Y,N for Logical [ckedem] */ case cPic == "L" .or. ( cPic == "#" .and. ::cType == "L" ) if !( Upper( cChar ) $ "YNTF" + ; hb_langmessage( HB_LANG_ITEM_BASE_TEXT + 1 ) + ; @@ -1223,7 +1122,7 @@ METHOD Input( cChar ) CLASS Get return cChar -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD PutMask( xValue, lEdit ) CLASS Get @@ -1235,7 +1134,7 @@ METHOD PutMask( xValue, lEdit ) CLASS Get local nNoEditable := 0 if ::cType == NIL - //not initialized yet + // Not initialized yet ::Original := ::VarGet() ::cType := ValType( ::Original ) ::Picture := ::cPicture @@ -1247,7 +1146,7 @@ METHOD PutMask( xValue, lEdit ) CLASS Get DEFAULT xValue TO ::VarGet() DEFAULT lEdit TO ::HasFocus - if xValue == NIL .OR. ValType( xValue ) $ "AB" + if xValue == NIL .or. ValType( xValue ) $ "AB" ::nMaxLen := 0 return NIL endif @@ -1291,15 +1190,15 @@ METHOD PutMask( xValue, lEdit ) CLASS Get ::nMaxLen := Len( cBuffer ) ::nMaxEdit := ::nMaxLen - if ::nDispLen == nil + if ::nDispLen == NIL ::nDispLen := ::nMaxLen endif if lEdit .and. ::cType == "N" .and. ! Empty( cMask ) if "E" $ 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 ) + 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 nFor := 1 to ::nMaxLen cChar := SubStr( cMask, nFor, 1 ) @@ -1307,20 +1206,16 @@ METHOD PutMask( xValue, lEdit ) CLASS Get cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + cChar + SubStr( cBuffer, nFor + 1 ) endif next - if ::lEdit .and. Empty(xValue) - cBuffer := StrTran(cBuffer, "0", " ") + 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 ) + 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 - if ::cType == "C" - cBuffer += SubStr( ::VarGet(), ::nMaxLen + 1 ) - endif - if ::cType == "N" if "(" $ ::cPicFunc .or. ")" $ ::cPicFunc ::nMaxEdit-- @@ -1330,34 +1225,35 @@ METHOD PutMask( xValue, lEdit ) CLASS Get endif endif - If ::cType == "D" .and. ::BadDate + if ::cType == "D" .and. ::BadDate cBuffer := ::Buffer - Endif + endif return cBuffer -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD BackSpace( lDisplay ) CLASS Get - local nPos := ::Pos, nMinus + local nPos := ::Pos + local nMinus DEFAULT lDisplay TO .t. - if nPos > 1 .and. nPos == ::FirstEditable() .and. ::minus - /* For delete the parethesis (negative indicator) in a non editable position */ + if nPos > 1 .and. nPos == ::FirstEditable() .and. ::lMinus - nMinus := At( "(", SubStr( ::buffer, 1, nPos-1 ) ) + /* To 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 ) + ::Buffer := SubStr( ::Buffer, 1, nMinus - 1 ) + " " +; + SubStr( ::Buffer, nMinus + 1 ) - ::Changed = .t. - // ::Assign() + ::Changed := .t. if lDisplay ::Display() @@ -1377,7 +1273,7 @@ METHOD BackSpace( lDisplay ) CLASS Get return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD _Delete( lDisplay ) CLASS Get @@ -1392,28 +1288,27 @@ METHOD _Delete( lDisplay ) CLASS Get // Calculating diferent nMaxLen for ::lPicComplex for n := ::Pos to nMaxLen if !::IsEditable( n ) - exit + exit endif next nMaxLen := n - 1 endif - if ::cType == "N" .and. SubStr( ::buffer, ::Pos, 1 ) $ "(-" - ::minus := .f. + if ::cType == "N" .and. SubStr( ::Buffer, ::Pos, 1 ) $ "(-" + ::lMinus := .f. endif - ::buffer := PadR( SubStr( ::buffer, 1, ::Pos - 1 ) + ; - SubStr( ::buffer, ::Pos + 1, nMaxLen - ::Pos ) + " " +; - SubStr( ::buffer, nMaxLen + 1 ), ::nMaxLen ) + ::Buffer := PadR( SubStr( ::Buffer, 1, ::Pos - 1 ) + ; + SubStr( ::Buffer, ::Pos + 1, nMaxLen - ::Pos ) + " " +; + SubStr( ::Buffer, nMaxLen + 1 ), ::nMaxLen ) if ::cType == "D" - ::BadDate := IsBadDate( ::buffer, ::cPicFunc ) + ::BadDate := IsBadDate( ::Buffer, ::cPicFunc ) else ::BadDate := .f. endif - ::Changed = .t. - // ::Assign() + ::Changed := .t. if lDisplay ::Display() @@ -1421,7 +1316,7 @@ METHOD _Delete( lDisplay ) CLASS Get return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD DeleteAll() CLASS Get @@ -1434,7 +1329,7 @@ METHOD DeleteAll() CLASS Get xValue := Space( ::nMaxlen ) case ::cType == "N" xValue := 0 - ::minus := .f. + ::lMinus := .f. case ::cType == "D" xValue := CToD( "" ) ::BadDate := .f. @@ -1442,19 +1337,18 @@ METHOD DeleteAll() CLASS Get xValue := .f. endcase - ::buffer := ::PutMask( xValue, .t. ) - ::Pos := ::FirstEditable( ) - // ::Assign() + ::Buffer := ::PutMask( xValue, .t. ) + ::Pos := ::FirstEditable() return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD DelEnd() CLASS Get local nPos := ::Pos - if ! ::hasfocus + if ! ::HasFocus return Self endif @@ -1469,7 +1363,7 @@ METHOD DelEnd() CLASS Get return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD DelLeft() CLASS Get @@ -1479,7 +1373,7 @@ METHOD DelLeft() CLASS Get return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD DelRight() CLASS Get @@ -1489,16 +1383,19 @@ METHOD DelRight() CLASS Get return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ + +/* NOTE ::WordLeft() + ::DelWordRight() */ METHOD DelWordLeft() CLASS Get - if ! ::hasfocus + if ! ::HasFocus return Self endif - if !( SubStr( ::buffer, ::Pos, 1 ) == " " ) - if SubStr( ::buffer, ::Pos - 1 , 1 ) == " " + if !( SubStr( ::Buffer, ::Pos, 1 ) == " " ) + if SubStr( ::Buffer, ::Pos - 1, 1 ) == " " ::BackSpace( .f. ) else ::WordRight() @@ -1506,37 +1403,37 @@ METHOD DelWordLeft() CLASS Get endif endif - if SubStr( ::buffer, ::Pos, 1 ) == " " + if SubStr( ::Buffer, ::Pos, 1 ) == " " ::Delete( .f. ) endif - do while ::Pos > 1 .and. !( SubStr( ::buffer, ::Pos - 1, 1 ) == " " ) + do while ::Pos > 1 .and. !( SubStr( ::Buffer, ::Pos - 1, 1 ) == " " ) ::BackSpace( .f. ) - Enddo + enddo ::Display() return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD DelWordRight() CLASS Get - if ! ::hasfocus + if ! ::HasFocus return Self endif ::TypeOut := .f. ::Clear := .f. - if ::pos == ::nMaxEdit + if ::Pos == ::nMaxEdit ::TypeOut := .t. return Self endif - do while ::Pos <= ::nMaxEdit .and. !( SubStr( ::buffer, ::Pos, 1 ) == " " ) + do while ::Pos <= ::nMaxEdit .and. !( SubStr( ::Buffer, ::Pos, 1 ) == " " ) ::Delete( .f. ) - Enddo + enddo if ::Pos <= ::nMaxEdit ::Delete( .f. ) @@ -1546,7 +1443,7 @@ METHOD DelWordRight() CLASS Get return Self -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ /* The METHOD ColorSpec and DATA cColorSpec allow to replace the * property ColorSpec for a function to control the content and @@ -1557,7 +1454,8 @@ return Self METHOD ColorSpec( cColorSpec ) CLASS Get - local cClrUnSel, cClrEnh + local cClrUnSel + local cClrEnh if cColorSpec != NIL @@ -1569,13 +1467,13 @@ METHOD ColorSpec( cColorSpec ) CLASS Get hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ),; cClrUnSel ) - ::cColorSpec := cClrUnSel + ", " + cClrEnh + ::cColorSpec := cClrUnSel + "," + cClrEnh endif return ::cColorSpec -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ /* The METHOD Picture and DATA cPicture allow to replace the * property Picture for a function to control the content and @@ -1587,14 +1485,144 @@ return ::cColorSpec METHOD Picture( cPicture ) CLASS Get + local cChar + local nAt + local nFor + local cNum + if cPicture != NIL ::nDispLen := NIL ::cPicture := cPicture - ::ParsePict( cPicture ) - ::buffer := ::PutMask() + cNum := "" + + if Left( cPicture, 1 ) == "@" + + nAt := At( " ", cPicture ) + + if nAt == 0 + ::cPicFunc := Upper( cPicture ) + ::cPicMask := "" + else + ::cPicFunc := Upper( SubStr( cPicture, 1, nAt - 1 ) ) + ::cPicMask := SubStr( cPicture, nAt + 1 ) + endif + + if "D" $ ::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 ) + endif + ::cPicFunc := SubStr( ::cPicFunc, 1, nAt - 1 ) + SubStr( ::cPicFunc, nFor ) + endif + + if "Z" $ ::cPicFunc + ::lCleanZero := .t. + else + ::lCleanZero := .f. + endif + ::cPicFunc := StrTran( ::cPicFunc, "Z", "" ) + + if ::cPicFunc == "@" + ::cPicFunc := "" + endif + else + ::cPicFunc := "" + ::cPicMask := cPicture + ::lCleanZero := .f. + endif + + if ::cType == NIL + ::Original := ::xVarGet + ::cType := ValType( ::Original ) + endif + + if ::cType == "D" + ::cPicMask := LTrim( ::cPicMask ) + endif + + // Comprobar si tiene la , y el . cambiado (Solo en Xbase++) + + ::lDecRev := "," $ Transform( 1.1, "9.9" ) + + // Generate default picture mask if not specified + + if Empty( ::cPicMask ) + + do case + case ::cType == "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" ) + + case ::cType == "N" + + cNum := Str( ::xVarGet ) + 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 + + case ::cType == "C" .and. ::cPicFunc == "@9" + ::cPicMask := Replicate( "9", Len( ::xVarGet ) ) + ::cPicFunc := "" + + endcase + + endif + + // Comprobar si tiene caracteres embebidos no modificables en la plantilla + + ::lPicComplex := .f. + + if ! Empty( ::cPicMask ) + for nFor := 1 to Len( ::cPicMask ) + cChar := SubStr( ::cPicMask, nFor, 1 ) + if !( cChar $ "!ANX9#" ) + ::lPicComplex := .t. + exit + endif + next + endif + + if ::HasFocus + if ::cType == "N" + ::DecPos := At( iif( ::lDecRev .or. "E" $ ::cPicFunc, ",", "." ), ; + Transform( 1, iif( Empty( ::cPicFunc ), "", ::cPicFunc + " " ) + ::cPicMask ) ) + if ::DecPos == 0 + ::DecPos := Len( ::Buffer ) + 1 + endif + else + ::DecPos := 0 // ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. + endif + endif if ::nDispLen == NIL ::nDispLen := ::nMaxLen @@ -1604,18 +1632,15 @@ METHOD Picture( cPicture ) CLASS Get return ::cPicture -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ METHOD Type() CLASS Get - if ::cType == NIL - ::Original := ::xVarGet - ::cType := ValType( ::Original ) - endif + ::cType := ValType( iif( ::HasFocus, ::xVarGet, ::VarGet() ) ) return ::cType -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ /* The METHOD Block and DATA bBlock allow to replace the * property Block for a function to control the content and @@ -1628,77 +1653,80 @@ return ::cType METHOD Block( bBlock ) CLASS Get - if bBlock != NIL .AND. !::HasFocus + if bBlock != NIL .and. !::HasFocus ::bBlock := bBlock - ::Original := ::xVarGet ::cType := ValType( ::Original ) - - ::Picture( ::Picture ) + ::xVarGet := NIL endif return ::bBlock -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ -METHOD HitTest(mrow,mcol) CLASS GET +#ifdef HB_COMPAT_C53 - if ::row != mrow +METHOD HitTest( nMRow, nMCol ) CLASS Get + + if ::Row != nMRow return HTNOWHERE endif - if mcol >= ::col .and. mcol <= ::col + ::ndispLen + iif( ::cDelimit == NIL, 0, 2 ) + if nMCol >= ::Col .and. ; + nMCol <= ::Col + ::nDispLen + iif( ::cDelimit == NIL, 0, 2 ) return HTCLIENT endif return HTNOWHERE -//---------------------------------------------------------------------------// +#endif -METHOD FirstEditable( ) CLASS GET +/* ------------------------------------------------------------------------- */ - Local nFor +METHOD FirstEditable() CLASS Get - If ::nMaxLen != NIL + local nFor - If ::IsEditable( 1 ) + if ::nMaxLen != NIL + + if ::IsEditable( 1 ) return 1 - Endif + endif - For nFor := 2 to ::nMaxLen - If ::IsEditable( nFor ) - Return nFor - Endif - Next + for nFor := 2 to ::nMaxLen + if ::IsEditable( nFor ) + return nFor + endif + next - Endif + endif ::TypeOut := .t. - Return 0 + return 0 -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ -METHOD LastEditable( ) CLASS GET +METHOD LastEditable() CLASS Get - Local nFor + local nFor - If ::nMaxLen != NIL + if ::nMaxLen != NIL - For nFor := ::nMaxLen to 1 step -1 - If ::IsEditable( nFor ) - Return nFor - Endif - Next + for nFor := ::nMaxLen to 1 step -1 + if ::IsEditable( nFor ) + return nFor + endif + next - Endif + endif ::TypeOut := .t. - Return 0 + return 0 -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ STATIC FUNCTION IsBadDate( cBuffer, cPicFunc ) @@ -1708,18 +1736,18 @@ STATIC FUNCTION IsBadDate( cBuffer, cPicFunc ) cBuffer := SubStr( cBuffer, 4, 3 ) + SubStr( cBuffer, 1, 3 ) + SubStr( cBuffer, 7 ) endif - If cBuffer == nil .or. ! Empty( Ctod( cBuffer ) ) + if cBuffer == NIL .or. ! Empty( CToD( cBuffer ) ) return .f. - Endif + endif - nLen := len( cBuffer ) + nLen := Len( cBuffer ) - For nFor := 1 to nLen - If IsDigit( Substr( cBuffer, nFor, 1 ) ) + for nFor := 1 to nLen + if IsDigit( SubStr( cBuffer, nFor, 1 ) ) return .t. - Endif - Next + endif + next return .f. -//---------------------------------------------------------------------------// +/* ------------------------------------------------------------------------- */ diff --git a/harbour/tests/Makefile b/harbour/tests/Makefile index e043dd87db..e201cc01e3 100644 --- a/harbour/tests/Makefile +++ b/harbour/tests/Makefile @@ -103,6 +103,7 @@ PRG_SOURCES=\ readhrb.prg \ recursiv.prg \ returns.prg \ + rto_get.prg \ round.prg \ say.prg \ scroll.prg \ diff --git a/harbour/tests/rto_get.prg b/harbour/tests/rto_get.prg new file mode 100644 index 0000000000..6dfb2e68ca --- /dev/null +++ b/harbour/tests/rto_get.prg @@ -0,0 +1,330 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Regression tests for class Get + * + * Copyright 1999-2007 Viktor Szakats + * 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. + * + */ + +/* NOTE: This source can be compiled with both Harbour and CA-Cl*pper. */ + +#include "fileio.ch" + +#ifndef __HARBOUR__ + #define HB_OSNewLine() ( Chr( 13 ) + Chr( 10 ) ) +#endif + +#translate TEST_LINE( ) => TEST_CALL( o, #, {|| } ) + +STATIC s_cTest := "" +STATIC s_xVar := NIL +STATIC s_fhnd + +FUNCTION Main() + LOCAL nInt01 := 98 + LOCAL nStr01 := "AbC DeF 974" + + LOCAL bOldBlock + LOCAL o + + #ifdef __HARBOUR__ + s_fhnd := FCreate( "tget_hb.txt", FC_NORMAL ) + #else + s_fhnd := FCreate( "tget_cl5.txt", FC_NORMAL ) + #endif + + IF s_fhnd == F_ERROR + RETURN 1 + ENDIF + + // ; Type change N -> C + + SetPos( 14, 14 ) + o := _GET_( nInt01, "nInt01",,, ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:KillFocus() ) + TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, nStr01, nStr01 := h ) } ) + TEST_LINE( o:SetFocus() ) + + // ; Reform + + SetPos( 14, 14 ) + o := _GET_( nStr01, "nStr01",,, ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:picture := "!!!!!!!!" ) + TEST_LINE( o:Reform() ) + TEST_LINE( o:KillFocus() ) + TEST_LINE( o:picture := "!!!!AAAA" ) + TEST_LINE( o:Reform() ) + + // ; Minus + + SetPos( 14, 14 ) + o := _GET_( nInt01, "nInt01",,, ) + TEST_LINE( GET_CREATE() ) + bOldBlock := o:block + TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:insert("-") ) + TEST_LINE( o:KillFocus() ) + TEST_LINE( o:SetFocus() ) + o:minus := .T. + TEST_LINE( o:SetFocus() ) + + // ; Exercises + + TGetTest( 98, NIL ) + TGetTest( 98, "99999.99" ) + TGetTest( -98, NIL ) + TGetTest( -98, "99999.99" ) + TGetTest( "hello world", NIL ) + TGetTest( "hello world", "@!" ) + TGetTest( "hello world", "!!!" ) + TGetTest( "hello world", "@S5" ) + + FClose( s_fhnd ) + + RETURN 0 + +PROCEDURE TGetTest( xVar, cPic ) + LOCAL bOldBlock + LOCAL o + + s_xVar := xVar + + // ; In focus + + s_cTest := "InFocus Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic ) + + SetPos( 14, 14 ) + o := _GET_( s_xVar, "s_xVar",,, ) + TEST_LINE( GET_CREATE() ) + bOldBlock := o:block + TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) + TEST_LINE( o:SetFocus() ) + IF cPic != NIL + TEST_LINE( o:picture := cPic ) + TEST_LINE( o:picture := NIL ) + ENDIF + TEST_LINE( o:UpdateBuffer() ) + TEST_LINE( o:UpdateBuffer() ) + TEST_LINE( o:Reform() ) + TEST_LINE( o:Display() ) + TEST_LINE( o:KillFocus() ) + + // ; Not in focus + + s_cTest := "NotFocus Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic ) + + SetPos( 14, 14 ) + o := _GET_( s_xVar, "s_xVar",,, ) + TEST_LINE( GET_CREATE() ) + bOldBlock := o:block + TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) + IF cPic != NIL + TEST_LINE( o:picture := cPic ) + TEST_LINE( o:picture := NIL ) + ENDIF + TEST_LINE( o:UpdateBuffer() ) + TEST_LINE( o:UpdateBuffer() ) + TEST_LINE( o:Reform() ) + TEST_LINE( o:Display() ) + TEST_LINE( o:KillFocus() ) + + // ; In Focus editing + + s_cTest := "InFocus #2 Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic ) + + SetPos( 14, 14 ) + o := _GET_( s_xVar, "s_xVar",,, ) + bOldBlock := o:block + TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Insert( "6" ) ) + TEST_LINE( o:Undo(.T.) ) + TEST_LINE( o:Insert( "5" ) ) + TEST_LINE( o:Assign() ) + TEST_LINE( o:Reset() ) + TEST_LINE( o:KillFocus() ) + TEST_LINE( o:VarPut( "newvalue " ) ) + TEST_LINE( o:Insert( "7" ) ) + TEST_LINE( o:Undo(.T.) ) + TEST_LINE( o:Assign() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Insert( "3" ) ) + TEST_LINE( o:Undo(.T.) ) + TEST_LINE( o:KillFocus() ) + TEST_LINE( o:VarPut( 0 ) ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Insert( "3" ) ) + TEST_LINE( o:Undo(.T.) ) + TEST_LINE( o:KillFocus() ) + + // ; + + s_cTest := "" + + RETURN + +PROCEDURE TEST_CALL( o, cBlock, bBlock ) + LOCAL xRetVal := Eval( bBlock ) + + LogGETVars( o, cBlock, xRetVal ) + + RETURN + +PROCEDURE LogMe( data, desc ) + LOCAL nLevel + LOCAL cStack + + cStack := "" + FOR nLevel := 2 TO 2 + IF Empty( ProcName( nLevel ) ) + EXIT + ENDIF + cStack += ProcName( nLevel ) + " (" + LTrim( Str( ProcLine( nLevel ) ) ) + ") " + NEXT + + IF desc == NIL + desc := "" + ENDIF + desc := s_cTest + " " + desc + + cStack := "" + + IF PCount() > 2 + FWrite( s_fhnd, cStack + "BLOCK_SET " + iif( data == NIL, "NIL", data ) + " " + desc + HB_OSNewLine() ) + ELSE + FWrite( s_fhnd, cStack + "BLOCK_GET " + desc + HB_OSNewLine() ) + ENDIF + + RETURN + +PROCEDURE LogGETVars( o, desc, xRetVal ) + LOCAL nLevel + LOCAL cStack + + cStack := "" + FOR nLevel := 2 TO 2 + IF Empty( ProcName( nLevel ) ) + EXIT + ENDIF + cStack += ProcName( nLevel ) + " (" + LTrim( Str( ProcLine( nLevel ) ) ) + ") " + NEXT + + IF desc == NIL + desc := "" + ENDIF + desc := s_cTest + " " + XToStr( desc ) + + FWrite( s_fhnd, cStack + " " + desc + HB_OSNewLine() ) + FWrite( s_fhnd, "---------------------" + HB_OSNewLine() ) + FWrite( s_fhnd, " s_xVar " + XToStr( s_xVar ) + HB_OSNewLine() ) + FWrite( s_fhnd, " xRetVal " + XToStr( xRetVal ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Row() " + XToStr( Row() ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Col() " + XToStr( Col() ) + HB_OSNewLine() ) + FWrite( s_fhnd, " BadDate " + XToStr( o:BadDate ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Block " + XToStr( o:Block ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Buffer " + XToStr( o:Buffer ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Cargo " + XToStr( o:Cargo ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Changed " + XToStr( o:Changed ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Clear " + XToStr( o:Clear ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Col " + XToStr( o:Col ) + HB_OSNewLine() ) + FWrite( s_fhnd, " ColorSpec " + XToStr( o:ColorSpec ) + HB_OSNewLine() ) + FWrite( s_fhnd, " DecPos " + XToStr( o:DecPos ) + HB_OSNewLine() ) + FWrite( s_fhnd, " ExitState " + XToStr( o:ExitState ) + HB_OSNewLine() ) + FWrite( s_fhnd, " HasFocus " + XToStr( o:HasFocus ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Minus " + XToStr( o:Minus ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Name " + XToStr( o:Name ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Original " + XToStr( o:Original ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Picture " + XToStr( o:Picture ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Pos " + XToStr( o:Pos ) + HB_OSNewLine() ) + FWrite( s_fhnd, " PostBlock " + XToStr( o:PostBlock ) + HB_OSNewLine() ) + FWrite( s_fhnd, " PreBlock " + XToStr( o:PreBlock ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Reader " + XToStr( o:Reader ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Rejected " + XToStr( o:Rejected ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Row " + XToStr( o:Row ) + HB_OSNewLine() ) + FWrite( s_fhnd, " SubScript " + XToStr( o:SubScript ) + HB_OSNewLine() ) + FWrite( s_fhnd, " Type " + XToStr( o:Type ) + HB_OSNewLine() ) + FWrite( s_fhnd, " TypeOut " + XToStr( o:TypeOut ) + HB_OSNewLine() ) + FWrite( s_fhnd, "---------------------" + HB_OSNewLine() ) + + RETURN + +FUNCTION XToStr( xValue ) + LOCAL cType := ValType( xValue ) + + DO CASE + CASE cType == "C" + + xValue := StrTran( xValue, Chr(0), '"+Chr(0)+"' ) + xValue := StrTran( xValue, Chr(9), '"+Chr(9)+"' ) + xValue := StrTran( xValue, Chr(10), '"+Chr(10)+"' ) + xValue := StrTran( xValue, Chr(13), '"+Chr(13)+"' ) + xValue := StrTran( xValue, Chr(26), '"+Chr(26)+"' ) + + RETURN '"' + xValue + '"' + + CASE cType == "N" ; RETURN LTrim( Str( xValue ) ) + CASE cType == "D" ; RETURN 'HB_SToD("' + DToS( xValue ) + '")' + CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." ) + CASE cType == "O" ; RETURN xValue:className() + " Object" + CASE cType == "U" ; RETURN "NIL" + CASE cType == "B" ; RETURN '{||...}' + CASE cType == "A" ; RETURN '{.[' + LTrim( Str( Len( xValue ) ) ) + '].}' + CASE cType == "M" ; RETURN 'M:"' + xValue + '"' + ENDCASE + + RETURN "" + +PROCEDURE GET_CREATE() + + // ; Dummy + + RETURN