fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2008-05-28 11:48 UTC+0100 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* 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.
This commit is contained in:
Viktor Szakats
2008-05-28 10:19:43 +00:00
parent 2c051a4220
commit ceeff3c354
10 changed files with 382 additions and 142 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
harbour/ChangeLog
View File

@@ -8,6 +8,43 @@
2008-12-31 13:59 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
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

7
harbour/contrib/hbfimage/fi_winfu.c
View File

@@ -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 */

2
harbour/contrib/rddads/adsfunc.c
View File

@@ -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;
}

1
harbour/contrib/xhb/Makefile
View File

@@ -16,6 +16,7 @@ C_SOURCES=\
xhbwith.c \
hbcomprs.c \
hbchksum.c \
xstrdel.c \
C_HEADERS=\
hbcompat.h \

1
harbour/contrib/xhb/common.mak
View File

@@ -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) \

96
harbour/contrib/xhb/xstrdel.c Normal file
View File

@@ -0,0 +1,96 @@
/*
* $Id$
*/
/*
* xHarbour Project source code:
* STRDEL() function
*
* Copyright 2003 Walter Negro <anegro@overnet.com.ar>
* 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( "" );
}
}

1
harbour/source/hbpcre/cnv_hb2o.bat
View File

@@ -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 ..

2
harbour/source/hbpcre/cnv_o2hb.bat
View File

@@ -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

264
harbour/source/rtl/tget.prg
View File

@@ -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"

109
harbour/tests/rto_get.prg
View File

@@ -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