diff --git a/harbour/ChangeLog b/harbour/ChangeLog index cb0f55b284..9b73e9c004 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,43 @@ 2008-12-31 13:59 UTC+0100 Foo Bar */ +2008-05-28 11:48 UTC+0100 Viktor Szakats (harbour.01 syenar hu) + * source/rtl/tget.prg + ! Fixed ::unTransform() padding for strings with @R picture. + (Edmer Issue #1) + ! Fixed ::unTransform() to not use the "Chr( 1 )" hack to + remove certain chars from string. (there is still one such + remaining) + ! Fixed ::unTransform() padding with zero decimals for numerics. + This cleared some differences in rto_get.prg. + ! Fixed ::toDecPos() to not crash with non-numeric vars. + - Removed some XBase++ specific code which is not + needed for Harbour. + - Removed some other unnecessary code dealing with '.'/',' swapping. + % Minor cleanups. + ; WARNING! Please test these with real code, as we have no extensive + regression test suite for the above code parts. + + * tests/rto_get.prg + + Added some test cases (and counter test cases) for + problems reported by Edmer. + + * source/hbpcre/cnv_o2hb.bat + * source/hbpcre/cnv_hb2o.bat + ! Fix for potential s&r problem. + (not adapted to converted code yet) + + * contrib/xhb/Makefile + * contrib/xhb/common.mak + + contrib/xhb/xstrdel.c + + STRDEL() added from Walter Negro / xhb. + + * contrib/rddads/adsfunc.c + + Minor correction to HB_TRACE handling. + + * contrib/hbfimage/fi_winfu.c + % Removed unused var. + 2008-05-28 11:48 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbrdddbf.h * harbour/include/hbapirdd.h @@ -21,8 +58,8 @@ * harbour/contrib/hbbmcdx/bmdbfcdx1.c + added ULONG ulConnection parameter to DROP() and EXISTS() RDD node methods - + added 4-th parameter with ulConncetion index to [HB_]DROP() and - [HB_]EXISTS() functions + + added 4-th parameter with ulConncetion index to [HB_]DBDROP() and + [HB_]DBEXISTS() functions 2008-05-27 22:49 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/make_deb.sh diff --git a/harbour/contrib/hbfimage/fi_winfu.c b/harbour/contrib/hbfimage/fi_winfu.c index f01cdda29d..c6696168ba 100644 --- a/harbour/contrib/hbfimage/fi_winfu.c +++ b/harbour/contrib/hbfimage/fi_winfu.c @@ -148,16 +148,13 @@ HB_FUNC( FI_BITMAPTOFI ) if( bitmap ) { BITMAP bm; HDC hDC; - int Success; GetObject( bitmap, sizeof(BITMAP), (LPSTR) &bm ); dib = FreeImage_Allocate(bm.bmWidth, bm.bmHeight, bm.bmBitsPixel, 0, 0, 0); hDC = GetDC( NULL ); - Success = GetDIBits( hDC, bitmap, 0, FreeImage_GetHeight(dib), - FreeImage_GetBits(dib), FreeImage_GetInfo(dib), DIB_RGB_COLORS); + GetDIBits( hDC, bitmap, 0, FreeImage_GetHeight(dib), + FreeImage_GetBits(dib), FreeImage_GetInfo(dib), DIB_RGB_COLORS); ReleaseDC( NULL, hDC ); - - HB_SYMBOL_UNUSED( Success ); } /* return value */ diff --git a/harbour/contrib/rddads/adsfunc.c b/harbour/contrib/rddads/adsfunc.c index 21fdb17e5e..8e3be69cf0 100644 --- a/harbour/contrib/rddads/adsfunc.c +++ b/harbour/contrib/rddads/adsfunc.c @@ -1418,10 +1418,12 @@ UNSIGNED32 WINAPI hb_adsShowPercentageCB( UNSIGNED16 usPercentDone ) return fResult; } +#if HB_TR_LEVEL >= HB_TR_DEBUG else { HB_TRACE(HB_TR_DEBUG, ("hb_adsShowPercentageCB(%d) called with no codeblock set.\n", usPercentDone )); } +#endif return 0; } diff --git a/harbour/contrib/xhb/Makefile b/harbour/contrib/xhb/Makefile index 5333232d7a..694f76bfe8 100644 --- a/harbour/contrib/xhb/Makefile +++ b/harbour/contrib/xhb/Makefile @@ -16,6 +16,7 @@ C_SOURCES=\ xhbwith.c \ hbcomprs.c \ hbchksum.c \ + xstrdel.c \ C_HEADERS=\ hbcompat.h \ diff --git a/harbour/contrib/xhb/common.mak b/harbour/contrib/xhb/common.mak index 4407e26cf7..913a5ba1f8 100644 --- a/harbour/contrib/xhb/common.mak +++ b/harbour/contrib/xhb/common.mak @@ -35,6 +35,7 @@ LIB_OBJS = \ $(OBJ_DIR)xhbwith$(OBJEXT) \ $(OBJ_DIR)hbcomprs$(OBJEXT) \ $(OBJ_DIR)hbchksum$(OBJEXT) \ + $(OBJ_DIR)xstrdel$(OBJEXT) \ \ $(OBJ_DIR)txml$(OBJEXT) \ $(OBJ_DIR)hblog$(OBJEXT) \ diff --git a/harbour/contrib/xhb/xstrdel.c b/harbour/contrib/xhb/xstrdel.c new file mode 100644 index 0000000000..ddb1c6f8ad --- /dev/null +++ b/harbour/contrib/xhb/xstrdel.c @@ -0,0 +1,96 @@ +/* + * $Id$ + */ + +/* + * xHarbour Project source code: + * STRDEL() function + * + * Copyright 2003 Walter Negro + * www - http://www.xharbour.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 xHarbour Project gives permission for + * additional uses of the text contained in its release of xHarbour. + * + * The exception is that, if you link the xHarbour 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 xHarbour + * Project under the name xHarbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * xHarbour, 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 "hbapi.h" + +/* replaces characters in a string */ +HB_FUNC( STRDEL ) +{ + if( ISCHAR( 1 ) && ISCHAR( 2 ) ) + { + char * szText = hb_parcx( 1 ); + ULONG ulText = hb_parclen( 1 ); + ULONG ulDel = hb_parclen( 2 ); + + if( ulDel > 0 && ulText > 0 ) + { + char * szDel = hb_parcx( 2 ); + ULONG ulPosTxt = 0; + ULONG ulResult = 0; + ULONG ulPosDel = 0; + char * szResult = ( char * ) hb_xgrab( ulText + 1 ); + + for( ; ( ulPosDel < ulText && ulPosDel < ulDel ); ulPosDel++ ) + { + if( szDel[ ulPosDel ] != ' ' ) + { + hb_xmemcpy( szResult + ulResult, szText + ulPosTxt, ulPosDel - ulPosTxt ); + ulResult += ulPosDel - ulPosTxt; + ulPosTxt = ulPosDel + 1; + } + } + hb_xmemcpy( szResult + ulResult, szText + ulPosTxt, ulText - ulPosTxt ); + ulResult += ulText - ulPosTxt; + + szResult[ ulResult ] = '\0'; + hb_retclenAdopt( szResult, ulResult ); + } + else + { + hb_retc( szText ); + } + } + else + { + hb_retc( "" ); + } +} diff --git a/harbour/source/hbpcre/cnv_hb2o.bat b/harbour/source/hbpcre/cnv_hb2o.bat index 10677367f0..3aa1b40b4c 100644 --- a/harbour/source/hbpcre/cnv_hb2o.bat +++ b/harbour/source/hbpcre/cnv_hb2o.bat @@ -54,6 +54,7 @@ gsar -o -s":x22pcreinal.h:x22" -r":x22pcre_internal.h:x22" *.* gsar -o -s":x22ucpinter.h:x22" -r":x22ucpinternal.h:x22" *.* gsar -o -s":x22_hbconf.h:x22" -r":x22config.h:x22" *.* gsar -o -s":x22pcreprni.h:x22" -r":x22pcre_printint.src:x22" *.* +gsar -o -s"if 2875" -r"ifdef HAVE_CONFIG_H" *.* gsar -o -s"if 1" -r"ifdef HAVE_CONFIG_H" *.* cd .. diff --git a/harbour/source/hbpcre/cnv_o2hb.bat b/harbour/source/hbpcre/cnv_o2hb.bat index 5212e68b08..4307e52246 100644 --- a/harbour/source/hbpcre/cnv_o2hb.bat +++ b/harbour/source/hbpcre/cnv_o2hb.bat @@ -67,4 +67,4 @@ gsar -o -s":x22ucpinternal.h:x22" -r":x22ucpinter.h:x22" *.h gsar -o -s":x22config.h:x22" -r":x22_hbconf.h:x22" *.c gsar -o -s":x22config.h:x22" -r":x22_hbconf.h:x22" *.h gsar -o -s":x22_hbconf.h:x22" -r":x22config.h:x22" _hbconf.h -gsar -o -s"ifdef HAVE_CONFIG_H" -r"if 1" *.c +gsar -o -s"ifdef HAVE_CONFIG_H" -r"if 2875" *.c diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index e287ac8e84..b4050d20b5 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -209,7 +209,6 @@ CREATE CLASS Get VAR cPicMask INIT "" VAR cPicFunc INIT "" VAR lPicComplex INIT .F. - VAR lPicDecRev INIT .F. VAR lPicBlankZero INIT .F. METHOD leftLow() @@ -229,7 +228,7 @@ ENDCLASS METHOD assign() CLASS Get IF ::hasFocus - ::varPut( ::UnTransform() ) + ::varPut( ::unTransform() ) ENDIF RETURN Self @@ -400,7 +399,7 @@ METHOD reset() CLASS Get ::lEdit := .F. ::lMinus := .F. ::rejected := .F. - ::typeOut := !( ::Type $ "CNDL" ) .OR. ( ::nPos == 0 ) /* ; Simple .F. in CA-Cl*pper [vszakats] */ + ::typeOut := !( ::type $ "CNDL" ) .OR. ( ::nPos == 0 ) /* ; Simple .F. in CA-Cl*pper [vszakats] */ ::display() ENDIF @@ -443,7 +442,7 @@ METHOD setFocus() CLASS Get ::lMinus := .F. IF ::cType == "N" - ::decPos := At( iif( ::lPicDecRev .OR. "E" $ ::cPicFunc, ",", "." ), ::cBuffer ) + ::decPos := At( iif( "E" $ ::cPicFunc, ",", "." ), ::cBuffer ) IF ::decPos == 0 ::decPos := Len( ::cBuffer ) + 1 ENDIF @@ -544,117 +543,130 @@ METHOD unTransform() CLASS Get LOCAL xValue LOCAL nFor LOCAL lMinus + LOCAL lHasDec IF ::hasFocus cBuffer := ::cBuffer - IF ! ISCHARACTER( cBuffer ) + IF ISCHARACTER( cBuffer ) + + DO CASE + CASE ::cType == "C" + + IF "R" $ ::cPicFunc + xValue := "" + FOR nFor := 1 TO Len( ::cPicMask ) + IF SubStr( ::cPicMask, nFor, 1 ) $ "ANX9#!LY" + xValue += SubStr( cBuffer, nFor, 1 ) + ENDIF + NEXT + ELSE + xValue := cBuffer + ENDIF + + CASE ::cType == "N" + + lMinus := .F. + IF "X" $ ::cPicFunc + IF Right( cBuffer, 2 ) == "DB" + lMinus := .T. + ENDIF + ENDIF + 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 ) ) + lMinus := .T. + EXIT + ENDIF + NEXT + ENDIF + cBuffer := Space( ::FirstEditable() - 1 ) + SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 ) + + IF "D" $ ::cPicFunc + FOR nFor := ::FirstEditable() TO ::LastEditable() + IF !::IsEditable( nFor ) + cBuffer := Left( cBuffer, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 ) + ENDIF + NEXT + ELSE + IF "E" $ ::cPicFunc + cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) +; + StrTran( 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 ) + ENDIF + + lHasDec := .F. + FOR nFor := ::FirstEditable() TO ::LastEditable() + IF ::IsEditable( nFor ) + IF lHasDec .AND. SubStr( cBuffer, nFor, 1 ) == " " + cBuffer := Left( cBuffer, nFor - 1 ) + "0" + SubStr( cBuffer, nFor + 1 ) + ENDIF + ELSE + IF SubStr( cBuffer, nFor, 1 ) == "." + lHasDec := .T. + ELSE + cBuffer := Left( cBuffer, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 ) + ENDIF + ENDIF + NEXT + ENDIF + + cBuffer := StrTran( cBuffer, Chr( 1 ), "" ) + + cBuffer := StrTran( cBuffer, "$", " " ) + cBuffer := StrTran( cBuffer, "*", " " ) + cBuffer := StrTran( cBuffer, "-", " " ) + cBuffer := StrTran( cBuffer, "(", " " ) + cBuffer := StrTran( cBuffer, ")", " " ) + + cBuffer := PadL( StrTran( cBuffer, " ", "" ), Len( cBuffer ) ) + + IF lMinus + FOR nFor := 1 TO Len( cBuffer ) + IF IsDigit( SubStr( cBuffer, nFor, 1 ) ) .OR. SubStr( cBuffer, nFor, 1 ) == "." + EXIT + ENDIF + NEXT + nFor-- + IF nFor > 0 + cBuffer := Left( cBuffer, nFor - 1 ) + "-" + SubStr( cBuffer, nFor + 1 ) + ELSE + cBuffer := "-" + cBuffer + ENDIF + ENDIF + + xValue := Val( cBuffer ) + + CASE ::cType == "L" + + cBuffer := Upper( 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 + xValue := CToD( cBuffer ) + + ENDCASE + + ELSE ::lClear := .F. ::decPos := 0 ::nPos := 0 ::typeOut := .F. - RETURN NIL ENDIF - - DO CASE - CASE ::cType == "C" - - IF "R" $ ::cPicFunc - FOR nFor := 1 TO Len( ::cPicMask ) - IF !SubStr( ::cPicMask, nFor, 1 ) $ "ANX9#!LY" - cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 ) - ENDIF - NEXT - xValue := PadR( StrTran( cBuffer, Chr( 1 ), "" ), Len( ::original ) ) - ELSE - xValue := cBuffer - ENDIF - - CASE ::cType == "N" - - lMinus := .F. - IF "X" $ ::cPicFunc - IF Right( cBuffer, 2 ) == "DB" - lMinus := .T. - ENDIF - ENDIF - 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 ) ) - lMinus := .T. - EXIT - ENDIF - NEXT - ENDIF - cBuffer := Space( ::FirstEditable() - 1 ) + SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 ) - - IF "D" $ ::cPicFunc - FOR nFor := ::FirstEditable() TO ::LastEditable() - IF !::IsEditable( nFor ) - cBuffer := Left( cBuffer, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 ) - ENDIF - NEXT - ELSE - IF "E" $ ::cPicFunc .OR. ::lPicDecRev - cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) +; - StrTran( 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 ) - ENDIF - - FOR nFor := ::FirstEditable() TO ::LastEditable() - IF !::IsEditable( nFor ) .AND. !( SubStr( cBuffer, nFor, 1 ) == "." ) - cBuffer := Left( cBuffer, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 ) - ENDIF - NEXT - ENDIF - - cBuffer := StrTran( cBuffer, Chr( 1 ), "" ) - - cBuffer := StrTran( cBuffer, "$", " " ) - cBuffer := StrTran( cBuffer, "*", " " ) - cBuffer := StrTran( cBuffer, "-", " " ) - cBuffer := StrTran( cBuffer, "(", " " ) - cBuffer := StrTran( cBuffer, ")", " " ) - - cBuffer := PadL( StrTran( cBuffer, " ", "" ), Len( cBuffer ) ) - - IF lMinus - FOR nFor := 1 TO Len( cBuffer ) - IF IsDigit( SubStr( cBuffer, nFor, 1 ) ) .OR. SubStr( cBuffer, nFor, 1 ) == "." - EXIT - ENDIF - NEXT - nFor-- - IF nFor > 0 - cBuffer := Left( cBuffer, nFor - 1 ) + "-" + SubStr( cBuffer, nFor + 1 ) - ELSE - cBuffer := "-" + cBuffer - ENDIF - ENDIF - - xValue := Val( cBuffer ) - - CASE ::cType == "L" - - cBuffer := Upper( 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 - xValue := CToD( cBuffer ) - - ENDCASE ENDIF RETURN xValue @@ -898,11 +910,11 @@ METHOD toDecPos() CLASS Get ::delEnd() ENDIF - ::cBuffer := ::PutMask( ::UnTransform(), .F. ) + ::cBuffer := ::PutMask( ::unTransform(), .F. ) ::pos := ::decPos ::lChanged := .T. - IF ::UnTransform() == 0 .AND. ::lMinus + IF ::type == "N" .AND. ::lMinus .AND. ::unTransform() == 0 ::backSpace() ::overStrike("-") ENDIF @@ -1153,7 +1165,6 @@ METHOD picture( cPicture ) CLASS Get ::cPicFunc := "" ::cPicMask := "" ::lPicComplex := .F. - ::lPicDecRev := .F. ::lPicBlankZero := .F. IF ISCHARACTER( cPicture ) @@ -1200,24 +1211,19 @@ METHOD picture( cPicture ) CLASS Get IF "Z" $ ::cPicFunc ::lPicBlankZero := .T. + ::cPicFunc := StrTran( ::cPicFunc, "Z", "" ) ENDIF - ::cPicFunc := StrTran( ::cPicFunc, "Z", "" ) IF ::cPicFunc == "@" ::cPicFunc := "" ENDIF ELSE - ::cPicFunc := "" ::cPicMask := cPicture ENDIF IF ::cType == "D" ::cPicMask := LTrim( ::cPicMask ) ENDIF - - /* Comprobar si tiene la , y el . cambiado (Solo en Xbase++) */ - - ::lPicDecRev := "," $ Transform( 1.1, "9.9" ) ENDIF ENDIF @@ -1239,8 +1245,8 @@ METHOD picture( cPicture ) CLASS Get CASE ::cType == "N" cNum := Str( ::xVarGet ) - IF ( nAt := At( iif( ::lPicDecRev, ",", "." ), cNum ) ) > 0 - ::cPicMask := Replicate( "9", nAt - 1 ) + iif( ::lPicDecRev, ",", "." ) + IF ( nAt := At( ".", cNum ) ) > 0 + ::cPicMask := Replicate( "9", nAt - 1 ) + "." ::cPicMask += Replicate( "9", Len( cNum ) - Len( ::cPicMask ) ) ELSE ::cPicMask := Replicate( "9", Len( cNum ) ) @@ -1255,7 +1261,7 @@ METHOD picture( cPicture ) CLASS Get ENDIF - /* Comprobar si tiene caracteres embebidos no modificables en la plantilla. */ + /* To verify if it has non-modifiable embedded characters in the group. */ IF ! Empty( ::cPicMask ) FOR nFor := 1 TO Len( ::cPicMask ) @@ -1336,8 +1342,8 @@ METHOD badDate() CLASS Get LOCAL xValue RETURN ::hasFocus .AND. ; - ::Type == "D" .AND. ; - ( xValue := ::UnTransform() ) == hb_SToD( "" ) .AND. ; + ::type == "D" .AND. ; + ( xValue := ::unTransform() ) == hb_SToD( "" ) .AND. ; !( ::cBuffer == Transform( xValue, ::cPicture ) ) #ifdef HB_C52_UNDOC @@ -1345,7 +1351,7 @@ METHOD badDate() CLASS Get METHOD reform() CLASS Get IF ::hasFocus - ::cBuffer := ::PutMask( ::UnTransform(), .F. ) + ::cBuffer := ::PutMask( ::unTransform(), .F. ) ::nDispLen := iif( ::nPicLen == NIL, ::nMaxLen, ::nPicLen ) // ; ? ENDIF @@ -1573,7 +1579,7 @@ METHOD DeleteAll() CLASS Get xValue := .F. ENDCASE - ::cBuffer := ::PutMask( xValue, .T. ) + ::cBuffer := ::PutMask( xValue ) ::pos := ::FirstEditable() ENDIF @@ -1733,8 +1739,8 @@ METHOD PutMask( xValue, lEdit ) CLASS Get cBuffer := Transform( xValue, ; iif( Empty( cPicFunc ), ; - iif( ::lPicBlankZero .AND. !::hasFocus, "@Z ", "" ), ; - cPicFunc + iif( ::lPicBlankZero .AND. !::hasFocus, "Z", "" ) + " " ) ; + iif( ::lPicBlankZero .AND. !::hasFocus, "@Z ", "" ), ; + cPicFunc + iif( ::lPicBlankZero .AND. !::hasFocus, "Z" , "" ) + " " ) ; + cPicMask ) IF ::cType == "N" @@ -1755,25 +1761,15 @@ METHOD PutMask( xValue, lEdit ) CLASS Get ::nMaxEdit := ::nMaxLen IF lEdit .AND. ::cType == "N" .AND. ! Empty( cPicMask ) - IF "E" $ cPicFunc - cPicMask := Left( cPicMask, ::FirstEditable() - 1 ) + StrTran( SubStr( cPicMask, ::FirstEditable(), ::LastEditable() - ::FirstEditable( ) + 1 ), ",", Chr( 1 ) ) + SubStr( cPicMask, ::LastEditable() + 1 ) - cPicMask := Left( cPicMask, ::FirstEditable() - 1 ) + StrTran( SubStr( cPicMask, ::FirstEditable(), ::LastEditable() - ::FirstEditable( ) + 1 ), ".", "," ) + SubStr( cPicMask, ::LastEditable() + 1 ) - cPicMask := Left( cPicMask, ::FirstEditable() - 1 ) + StrTran( SubStr( cPicMask, ::FirstEditable(), ::LastEditable() - ::FirstEditable( ) + 1 ), Chr( 1 ), "." ) + SubStr( cPicMask, ::LastEditable() + 1 ) - ENDIF FOR nFor := 1 TO ::nMaxLen cChar := SubStr( cPicMask, nFor, 1 ) - IF cChar $ ",." .AND. SubStr( cBuffer, nFor, 1 ) $ ",." + IF cChar $ ",." .AND. SubStr( cBuffer, nFor, 1 ) $ ",." // " " TOFIX cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + cChar + SubStr( cBuffer, nFor + 1 ) ENDIF NEXT IF ::lEdit .AND. Empty( xValue ) cBuffer := StrTran( cBuffer, "0", " " ) ENDIF - IF ::lPicDecRev - 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 == "N" diff --git a/harbour/tests/rto_get.prg b/harbour/tests/rto_get.prg index 167ad8345a..78529ffbbc 100644 --- a/harbour/tests/rto_get.prg +++ b/harbour/tests/rto_get.prg @@ -72,12 +72,14 @@ STATIC s_lObjectDump FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) LOCAL uNIL := NIL LOCAL nInt01 := 98 + LOCAL nInt02 := 0 LOCAL cStr01 := "AbC DF 974" LOCAL cStr02E := "" LOCAL cStr03 := "" LOCAL cStr04 := "" LOCAL cStr05 := "" LOCAL cStr06 := "" + LOCAL cStr07 := "" #ifdef NULL LOCAL dDate01 #endif @@ -274,6 +276,95 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) TEST_LINE( o:OverStrike( "z" ) ) TEST_LINE( o:Assign() ) + // ; Edmer #1 + + cStr07 := Space(10) + SetPos( 14, 16 ) ; o := _GET_( cStr07, "cStr07", "@R 999 9999 999999",, ) + o:display() + o:setFocus() + TGetTOVS( o, "1231234123456" ) +/* + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:OverStrike( "2" ) ) + TEST_LINE( o:OverStrike( "3" ) ) + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:OverStrike( "2" ) ) + TEST_LINE( o:OverStrike( "3" ) ) + TEST_LINE( o:OverStrike( "4" ) ) + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:OverStrike( "2" ) ) + TEST_LINE( o:OverStrike( "3" ) ) + TEST_LINE( o:OverStrike( "4" ) ) + TEST_LINE( o:OverStrike( "5" ) ) + TEST_LINE( o:OverStrike( "6" ) ) +*/ + TEST_LINE( o:Assign() ) + + cStr07 := Space(10) + SetPos( 14, 16 ) ; o := _GET_( cStr07, "cStr07", "@R 999 9999 999999",, ) + o:display() + o:setFocus() + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:OverStrike( "2" ) ) + TEST_LINE( o:OverStrike( "3" ) ) + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:OverStrike( "2" ) ) + TEST_LINE( o:OverStrike( "3" ) ) + TEST_LINE( o:OverStrike( "4" ) ) + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:OverStrike( "2" ) ) + TEST_LINE( o:OverStrike( "3" ) ) + TEST_LINE( o:OverStrike( "4" ) ) + TEST_LINE( o:OverStrike( "5" ) ) + TEST_LINE( o:OverStrike( "6" ) ) + TEST_LINE( o:Assign() ) + + cStr07 := Space(10) + SetPos( 14, 16 ) ; o := _GET_( cStr07, "cStr07", "@R 999 9999 999999",, ) + o:display() + o:setFocus() + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:OverStrike( "2" ) ) + TEST_LINE( o:OverStrike( "3" ) ) + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:OverStrike( "2" ) ) + TEST_LINE( o:OverStrike( "3" ) ) + TEST_LINE( o:OverStrike( "4" ) ) + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:OverStrike( "2" ) ) + TEST_LINE( o:OverStrike( "3" ) ) + TEST_LINE( o:OverStrike( "4" ) ) + TEST_LINE( o:OverStrike( "5" ) ) + TEST_LINE( o:OverStrike( "6" ) ) + TEST_LINE( o:Assign() ) + + // ; Edmer #2 + + nInt02 := 0 + SetPos( 14, 16 ) ; o := _GET_( nInt02, "nInt02", "9,999,999.99",, ) + o:display() + o:setFocus() + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:OverStrike( "2" ) ) + TEST_LINE( o:OverStrike( "3" ) ) + TEST_LINE( o:OverStrike( "4" ) ) + TEST_LINE( o:OverStrike( "5" ) ) + TEST_LINE( o:Assign() ) + + // ; + + nInt02 := 1234.56 + SetPos( 14, 16 ) ; o := _GET_( nInt02, "nInt02", "@Z 9999999.9999",, ) + o:display() + o:setFocus() + TEST_LINE( o:OverStrike( "0" ) ) + TEST_LINE( o:Assign() ) + TEST_LINE( o:reset() ) + TEST_LINE( o:OverStrike( "1" ) ) + TEST_LINE( o:Assign() ) + TEST_LINE( o:reset() ) + TEST_LINE( o:killFocus() ) + // ; Buffer s_xVar := "abcdefg" @@ -585,6 +676,24 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) RETURN 0 +PROCEDURE TGetTOVS( o, cKeys ) + LOCAL tmp + + FOR tmp := 1 TO Len( cKeys ) + TEST_CALL( o, "o:overStrike( '" + SubStr( cKeys, tmp, 1 ) + "' )", {|| o:overStrike( SubStr( cKeys, tmp, 1 ) ) } ) + NEXT + + RETURN + +PROCEDURE TGetTIns( o, cKeys ) + LOCAL tmp + + FOR tmp := 1 TO Len( cKeys ) + TEST_CALL( o, "o:insert( '" + SubStr( cKeys, tmp, 1 ) + "' )", {|| o:insert( SubStr( cKeys, tmp, 1 ) ) } ) + NEXT + + RETURN + PROCEDURE TGetAssign( xVar ) LOCAL o LOCAL nInt01 := 76