From e9afeddcdbb493439b40a5b119335a96655deda4 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 29 May 2008 15:08:08 +0000 Subject: [PATCH] 2008-05-29 17:02 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * source/rtl/tget.prg * ::picture(), ::PutMask(), ::unTransform() moved next to each other for easier editing/fixing. * common.mak - source/common/hbfhnd.c * source/common/Makefile - Removed file not used by Harbour anymore. * contrib/hbole/ole2.c ! Fixed OLE C++ errors under MSVC. Using Przemek's method. ; TOFIX: This one is still left: .\ole2.c(714) : error C2664: 'HRESULT (IUnknown *,const IID &,void **)' : cannot convert parameter 2 from 'LPIID' to 'const IID &' Reason: cannot convert from 'LPIID' to 'const IID' No constructor could take the source type, or constructor overload resolution was ambiguous --- harbour/ChangeLog | 17 ++ harbour/common.mak | 1 - harbour/contrib/hbole/ole2.c | 32 ++- harbour/source/common/Makefile | 1 - harbour/source/common/hbfhnd.c | 127 ---------- harbour/source/rtl/tget.prg | 428 ++++++++++++++++----------------- 6 files changed, 252 insertions(+), 354 deletions(-) delete mode 100644 harbour/source/common/hbfhnd.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index b4e44d73a2..82bfb71aba 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,23 @@ 2008-12-31 13:59 UTC+0100 Foo Bar */ +2008-05-29 17:02 UTC+0100 Viktor Szakats (harbour.01 syenar hu) + * source/rtl/tget.prg + * ::picture(), ::PutMask(), ::unTransform() moved next + to each other for easier editing/fixing. + + * common.mak + - source/common/hbfhnd.c + * source/common/Makefile + - Removed file not used by Harbour anymore. + + * contrib/hbole/ole2.c + ! Fixed OLE C++ errors under MSVC. Using Przemek's method. + ; TOFIX: This one is still left: + .\ole2.c(714) : error C2664: 'HRESULT (IUnknown *,const IID &,void **)' : cannot convert parameter 2 from 'LPIID' to 'const IID &' + Reason: cannot convert from 'LPIID' to 'const IID' + No constructor could take the source type, or constructor overload resolution was ambiguous + 2008-05-29 11:45 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * tests/rto_get.prg + Some tests added. diff --git a/harbour/common.mak b/harbour/common.mak index 9037bd93e1..d46407bec4 100644 --- a/harbour/common.mak +++ b/harbour/common.mak @@ -330,7 +330,6 @@ COMMON_LIB_OBJS = \ $(OBJ_DIR)\expropt1$(OBJEXT) \ $(OBJ_DIR)\expropt2$(OBJEXT) \ $(OBJ_DIR)\hbarch$(OBJEXT) \ - $(OBJ_DIR)\hbfhnd$(OBJEXT) \ $(OBJ_DIR)\hbfsapi$(OBJEXT) \ $(OBJ_DIR)\hbfopen$(OBJEXT) \ $(OBJ_DIR)\hbgete$(OBJEXT) \ diff --git a/harbour/contrib/hbole/ole2.c b/harbour/contrib/hbole/ole2.c index fefe9d04a9..acb03c4792 100644 --- a/harbour/contrib/hbole/ole2.c +++ b/harbour/contrib/hbole/ole2.c @@ -75,6 +75,16 @@ #define HB_OS_WIN_32_USED +#ifndef CINTERFACE + #define CINTERFACE 1 +#endif + +#ifdef __cplusplus +# define HB_ID_REF( type, id ) id +#else +# define HB_ID_REF( type, id ) ( ( type ) &id ) +#endif + #include #include @@ -406,7 +416,7 @@ HB_FUNC( CREATEOLEOBJECT ) // ( cOleName | cCLSID [, cIID ] ) } if ( nOleError == S_OK ) - nOleError = CoCreateInstance( &ClassID, NULL, CLSCTX_SERVER, + nOleError = CoCreateInstance( HB_ID_REF( REFCLSID, ClassID ), NULL, CLSCTX_SERVER, (REFIID) riid, &pDisp ); } @@ -440,8 +450,8 @@ HB_FUNC( OLEINVOKE ) // (hOleObject, szMethodName, uParams...) memset( (LPBYTE) &excep, 0, sizeof( excep ) ); cMember = AnsiToWide( hb_parc( 2 ) ); - nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, &IID_NULL, - ( LPVOID ) &cMember, 1, + nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, HB_ID_REF( REFIID, IID_NULL ), + ( wchar_t ** ) &cMember, 1, LOCALE_USER_DEFAULT, &lDispID ); hb_xfree( cMember ); @@ -450,7 +460,7 @@ HB_FUNC( OLEINVOKE ) // (hOleObject, szMethodName, uParams...) GetParams( &dParams ); nOleError = pDisp->lpVtbl->Invoke( pDisp, lDispID, - &IID_NULL, + HB_ID_REF( REFIID, IID_NULL ), LOCALE_USER_DEFAULT, DISPATCH_METHOD, &dParams, @@ -475,8 +485,8 @@ HB_FUNC( OLESETPROPERTY ) // (hOleObject, cPropName, uValue, uParams...) memset( (LPBYTE) &excep, 0, sizeof( excep ) ); cMember = AnsiToWide( hb_parc( 2 ) ); - nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, &IID_NULL, - ( LPVOID ) &cMember, 1, + nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, HB_ID_REF( REFIID, IID_NULL ), + ( wchar_t ** ) &cMember, 1, LOCALE_USER_DEFAULT, &lDispID ); hb_xfree( cMember ); @@ -488,7 +498,7 @@ HB_FUNC( OLESETPROPERTY ) // (hOleObject, cPropName, uValue, uParams...) nOleError = pDisp->lpVtbl->Invoke( pDisp, lDispID, - &IID_NULL, + HB_ID_REF( REFIID, IID_NULL ), LOCALE_USER_DEFAULT, DISPATCH_PROPERTYPUT, &dParams, @@ -514,8 +524,8 @@ HB_FUNC( OLEGETPROPERTY ) // (hOleObject, cPropName, uParams...) memset( (LPBYTE) &excep, 0, sizeof( excep ) ); cMember = AnsiToWide( hb_parc( 2 ) ); - nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, &IID_NULL, - ( LPVOID ) &cMember, 1, + nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, HB_ID_REF( REFIID, IID_NULL ), + ( wchar_t ** ) &cMember, 1, LOCALE_USER_DEFAULT, &lDispID ); hb_xfree( cMember ); @@ -524,7 +534,7 @@ HB_FUNC( OLEGETPROPERTY ) // (hOleObject, cPropName, uParams...) GetParams( &dParams ); nOleError = pDisp->lpVtbl->Invoke( pDisp, lDispID, - &IID_NULL, + HB_ID_REF( REFIID, IID_NULL ), LOCALE_USER_DEFAULT, DISPATCH_PROPERTYGET, &dParams, @@ -697,7 +707,7 @@ HB_FUNC( GETOLEOBJECT ) if ( nOleError == S_OK ) { - nOleError = GetActiveObject( &ClassID, NULL, &pUnk ); + nOleError = GetActiveObject( HB_ID_REF( REFCLSID, ClassID ), NULL, &pUnk ); if ( nOleError == S_OK ) { diff --git a/harbour/source/common/Makefile b/harbour/source/common/Makefile index bbf83a5995..25b66495c0 100644 --- a/harbour/source/common/Makefile +++ b/harbour/source/common/Makefile @@ -5,7 +5,6 @@ ROOT = ../../ C_SOURCES=\ - hbfhnd.c \ hbfsapi.c \ hbfopen.c \ hbgete.c \ diff --git a/harbour/source/common/hbfhnd.c b/harbour/source/common/hbfhnd.c deleted file mode 100644 index f3cc4915c8..0000000000 --- a/harbour/source/common/hbfhnd.c +++ /dev/null @@ -1,127 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * File handle tweaks - * - * Copyright 2001-2002 {list of individual authors and e-mail addresses} - * 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. - * - */ - -#if defined(__WIN32__) && defined(__BORLANDC__) && !defined( HB_NO_BCC_MAX_OPENFILES_HACK ) - - #define ___NFILE_H - - #ifdef _NFILE_ - #undef _NFILE_ - #endif - #define _NFILE_ 600 - - #include - #include - #include - - #ifdef __cplusplus - extern "C" { - #endif - - unsigned _RTLENTRY _EXPDATA _nfile = _NFILE_; - - void hb_files_setup( void ); - - extern void _RTLENTRY _init_handles( void ); - extern void _RTLENTRY _init_streams( void ); - - #ifdef __cplusplus - } - #endif - - #pragma startup hb_files_setup - #pragma startup _init_handles 4 - #pragma startup _init_streams 5 - -#endif - -/* NOTE: This symbol must be requested for the inclusion of this - module. [vszakats] */ - -void hb_fhnd_ForceLink( void ) -{ - /* Intentionally do nothing */ -} - -#if defined(__WIN32__) && defined(__BORLANDC__) && !defined( HB_NO_BCC_MAX_OPENFILES_HACK ) - -#define _F_STDIN (_F_READ | _F_TERM | _F_LBUF) -#define _F_STDOUT (_F_WRIT | _F_TERM | _F_LBUF) -#define _F_STDERR (_F_WRIT | _F_TERM) - -FILE _RTLENTRY _EXPDATA _streams [_NFILE_] = -{ - { NULL, NULL, 0, 0, 0, _F_STDIN, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, _F_STDOUT, 0, 1, 0 }, - { NULL, NULL, 0, 0, 0, _F_STDERR, 0, 2, 0 } -}; - -unsigned int _RTLENTRY _openfd[_NFILE_] = -{ - O_RDONLY | O_TEXT | O_DEVICE, - O_WRONLY | O_TEXT | O_DEVICE, - O_WRONLY | O_TEXT | O_DEVICE -}; - -unsigned int _RTLENTRY _pidtab[_NFILE_]; - -#ifdef __WIN32__ - unsigned long _RTLENTRY _handles[_NFILE_]; -#endif - -void hb_files_setup( void ) -{ - _nfile = _NFILE_; -} - -#endif - diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 76a3927df2..e2e197ccea 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -537,140 +537,6 @@ METHOD varGet() CLASS Get RETURN xValue -METHOD unTransform() CLASS Get - - LOCAL cBuffer - LOCAL xValue - LOCAL nFor - LOCAL lMinus - LOCAL lHasDec - - IF ::hasFocus - - cBuffer := ::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. - ENDIF - ENDIF - - RETURN xValue - /* NOTE: CA-Cl*pper will corrupt memory if cChar contains multiple chars. [vszakats] */ @@ -1272,6 +1138,220 @@ METHOD picture( cPicture ) CLASS Get RETURN ::cPicture +METHOD PutMask( xValue, lEdit ) CLASS Get + + LOCAL cChar + LOCAL cBuffer + LOCAL cPicFunc := ::cPicFunc + LOCAL cPicMask := ::cPicMask + LOCAL nFor + LOCAL nNoEditable := 0 + + DEFAULT lEdit TO ::hasFocus + + IF !( ValType( xValue ) $ "CNDL" ) + xValue := "" + ENDIF + + IF ::hasFocus + cPicFunc := StrTran( cPicfunc, "B", "" ) + IF cPicFunc == "@" + cPicFunc := "" + ENDIF + ENDIF + IF lEdit .AND. ::lEdit + IF "*" $ cPicMask .OR. ; + "$" $ cPicMask + cPicMask := StrTran( StrTran( cPicMask, "*", "9" ), "$", "9" ) + ENDIF + ENDIF + + cBuffer := Transform( xValue, ; + iif( Empty( cPicFunc ), ; + iif( ::lPicBlankZero .AND. !::hasFocus, "@Z ", "" ), ; + cPicFunc + iif( ::lPicBlankZero .AND. !::hasFocus, "Z" , "" ) + " " ) ; + + cPicMask ) + + IF ::cType == "N" + IF ( "(" $ cPicFunc .OR. ")" $ cPicFunc ) .AND. xValue >= 0 + cBuffer += " " + ENDIF + + IF ( ( "C" $ cPicFunc .AND. xValue < 0 ) .OR.; + ( "X" $ cPicFunc .AND. xValue >= 0 ) ) .AND.; + !( "X" $ cPicFunc .AND. "C" $ cPicFunc ) + cBuffer += " " + ENDIF + + ::lMinusPrinted := ( xValue < 0 ) + ENDIF + + ::nMaxLen := Len( cBuffer ) + ::nMaxEdit := ::nMaxLen + + IF lEdit .AND. ::cType == "N" .AND. ! Empty( cPicMask ) + FOR nFor := 1 TO ::nMaxLen + cChar := SubStr( cPicMask, 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 + ENDIF + + IF ::cType == "N" + IF "(" $ ::cPicFunc .OR. ")" $ ::cPicFunc + ::nMaxEdit-- + ENDIF + IF "C" $ ::cPicFunc .OR. "X" $ ::cPicFunc + ::nMaxEdit -= 3 + ENDIF + ENDIF + + IF ::cType == "D" .AND. ::badDate + cBuffer := ::cBuffer + ENDIF + + ::nMaxLen := Len( cBuffer ) + + RETURN cBuffer + +METHOD unTransform() CLASS Get + + LOCAL cBuffer + LOCAL xValue + LOCAL nFor + LOCAL lMinus + LOCAL lHasDec + + IF ::hasFocus + + cBuffer := ::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. + ENDIF + ENDIF + + RETURN xValue + METHOD type() CLASS Get RETURN ::cType := ValType( iif( ::hasFocus, ::xVarGet, ::varGet() ) ) @@ -1705,86 +1785,6 @@ METHOD Input( cChar ) CLASS Get RETURN cChar -METHOD PutMask( xValue, lEdit ) CLASS Get - - LOCAL cChar - LOCAL cBuffer - LOCAL cPicFunc := ::cPicFunc - LOCAL cPicMask := ::cPicMask - LOCAL nFor - LOCAL nNoEditable := 0 - - DEFAULT lEdit TO ::hasFocus - - IF !( ValType( xValue ) $ "CNDL" ) - xValue := "" - ENDIF - - IF ::hasFocus - cPicFunc := StrTran( cPicfunc, "B", "" ) - IF cPicFunc == "@" - cPicFunc := "" - ENDIF - ENDIF - IF lEdit .AND. ::lEdit - IF "*" $ cPicMask .OR. ; - "$" $ cPicMask - cPicMask := StrTran( StrTran( cPicMask, "*", "9" ), "$", "9" ) - ENDIF - ENDIF - - cBuffer := Transform( xValue, ; - iif( Empty( cPicFunc ), ; - iif( ::lPicBlankZero .AND. !::hasFocus, "@Z ", "" ), ; - cPicFunc + iif( ::lPicBlankZero .AND. !::hasFocus, "Z" , "" ) + " " ) ; - + cPicMask ) - - IF ::cType == "N" - IF ( "(" $ cPicFunc .OR. ")" $ cPicFunc ) .AND. xValue >= 0 - cBuffer += " " - ENDIF - - IF ( ( "C" $ cPicFunc .AND. xValue < 0 ) .OR.; - ( "X" $ cPicFunc .AND. xValue >= 0 ) ) .AND.; - !( "X" $ cPicFunc .AND. "C" $ cPicFunc ) - cBuffer += " " - ENDIF - - ::lMinusPrinted := ( xValue < 0 ) - ENDIF - - ::nMaxLen := Len( cBuffer ) - ::nMaxEdit := ::nMaxLen - - IF lEdit .AND. ::cType == "N" .AND. ! Empty( cPicMask ) - FOR nFor := 1 TO ::nMaxLen - cChar := SubStr( cPicMask, 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 - ENDIF - - IF ::cType == "N" - IF "(" $ ::cPicFunc .OR. ")" $ ::cPicFunc - ::nMaxEdit-- - ENDIF - IF "C" $ ::cPicFunc .OR. "X" $ ::cPicFunc - ::nMaxEdit -= 3 - ENDIF - ENDIF - - IF ::cType == "D" .AND. ::badDate - cBuffer := ::cBuffer - ENDIF - - ::nMaxLen := Len( cBuffer ) - - RETURN cBuffer - /* ------------------------------------------------------------------------- */ METHOD buffer( cBuffer ) CLASS Get