diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 97e3db9c9f..fe6db3bd32 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,92 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-04-23 23:28 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * harbour/source/rtl/diskspac.c + ! Fixed to return free space instead of disk size under Unix OSes. + + * harbour/source/rtl/tget.prg + ! Fixed checking for invalid GET var types. + ! More C5x compatible behaviour for invalid types. + ! ::UnTransform() fixed when not in focus. + - ::UnTransform() cBuffer incompatible parameter removed. + ! ::Reform() probably made more compatible. + + ::PosInBuffer() XBase++ compatible method implemented. + (but not tested or compared with XBase++) + ! ::Minus assignment fixed. + ! ::Clear assignment fixed. + ! ::Changed assignment fixed. + ! ::Buffer assignment fixed. + ! ::Block assignment fixed. + ! ::Name assignment fixed. + ! ::UnTransform() extra parameter removed. + ! ::UpdateBuffer() minor fix when not in focus. + ! ::Reform() made more compatible. + % ::SetFocus() some superfluous stuff removed. + % ::SetFocus() some fixes, cleanups. + ! ::KillFocus() now sets ::TypeOut properly. + ! ::VarPut(), ::VarGet() fixed for invalid ::Subscript contents. + ! ::VarPut(), ::VarGet() fixed for invalid ::Block content. + ! ::Pos rewritten to be fully compatible. + ! ::ColorSpec made fully compatible. + ! ::UnTransform() fixed when not in focus. + ! ::UnTransform() fixed handling "YL" in string pictures. + % ::UnTransform() minor optimization. + % ::PutMask() some hacks removed. + ! ::PutMask() invalid types handling. + ! ::BackSpace() fixed when not in focus. + ! ::Delete() fixed when not in focus. + ! ::DeleteAll() fixed when not in focus. + ! ::IsEditable() fixes. + ! ::Picture fixes for invalid types, assignment behaviour. + ! ::Picture hacks removed. + ! Non-assignable vars made READONLY. (will generate + different RTEs than in CA-Cl*pper due to the more + refined oo engine in Harbour.) + ! ::BadDate changed to be a METHOD. + ! ::ToDecPos fixes. + ! ::Row assigment and behaviour fixes. + ! ::Col assigment and behaviour fixes. + + Several comments and NOTEs added. + + * harbour/include/hbapigt.h + * harbour/source/rtl/gtapi.c + * harbour/source/rtl/setcolor.c + + hb_gtColorsToString() public API added. + + hb_NToColor() function added to convert a single color + value (returned by hb_ColorToN()) back to a string. + Used in TGet():ColorSpec implementation. + + * harbour/source/vm/fm.c + * "Blocks" -> "Block(s)" + + * harbour/tests/rto_get.prg + + Added many test cases. + + * harbour/source/vm/cmdarg.c + + Added support to use "--" instead of "//" for internal + command line options. + + * harbour/source/rtl/tbcolumn.prg + + Formatting. + + * harbour/source/rtl/tbrowse.prg + + Added Harbour (undocumented) extension NOTE. + + * harbour/include/Makefile + - harbour/include/usrrdd.ch + + harbour/include/hbusrrdd.ch + * harbour/source/rdd/usrrdd/usrrdd.c + * harbour/source/rdd/usrrdd/rdds/dbtcdx.prg + * harbour/source/rdd/usrrdd/rdds/fcomma.prg + * harbour/source/rdd/usrrdd/rdds/fptcdx.prg + * harbour/source/rdd/usrrdd/rdds/hscdx.prg + * harbour/source/rdd/usrrdd/rdds/rlcdx.prg + * harbour/source/rdd/usrrdd/rdds/smtcdx.prg + * harbour/contrib/pgsql/pgrdd.prg + ! Changed public header filename to comply with the "hb*.ch" rule. + (namespace protection) + 2007-04-23 18:25 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbcomp.h * harbour/include/hbcompdf.h diff --git a/harbour/contrib/pgsql/pgrdd.prg b/harbour/contrib/pgsql/pgrdd.prg index 949c101ad3..12e196e3b4 100644 --- a/harbour/contrib/pgsql/pgrdd.prg +++ b/harbour/contrib/pgsql/pgrdd.prg @@ -58,7 +58,7 @@ */ #include "rddsys.ch" -#include "usrrdd.ch" +#include "hbusrrdd.ch" #include "fileio.ch" #include "error.ch" #include "dbstruct.ch" @@ -391,5 +391,3 @@ RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; INIT PROC PG_INIT() rddRegister( "PGRDD", RDT_FULL ) RETURN - - diff --git a/harbour/include/Makefile b/harbour/include/Makefile index 7ad0feed88..b2f1009425 100644 --- a/harbour/include/Makefile +++ b/harbour/include/Makefile @@ -73,6 +73,7 @@ PRG_HEADERS=\ getexit.ch \ hbclass.ch \ hbcommon.ch \ + hbcompat.ch \ hbdebug.ch \ hbextern.ch \ hbgetcmt.ch \ @@ -89,6 +90,7 @@ PRG_HEADERS=\ hbpers.ch \ hbsetup.ch \ hbstdgen.ch \ + hbusrrdd.ch \ inkey.ch \ memoedit.ch \ ord.ch \ @@ -98,9 +100,7 @@ PRG_HEADERS=\ setcurs.ch \ simpleio.ch \ std.ch \ - tbrowse.ch \ - usrrdd.ch \ - hbcompat.ch + tbrowse.ch API_HEADERS=\ error.api \ diff --git a/harbour/include/hbapigt.h b/harbour/include/hbapigt.h index 12eb1495c2..d9c275af9e 100644 --- a/harbour/include/hbapigt.h +++ b/harbour/include/hbapigt.h @@ -149,6 +149,7 @@ extern HB_EXPORT ERRCODE hb_gtBoxD( SHORT uiTop, SHORT uiLeft, SHORT uiBottom, S extern HB_EXPORT ERRCODE hb_gtBoxS( SHORT uiTop, SHORT uiLeft, SHORT uiBottom, SHORT uiRight ); extern HB_EXPORT ERRCODE hb_gtColorSelect( USHORT uiColorIndex ); extern HB_EXPORT USHORT hb_gtColorToN( char * szColorString ); +extern HB_EXPORT USHORT hb_gtColorsToString( int * pColors, int iColorCount, char * pszColorString, int iBufSize ); extern HB_EXPORT ERRCODE hb_gtDispBegin( void ); extern HB_EXPORT USHORT hb_gtDispCount( void ); extern HB_EXPORT ERRCODE hb_gtDispEnd( void ); diff --git a/harbour/include/usrrdd.ch b/harbour/include/hbusrrdd.ch similarity index 100% rename from harbour/include/usrrdd.ch rename to harbour/include/hbusrrdd.ch diff --git a/harbour/source/rdd/usrrdd/rdds/dbtcdx.prg b/harbour/source/rdd/usrrdd/rdds/dbtcdx.prg index 7d54fa5b33..e646ef341f 100644 --- a/harbour/source/rdd/usrrdd/rdds/dbtcdx.prg +++ b/harbour/source/rdd/usrrdd/rdds/dbtcdx.prg @@ -51,7 +51,7 @@ */ #include "rddsys.ch" -#include "usrrdd.ch" +#include "hbusrrdd.ch" #include "dbinfo.ch" /* diff --git a/harbour/source/rdd/usrrdd/rdds/fcomma.prg b/harbour/source/rdd/usrrdd/rdds/fcomma.prg index c1f4e1cca7..13be449fa7 100644 --- a/harbour/source/rdd/usrrdd/rdds/fcomma.prg +++ b/harbour/source/rdd/usrrdd/rdds/fcomma.prg @@ -64,7 +64,7 @@ */ #include "rddsys.ch" -#include "usrrdd.ch" +#include "hbusrrdd.ch" #include "fileio.ch" #include "error.ch" diff --git a/harbour/source/rdd/usrrdd/rdds/fptcdx.prg b/harbour/source/rdd/usrrdd/rdds/fptcdx.prg index 1c785d55d4..8c2e4fa9e8 100644 --- a/harbour/source/rdd/usrrdd/rdds/fptcdx.prg +++ b/harbour/source/rdd/usrrdd/rdds/fptcdx.prg @@ -51,7 +51,7 @@ */ #include "rddsys.ch" -#include "usrrdd.ch" +#include "hbusrrdd.ch" #include "dbinfo.ch" /* diff --git a/harbour/source/rdd/usrrdd/rdds/hscdx.prg b/harbour/source/rdd/usrrdd/rdds/hscdx.prg index a2b4a06cce..f272d340cc 100644 --- a/harbour/source/rdd/usrrdd/rdds/hscdx.prg +++ b/harbour/source/rdd/usrrdd/rdds/hscdx.prg @@ -60,7 +60,7 @@ */ #include "rddsys.ch" -#include "usrrdd.ch" +#include "hbusrrdd.ch" #include "fileio.ch" #include "dbinfo.ch" diff --git a/harbour/source/rdd/usrrdd/rdds/rlcdx.prg b/harbour/source/rdd/usrrdd/rdds/rlcdx.prg index 0b049ee66b..84d85cdf85 100644 --- a/harbour/source/rdd/usrrdd/rdds/rlcdx.prg +++ b/harbour/source/rdd/usrrdd/rdds/rlcdx.prg @@ -59,7 +59,7 @@ */ #include "rddsys.ch" -#include "usrrdd.ch" +#include "hbusrrdd.ch" ANNOUNCE RLCDX diff --git a/harbour/source/rdd/usrrdd/rdds/smtcdx.prg b/harbour/source/rdd/usrrdd/rdds/smtcdx.prg index eac773e5ce..5751c43f74 100644 --- a/harbour/source/rdd/usrrdd/rdds/smtcdx.prg +++ b/harbour/source/rdd/usrrdd/rdds/smtcdx.prg @@ -57,7 +57,7 @@ */ #include "rddsys.ch" -#include "usrrdd.ch" +#include "hbusrrdd.ch" #include "dbinfo.ch" /* Force linking DBFCDX and DBFFPT from which our RDD inherits */ diff --git a/harbour/source/rdd/usrrdd/usrrdd.c b/harbour/source/rdd/usrrdd/usrrdd.c index 761abb6244..9a6d417be1 100644 --- a/harbour/source/rdd/usrrdd/usrrdd.c +++ b/harbour/source/rdd/usrrdd/usrrdd.c @@ -61,7 +61,7 @@ #include "hbstack.h" #include "hbinit.h" #include "rddsys.ch" -#include "usrrdd.ch" +#include "hbusrrdd.ch" #define SELF_USRNODE( w ) ( s_pUsrRddNodes[ (w)->rddID ] ) #define SELF_USRDATA( w ) ( ( LPUSRRDDDATA ) ( ( BYTE * )( w ) + \ diff --git a/harbour/source/rtl/diskspac.c b/harbour/source/rtl/diskspac.c index ed344320ac..46a103bca0 100644 --- a/harbour/source/rtl/diskspac.c +++ b/harbour/source/rtl/diskspac.c @@ -209,12 +209,12 @@ HB_FUNC( DISKSPACE ) char *szName = ISCHAR( 1 ) ? hb_parc( 1 ) : ( char * ) "/"; #if defined(HB_OS_SUNOS) struct statvfs st; - if ( statvfs( szName, &st) == 0 ) + if ( statvfs( szName, &st ) == 0 ) #else struct statfs st; - if ( statfs( szName, &st) == 0 ) + if ( statfs( szName, &st ) == 0 ) #endif - dSpace = ( double ) st.f_blocks * ( double ) st.f_bsize; + dSpace = ( double ) st.f_bfree * ( double ) st.f_bsize; else bError = TRUE; diff --git a/harbour/source/rtl/gtapi.c b/harbour/source/rtl/gtapi.c index 0186c00202..8737a4999d 100644 --- a/harbour/source/rtl/gtapi.c +++ b/harbour/source/rtl/gtapi.c @@ -240,6 +240,15 @@ HB_EXPORT USHORT hb_gtColorToN( char * szColorString ) return hb_gt_ColorNum( szColorString ); } +HB_EXPORT USHORT hb_gtColorsToString( int * pColors, int iColorCount, char * pszColorString, int iBufSize ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_gtColorsToString(%p, %d, %p, %d)", pColors, iColorCount, pszColorString, iBufSize)); + + hb_gt_ColorsToString( pColors, iColorCount, pszColorString, iBufSize ); + + return SUCCESS; +} + HB_EXPORT ERRCODE hb_gtSetColorStr( const char * szColorString ) { HB_TRACE(HB_TR_DEBUG, ("hb_gtSetColorStr(%s)", szColorString)); diff --git a/harbour/source/rtl/setcolor.c b/harbour/source/rtl/setcolor.c index c8f11bcb15..aead353923 100644 --- a/harbour/source/rtl/setcolor.c +++ b/harbour/source/rtl/setcolor.c @@ -99,4 +99,21 @@ HB_FUNC( HB_COLORTON ) hb_retni( 0 ); } +HB_FUNC( HB_NTOCOLOR ) +{ + if( ISNUM( 1 ) ) + { + char szColorString[ 10 ]; + int colors[ 1 ]; + + colors[ 0 ] = hb_parni( 1 ); + + hb_gtColorsToString( colors, 1, szColorString, 10 ); + + hb_retc( szColorString ); + } + else + hb_retc( "N/N" ); +} + #endif diff --git a/harbour/source/rtl/tbcolumn.prg b/harbour/source/rtl/tbcolumn.prg index 943f50feb4..3acef40b16 100644 --- a/harbour/source/rtl/tbcolumn.prg +++ b/harbour/source/rtl/tbcolumn.prg @@ -74,7 +74,7 @@ CLASS TBColumn #endif ACCESS Width INLINE ::nWidth // Column display width - ASSIGN Width( n ) INLINE ::SetWidth( n ) + ASSIGN Width( nWidth ) INLINE ::SetWidth( nWidth ) // NOTE: 17/08/01 - // It is not correct in my opinion that this instance variable be exported @@ -117,34 +117,34 @@ METHOD New( cHeading, bBlock ) CLASS TBColumn return Self -METHOD SetWidth(n) CLASS TBColumn +METHOD SetWidth( nWidth ) CLASS TBColumn - // From a TOFIX inside TBrowse.prg: - // "Also Clipper will not allow the user to assign a NIL to the :width variable." - if n <> nil - ::nWidth := n + /* NOTE: CA-Cl*pper won't allow the user to assign NIL to the :width variable. */ + if nWidth != NIL + ::nWidth := nWidth endif -return n +return nWidth #ifdef HB_COMPAT_C53 METHOD SetStyle( nMode, lSetting ) CLASS TBColumn - LOCAL lRet := .F. - IF nMode > LEN( ::aSetStyle ) - ASize( ::aSetStyle, nMode ) - ::aSetStyle[ nMode ] := .F. - ENDIF + local lRet := .F. + + if nMode > Len( ::aSetStyle ) + ASize( ::aSetStyle, nMode ) + ::aSetStyle[ nMode ] := .F. + endif + + lRet := ::aSetStyle[ nMode ] + + if ISLOGICAL( lSetting ) + ::aSetStyle[ nMode ] := lSetting + endif - lRet := ::aSetStyle[ nMode ] - - IF ISLOGICAL( lSetting ) - ::aSetStyle[ nMode ] := lSetting - ENDIF - -RETURN lRet +return lRet #endif diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index 4acb2537da..f31936350b 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -154,6 +154,7 @@ CLASS TBrowse METHOD ColWidth( nColumn ) // Returns the display width of a particular column METHOD ColCount() METHOD ColorRect() // Alters the color of a rectangular group of cells + /* NOTE: nMode is an undocumented Harbour parameter. Should not be used by app code. */ METHOD Configure( nMode ) // Reconfigures the internal settings of the TBrowse object // nMode is an undocumented parameter in CA-Cl*pper METHOD DeHilite() // Dehighlights the current cell diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 5bb88af71d..9d7b647484 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -50,6 +50,18 @@ * */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2007 Viktor Szakats + * Several smaller methods and lots of fixes using + * regression/unit testing. + * + * See doc/license.txt for licensing terms. + * + */ + #include "hbclass.ch" #include "color.ch" @@ -60,13 +72,7 @@ #include "button.ch" #include "hblang.ch" -/* TODO: :posInBuffer( , ) --> nPos - Determines a position within the edit buffer based on screen - coordinates. - Xbase++ compatible method */ - /* TOFIX: ::Minus [vszakats] */ -/* TOFIX: ::DecPos [vszakats] */ #define GET_CLR_UNSELECTED 0 #define GET_CLR_ENHANCED 1 @@ -77,26 +83,17 @@ CLASS Get EXPORTED: - DATA BadDate INIT .f. - DATA Buffer DATA Cargo - DATA Changed INIT .f. - DATA Clear INIT .f. - DATA Col - DATA DecPos INIT 0 // ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. + DATA DecPos INIT 0 READONLY /* ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. [vszakats] */ DATA ExitState - DATA HasFocus INIT .f. - DATA Minus INIT .f. - DATA Name - DATA Original - DATA Pos INIT 0 + DATA HasFocus INIT .f. READONLY + DATA Original READONLY DATA PostBlock DATA PreBlock DATA Reader - DATA Rejected INIT .f. - DATA Row + DATA Rejected INIT .f. READONLY DATA SubScript - DATA TypeOut INIT .f. + DATA TypeOut INIT .f. READONLY #ifdef HB_COMPAT_C53 DATA Control DATA Message @@ -105,12 +102,20 @@ CLASS Get DATA CapCol INIT 0 #endif - PROTECTED: + HIDDEN: DATA cColorSpec DATA cPicture DATA bBlock DATA cType + DATA nPos INIT 0 + DATA lChanged INIT .f. + DATA lClear INIT .f. + DATA nRow + DATA nCol + DATA cName + DATA lRejected INIT .f. + DATA cBuffer DATA cPicMask INIT "" DATA cPicFunc INIT "" @@ -125,45 +130,54 @@ CLASS Get DATA cDelimit DATA nMaxEdit DATA lMinus INIT .f. + DATA lMinus2 INIT .f. DATA lMinusPrinted INIT .f. DATA xVarGet VISIBLE: - /* NOTE: This method is a Harbour extension */ - METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) + METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) /* NOTE: This method is a Harbour extension [vszakats] */ METHOD Assign() #ifdef HB_COMPAT_XPP - MESSAGE _Assign METHOD Assign() + MESSAGE _Assign() METHOD Assign() #endif - METHOD Type() + METHOD BadDate() + METHOD Block( bBlock ) SETGET + METHOD Buffer( cBuffer ) SETGET + METHOD Changed( lChanged ) SETGET + METHOD Clear( lClear ) SETGET + METHOD Col( nCol ) SETGET + METHOD ColorDisp( cColorSpec ) + METHOD ColorSpec( cColorSpec ) SETGET + METHOD Display( lForced ) /* NOTE: lForced is an undocumented Harbour parameter. Should not be used by app code. [vszakats] */ #ifdef HB_COMPAT_C53 METHOD HitTest( nMRow, nMCol ) #endif - METHOD Block( bBlock ) SETGET - METHOD ColorSpec( cColorSpec ) SETGET - METHOD Picture( cPicture ) SETGET - /* NOTE: lForced is an undocumented Harbour parameter. Should not be used by app code. */ - METHOD Display( lForced ) - METHOD ColorDisp( cColorSpec ) METHOD KillFocus() - METHOD Reset() - METHOD SetFocus() - METHOD Undo() - METHOD UnTransform( cBuffer ) - METHOD UpdateBuffer() + METHOD Minus( lMinus ) SETGET + METHOD Name( cName ) SETGET + METHOD Picture( cPicture ) SETGET + METHOD Pos( nPos ) SETGET +#ifdef HB_COMPAT_XPP + METHOD PosInBuffer( nRow, nCol ) +#endif #ifdef HB_C52_UNDOC METHOD Reform() #endif - + METHOD Reset() + METHOD Row( nRow ) SETGET + METHOD SetFocus() + METHOD Type() + METHOD Undo() + METHOD UnTransform() + METHOD UpdateBuffer() METHOD VarGet() - /* NOTE: lReFormat is an undocumented Harbour parameter. Should not be used by app code. */ - METHOD VarPut( xValue, lReFormat ) + METHOD VarPut( xValue, lReFormat ) /* NOTE: lReFormat is an undocumented Harbour parameter. Should not be used by app code. [vszakats] */ METHOD End() #ifdef HB_COMPAT_XPP - MESSAGE _End METHOD End() + MESSAGE _End() METHOD End() #endif METHOD Home() MESSAGE Left() METHOD _Left() @@ -172,9 +186,8 @@ CLASS Get METHOD WordLeft() METHOD WordRight() - /* NOTE: lDisplay is an undocumented Harbour parameter. Should not be used by app code. */ - METHOD BackSpace( lDisplay ) - MESSAGE Delete() METHOD _Delete() + METHOD BackSpace( lDisplay ) /* NOTE: lDisplay is an undocumented Harbour parameter. Should not be used by app code. [vszakats] */ + MESSAGE Delete( lDisplay ) METHOD _Delete( lDisplay ) /* NOTE: lDisplay is an undocumented Harbour parameter. Should not be used by app code. [vszakats] */ METHOD DelEnd() METHOD DelLeft() METHOD DelRight() @@ -184,7 +197,7 @@ CLASS Get METHOD Insert( cChar ) METHOD OverStrike( cChar ) - PROTECTED: + HIDDEN: METHOD DeleteAll() METHOD IsEditable( nPos ) @@ -192,6 +205,7 @@ CLASS Get METHOD PutMask( xValue, lEdit ) METHOD FirstEditable() METHOD LastEditable() + METHOD ResetPar() ENDCLASS @@ -205,10 +219,10 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get DEFAULT bVarBlock TO iif( ISCHARACTER( cVarName ), MemvarBlock( cVarName ), NIL ) DEFAULT cColorSpec TO hb_ColorIndex( SetColor(), CLR_UNSELECTED ) + "," + hb_ColorIndex( SetColor(), CLR_ENHANCED ) - ::Row := nRow - ::Col := nCol + ::nRow := nRow + ::nCol := nCol ::bBlock := bVarBlock - ::Name := cVarName + ::cName := cVarName ::Picture := cPicture ::ColorSpec := cColorSpec if Set( _SET_DELIMITERS ) @@ -232,10 +246,10 @@ return Self METHOD UpdateBuffer() CLASS Get if ::HasFocus - ::Buffer := ::PutMask( ::VarGet() ) + ::cBuffer := ::PutMask( ::VarGet() ) ::Display() else - ::PutMask( ::VarGet() ) + ::VarGet() endif return Self @@ -247,7 +261,7 @@ return Self METHOD Reform() CLASS Get if ::HasFocus - ::Buffer := ::PutMask( ::xVarGet, .f. ) + ::cBuffer := ::PutMask( ::UnTransform(), .f. ) endif return Self @@ -264,55 +278,55 @@ METHOD Display( lForced ) CLASS Get DEFAULT lForced TO .t. - if ::Buffer == NIL + if ! ISCHARACTER( ::cBuffer ) ::cType := ValType( ::xVarGet ) ::picture := ::cPicture endif if ::HasFocus - cBuffer := ::Buffer + cBuffer := ::cBuffer else cBuffer := ::PutMask( ::VarGet() ) endif if ::nMaxLen == NIL - ::nMaxLen := iif( cBuffer == NIL, 0, Len( cBuffer ) ) + ::nMaxLen := 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 + ::DecPos != 0 .and. ::lMinus2 .and. ; + ::nPos > ::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 != ::nMaxLen .and. ::nPos != 0 // ; has scroll? if ::nDispLen > 8 - nDispPos := Max( 1, Min( ::Pos - ::nDispLen + 4, ::nMaxLen - ::nDispLen + 1 ) ) + nDispPos := Max( 1, Min( ::nPos - ::nDispLen + 4, ::nMaxLen - ::nDispLen + 1 ) ) else - nDispPos := Max( 1, Min( ::Pos - int( ::nDispLen / 2 ), ::nMaxLen - ::nDispLen + 1 ) ) + nDispPos := Max( 1, Min( ::nPos - Int( ::nDispLen / 2 ), ::nMaxLen - ::nDispLen + 1 ) ) endif else nDispPos := 1 endif if cBuffer != NIL .and. ( lForced .or. ( nDispPos != ::nOldPos ) ) - DispOutAt( ::Row, ::Col + iif( ::cDelimit == NIL, 0, 1 ),; + DispOutAt( ::nRow, ::nCol + iif( ::cDelimit == NIL, 0, 1 ),; SubStr( cBuffer, nDispPos, ::nDispLen ),; hb_ColorIndex( ::cColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) ) 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( ::nRow, ::nCol, Left( ::cDelimit, 1 ), hb_ColorIndex( ::cColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) ) + DispOutAt( ::nRow, ::nCol + ::nDispLen + 1, SubStr( ::cDelimit, 2, 1 ), hb_ColorIndex( ::cColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) ) endif endif - if ::Pos != 0 - SetPos( ::Row, ::Col + ::Pos - nDispPos + iif( ::cDelimit == NIL, 0, 1 ) ) + if ::nPos != 0 + SetPos( ::nRow, ::nCol + ::nPos - nDispPos + iif( ::cDelimit == NIL, 0, 1 ) ) endif ::nOldPos := nDispPos @@ -325,8 +339,7 @@ return Self METHOD ColorDisp( cColorSpec ) CLASS Get - ::ColorSpec := cColorSpec - ::Display() + ::ColorSpec( cColorSpec ):Display() return Self @@ -334,11 +347,13 @@ return Self METHOD End() CLASS Get - local nLastCharPos, nPos, nFor + local nLastCharPos + local nPos + local nFor if ::HasFocus - nLastCharPos := Min( Len( RTrim( ::Buffer ) ) + 1, ::nMaxEdit ) - if ::Pos != nLastCharPos + nLastCharPos := Min( Len( RTrim( ::cBuffer ) ) + 1, ::nMaxEdit ) + if ::nPos != nLastCharPos nPos := nLastCharPos else nPos := ::nMaxEdit @@ -349,7 +364,7 @@ METHOD End() CLASS Get exit endif next - ::Clear := .f. + ::lClear := .f. ::Display( .f. ) endif @@ -361,7 +376,7 @@ METHOD Home() CLASS Get if ::HasFocus ::Pos := ::FirstEditable() - ::Clear := .f. + ::lClear := .f. ::Display( .f. ) endif @@ -372,13 +387,13 @@ return Self METHOD Reset() CLASS Get 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 + ::cBuffer := ::PutMask( ::VarGet(), .f. ) + ::Pos := ::FirstEditable() /* ; Simple 0 in CA-Cl*pper [vszakats] */ + ::lClear := ( "K" $ ::cPicFunc .or. ::cType == "N" ) + ::lEdit := .f. + ::lMinus := .f. + ::Rejected := .f. + ::TypeOut := ( ::nPos == 0 ) /* ; Simple .f. in CA-Cl*pper [vszakats] */ ::Display() endif @@ -391,7 +406,7 @@ METHOD Undo() CLASS Get if ::HasFocus ::VarPut( ::Original ) ::Reset() - ::Changed := .f. + ::lChanged := .f. endif return Self @@ -400,48 +415,29 @@ return Self METHOD SetFocus() CLASS Get - local lWasNIL local xVarGet 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" ) + ::cBuffer := ::PutMask( xVarGet, .f. ) + ::ResetPar() + ::lChanged := .f. + ::lClear := ( "K" $ ::cPicFunc .or. ::cType == "N" ) ::lEdit := .f. - ::Pos := ::FirstEditable() - ::TypeOut := ( ::Pos == 0 ) - - if ::cType == "N" - ::DecPos := At( iif( ::lDecRev .or. "E" $ ::cPicFunc, ",", "." ), ::Buffer ) - if ::DecPos == 0 - ::DecPos := Len( ::Buffer ) + 1 - endif - ::lMinus := ( xVarGet < 0 ) - else - ::DecPos := 0 // ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. - endif + ::Pos := 1 ::lMinusPrinted := .f. - ::Minus := .f. - ::BadDate := ( ::cType == "D" ) .and. IsBadDate( ::Buffer, ::cPicFunc ) - - if lWasNIL .and. ::Buffer != NIL - if ::nDispLen == NIL - ::nDispLen := ::nMaxLen - endif - endif + ::lMinus := .f. ::Display() @@ -460,11 +456,12 @@ METHOD KillFocus() CLASS Get lHadFocus := ::HasFocus ::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. + ::nPos := 0 + ::lClear := .f. + ::lMinus := .f. + ::lChanged := .f. + ::DecPos := 0 /* ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. [vszakats] */ + ::TypeOut := .f. if lHadFocus ::Display() @@ -472,7 +469,7 @@ METHOD KillFocus() CLASS Get ::xVarGet := NIL ::Original := NIL - ::Buffer := NIL + ::cBuffer := NIL return Self @@ -480,30 +477,40 @@ return Self METHOD VarPut( xValue, lReFormat ) CLASS Get - local aSubs, nLen, aValue + local aSubs + local nLen + local aValue local i - DEFAULT lReFormat TO .t. - if ISBLOCK( ::bBlock ) - if ::SubScript == NIL - Eval( ::bBlock, xValue ) - else - aSubs := ::SubScript + aSubs := ::SubScript + if ISARRAY( aSubs ) .and. ! Empty( aSubs ) nLen := Len( aSubs ) aValue := Eval( ::bBlock ) for i := 1 to nLen - 1 - aValue := aValue[ aSubs[ i ] ] + if ISNUMBER( aSubs[ i ] ) + aValue := aValue[ aSubs[ i ] ] + else + exit + endif next - aValue[ aSubs[ i ] ] := xValue + if ISNUMBER( aSubs[ i ] ) + aValue[ aSubs[ i ] ] := xValue + endif + else + Eval( ::bBlock, xValue ) endif + DEFAULT lReFormat TO .t. + if lReFormat ::cType := ValType( xValue ) ::xVarGet := xValue ::lEdit := .f. ::Picture := ::cPicture endif + else + xValue := NIL endif return xValue @@ -512,24 +519,28 @@ return xValue METHOD VarGet() CLASS Get - local aSubs, nLen, aValue + local aSubs + local nLen local i local xValue if ISBLOCK( ::bBlock ) - if ::SubScript == NIL - xValue := Eval( ::bBlock ) - else - aSubs := ::SubScript + aSubs := ::SubScript + if ISARRAY( aSubs ) .and. ! Empty( aSubs ) nLen := Len( aSubs ) - aValue := Eval( ::bBlock ) - for i := 1 to nLen - 1 - aValue := aValue[ aSubs[ i ] ] + xValue := Eval( ::bBlock ) + for i := 1 to nLen + if ISNUMBER( aSubs[ i ] ) + xValue := xValue[ aSubs[ i ] ] + else + exit + endif next - xValue := aValue[ aSubs[ i ] ] + else + xValue := Eval( ::bBlock ) endif else - xValue := NIL + xValue := ::xVarGet endif ::xVarGet := xValue @@ -538,48 +549,56 @@ return xValue /* ------------------------------------------------------------------------- */ -METHOD UnTransform( cBuffer ) CLASS Get +METHOD UnTransform() CLASS Get + local cBuffer local xValue - local cChar local nFor + local lMinus - DEFAULT cBuffer TO ::Buffer + if ! ::HasFocus + return NIL + endif -// if !::lEdit -// return ::VarGet() -// endif + cBuffer := ::cBuffer + + if ! ISCHARACTER( cBuffer ) + ::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 ) - cChar := SubStr( ::cPicMask, nFor, 1 ) - if !cChar $ "ANX9#!" + if !SubStr( ::cPicMask, nFor, 1 ) $ "ANX9#!LY" cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 ) endif next - cBuffer := PadR( StrTran( cBuffer, Chr( 1 ), "" ), Len( ::Original ) ) + xValue := PadR( StrTran( cBuffer, Chr( 1 ), "" ), Len( ::Original ) ) + else + xValue := cBuffer endif - xValue := cBuffer - case ::cType == "N" - //::lMinus := .f. + lMinus := .f. if "X" $ ::cPicFunc if Right( cBuffer, 2 ) == "DB" - ::lMinus := .t. + lMinus := .t. endif endif - if !::lMinus + 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. + if SubStr( cBuffer, nFor, 1 ) $ "-(" .and. !( SubStr( cBuffer, nFor, 1 ) == SubStr( ::cPicMask, nFor, 1 ) ) + lMinus := .t. exit endif next @@ -589,7 +608,7 @@ METHOD UnTransform( cBuffer ) CLASS Get if "D" $ ::cPicFunc 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 @@ -601,8 +620,8 @@ METHOD UnTransform( cBuffer ) CLASS Get 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 ) + if !::IsEditable( nFor ) .and. !( SubStr( cBuffer, nFor, 1 ) == "." ) + cBuffer := Left( cBuffer, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 ) endif next endif @@ -617,7 +636,7 @@ METHOD UnTransform( cBuffer ) CLASS Get cBuffer := PadL( StrTran( cBuffer, " ", "" ), Len( cBuffer ) ) - if ::lMinus + if lMinus for nFor := 1 to Len( cBuffer ) if IsDigit( SubStr( cBuffer, nFor, 1 ) ) exit @@ -625,25 +644,25 @@ METHOD UnTransform( cBuffer ) CLASS Get next nFor-- if nFor > 0 - cBuffer := Left( cBuffer, nFor-1 ) + "-" + SubStr( cBuffer, nFor+1 ) + cBuffer := Left( cBuffer, nFor - 1 ) + "-" + SubStr( cBuffer, nFor + 1 ) else cBuffer := "-" + cBuffer endif endif - xValue := Val( cBuffer ) + 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 - if cBuffer != NIL - xValue := CToD( cBuffer ) - endif + xValue := CToD( cBuffer ) endcase @@ -657,7 +676,7 @@ METHOD OverStrike( cChar ) CLASS Get return Self endif - if ::cType == "N" .and. ! ::lEdit .and. ::Clear + if ::cType == "N" .and. ! ::lEdit .and. ::lClear ::Pos := ::FirstEditable() endif @@ -675,32 +694,30 @@ METHOD OverStrike( cChar ) CLASS Get ::Rejected := .f. endif - if ::Clear .and. ::Pos == ::FirstEditable() + if ::lClear .and. ::nPos == ::FirstEditable() ::DeleteAll() - ::Clear := .f. + ::lClear := .f. endif ::lEdit := .t. - if ::Pos == 0 + if ::nPos == 0 ::Pos := 1 endif - do while ! ::IsEditable( ::Pos ) .and. ::Pos <= ::nMaxEdit + do while ! ::IsEditable( ::nPos ) .and. ::nPos <= ::nMaxEdit ::Pos++ enddo - if ::Pos > ::nMaxEdit + if ::nPos > ::nMaxEdit ::Pos := ::FirstEditable() endif - ::Buffer := SubStr( ::Buffer, 1, ::Pos - 1 ) + cChar + SubStr( ::Buffer, ::Pos + 1 ) + ::cBuffer := SubStr( ::cBuffer, 1, ::nPos - 1 ) + cChar + SubStr( ::cBuffer, ::nPos + 1 ) - ::Changed := .t. + ::lChanged := .t. ::Right( .f. ) - ::BadDate := ( ::cType == "D" ) .and. IsBadDate( ::Buffer, ::cPicFunc ) - ::Display() return Self @@ -718,11 +735,11 @@ METHOD Insert( cChar ) CLASS Get nMaxEdit := ::nMaxEdit - if ::cType == "N" .and. ! ::lEdit .and. ::Clear + if ::cType == "N" .and. ! ::lEdit .and. ::lClear ::Pos := ::FirstEditable() endif - if ::Pos > ::nMaxEdit + if ::nPos > ::nMaxEdit ::Rejected := .t. return Self endif @@ -736,47 +753,44 @@ METHOD Insert( cChar ) CLASS Get ::Rejected := .f. endif - if ::Clear .and. ::Pos == ::FirstEditable() + if ::lClear .and. ::nPos == ::FirstEditable() ::DeleteAll() - ::Clear := .f. + ::lClear := .f. endif ::lEdit := .t. - if ::Pos == 0 + if ::nPos == 0 ::Pos := 1 endif - do while ! ::IsEditable( ::Pos ) .and. ::Pos <= ::nMaxEdit + do while ! ::IsEditable( ::nPos ) .and. ::nPos <= ::nMaxEdit ::Pos++ enddo - if ::Pos > ::nMaxEdit + if ::nPos > ::nMaxEdit ::Pos := ::FirstEditable() endif if ::lPicComplex - // Calculating diferent nMaxEdit for ::lPicComplex - - for n := ::Pos to nMaxEdit + // Calculating different nMaxEdit for ::lPicComplex + for n := ::nPos to nMaxEdit if !::IsEditable( n ) exit endif next nMaxEdit := n - ::Buffer := Left( SubStr( ::Buffer, 1, ::Pos-1 ) + cChar +; - SubStr( ::Buffer, ::Pos, nMaxEdit-1-::Pos ) +; - SubStr( ::Buffer, nMaxEdit ), ::nMaxLen ) + ::cBuffer := Left( SubStr( ::cBuffer, 1, ::nPos - 1 ) + cChar +; + SubStr( ::cBuffer, ::nPos, nMaxEdit - 1 - ::nPos ) +; + SubStr( ::cBuffer, nMaxEdit ), ::nMaxLen ) else - ::Buffer := Left( SubStr( ::Buffer, 1, ::Pos-1 ) + cChar + SubStr( ::Buffer, ::Pos ), ::nMaxEdit ) + ::cBuffer := Left( SubStr( ::cBuffer, 1, ::nPos - 1 ) + cChar + SubStr( ::cBuffer, ::nPos ), ::nMaxEdit ) endif - ::Changed := .t. + ::lChanged := .t. ::Right( .f. ) - ::BadDate := ( ::cType == "D" ) .and. IsBadDate( ::Buffer, ::cPicFunc ) - ::Display() return Self @@ -794,14 +808,14 @@ METHOD _Right( lDisplay ) CLASS Get DEFAULT lDisplay TO .t. ::TypeOut := .f. - ::Clear := .f. + ::lClear := .f. - if ::Pos == ::nMaxEdit + if ::nPos == ::nMaxEdit ::TypeOut := .t. return Self endif - nPos := ::Pos + 1 + nPos := ::nPos + 1 do while ! ::IsEditable( nPos ) .and. nPos <= ::nMaxEdit nPos++ @@ -832,14 +846,14 @@ METHOD _Left( lDisplay ) CLASS Get DEFAULT lDisplay TO .t. ::TypeOut := .f. - ::Clear := .f. + ::lClear := .f. - if ::Pos == ::FirstEditable() + if ::nPos == ::FirstEditable() ::TypeOut := .t. return Self endif - nPos := ::Pos - 1 + nPos := ::nPos - 1 do while ! ::IsEditable( nPos ) .and. nPos > 0 nPos-- @@ -868,21 +882,21 @@ METHOD WordLeft() CLASS Get endif ::TypeOut := .f. - ::Clear := .f. + ::lClear := .f. - if ::Pos == ::FirstEditable() + if ::nPos == ::FirstEditable() ::TypeOut := .t. return Self endif - nPos := ::Pos - 1 + nPos := ::nPos - 1 do while nPos > 0 - if SubStr( ::Buffer, nPos, 1 ) == " " - do while nPos > 0 .and. SubStr( ::Buffer, nPos, 1 ) == " " + if SubStr( ::cBuffer, nPos, 1 ) == " " + do while nPos > 0 .and. SubStr( ::cBuffer, nPos, 1 ) == " " nPos-- enddo - do while nPos > 0 .and. !( SubStr( ::Buffer, nPos, 1 ) == " " ) + do while nPos > 0 .and. !( SubStr( ::cBuffer, nPos, 1 ) == " " ) nPos-- enddo if nPos > 0 @@ -916,18 +930,18 @@ METHOD WordRight() CLASS Get endif ::TypeOut := .f. - ::Clear := .f. + ::lClear := .f. - if ::Pos == ::nMaxEdit + if ::nPos == ::nMaxEdit ::TypeOut := .t. return Self endif - nPos := ::Pos + 1 + nPos := ::nPos + 1 do while nPos <= ::nMaxEdit - if SubStr( ::Buffer, nPos, 1 ) == " " - do while nPos <= ::nMaxEdit .and. SubStr( ::Buffer, nPos, 1 ) == " " + if SubStr( ::cBuffer, nPos, 1 ) == " " + do while nPos <= ::nMaxEdit .and. SubStr( ::cBuffer, nPos, 1 ) == " " nPos++ enddo exit @@ -951,30 +965,24 @@ return Self METHOD ToDecPos() CLASS Get - if ! ::HasFocus - return Self - endif + if ::HasFocus - if ::Pos == ::FirstEditable() - ::DeleteAll() - endif - - ::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 + if ::lClear + ::DelEnd() endif - else - ::Pos := ::nDispLen - endif - ::Display() + ::cBuffer := ::PutMask( ::UnTransform(), .f. ) + ::Pos := ::DecPos + ::lChanged := .t. + + if ::UnTransform() == 0 .and. ::lMinus + ::Backspace() + ::Overstrike("-") + endif + + ::Display() + + endif return Self @@ -988,15 +996,15 @@ METHOD IsEditable( nPos ) CLASS Get return .t. endif - if ::nMaxEdit == NIL .or. nPos > ::nMaxEdit + cChar := SubStr( ::cPicMask, nPos, 1 ) + + if Empty( cChar ) return .f. endif - cChar := SubStr( ::cPicMask, nPos, 1 ) - do case case ::cType == "C" - return cChar $ "!ANX9#" + return cChar $ "!ANX9#LY" case ::cType == "N" return cChar $ "9#$*" case ::cType == "D" @@ -1018,8 +1026,8 @@ METHOD Input( cChar ) CLASS Get do case case cChar == "-" - ::lMinus := .t. /* The minus symbol can be written in any place */ - ::Minus := .t. + ::lMinus2 := .t. /* The minus symbol can be written in any place */ + ::lMinus := .t. case cChar $ ".," ::toDecPos() @@ -1041,6 +1049,11 @@ METHOD Input( cChar ) CLASS Get return "" endif +// case !( ::cType == "C" ) +// +// ::Rejected := .T. +// return "" + endcase if ! Empty( ::cPicFunc ) @@ -1048,7 +1061,7 @@ METHOD Input( cChar ) CLASS Get endif if ! Empty( ::cPicMask ) - cPic := SubStr( ::cPicMask, ::Pos, 1 ) + cPic := SubStr( ::cPicMask, ::nPos, 1 ) // cChar := Transform( cChar, cPic ) // Above line eliminated because some get picture template symbols for @@ -1069,7 +1082,7 @@ METHOD Input( cChar ) CLASS Get if ! IsDigit( cChar ) .and. ! cChar $ "-+" cChar := "" endif - if ::cType != "N" .and. cChar $ "-+" + if !( ::cType == "N" ) .and. cChar $ "-+" cChar := "" endif @@ -1092,7 +1105,7 @@ METHOD Input( cChar ) CLASS Get endif case ( cPic == "$" .or. cPic == "*" ) .and. ::cType == "N" - if ! IsDigit( cChar ) .and. cChar != "-" + if ! IsDigit( cChar ) .and. !( cChar == "-" ) cChar := "" endif otherwise @@ -1109,26 +1122,25 @@ METHOD PutMask( xValue, lEdit ) CLASS Get local cChar local cBuffer local cPicFunc - local cMask + local cPicMask local nFor local nNoEditable := 0 - if ::cType == NIL - // Not initialized yet - ::Original := ::VarGet() - ::cType := ValType( ::Original ) - ::Picture := ::cPicture - endif +// if ::cType == NIL +// // Not initialized yet +// ::Original := ::VarGet() +// ::cType := ValType( ::Original ) +// ::Picture := ::cPicture +// endif cPicFunc := ::cPicFunc - cMask := ::cPicMask + cPicMask := ::cPicMask DEFAULT xValue TO ::VarGet() DEFAULT lEdit TO ::HasFocus - if xValue == NIL .or. ValType( xValue ) $ "AB" - ::nMaxLen := 0 - return NIL + if !( ValType( xValue ) $ "CNDL" ) + xValue := "" endif if ::HasFocus @@ -1138,8 +1150,8 @@ METHOD PutMask( xValue, lEdit ) CLASS Get endif endif if lEdit .and. ::lEdit - if ( "*" $ cMask ) .or. ( "$" $ cMask ) - cMask := StrTran( StrTran( cMask, "*", "9" ), "$", "9" ) + if ( "*" $ cPicMask ) .or. ( "$" $ cPicMask ) + cPicMask := StrTran( StrTran( cPicMask, "*", "9" ), "$", "9" ) endif endif @@ -1147,7 +1159,7 @@ METHOD PutMask( xValue, lEdit ) CLASS Get iif( Empty( cPicFunc ), ; iif( ::lCleanZero .and. !::HasFocus, "@Z ", "" ), ; cPicFunc + iif( ::lCleanZero .and. !::HasFocus, "Z", "" ) + " " ) ; - + cMask ) + + cPicMask ) if ::cType == "N" if ( "(" $ cPicFunc .or. ")" $ cPicFunc ) .and. xValue >= 0 @@ -1174,14 +1186,14 @@ METHOD PutMask( xValue, lEdit ) CLASS Get ::nDispLen := ::nMaxLen endif - if lEdit .and. ::cType == "N" .and. ! Empty( cMask ) + if lEdit .and. ::cType == "N" .and. ! Empty( cPicMask ) 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 ) + 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( cMask, nFor, 1 ) + cChar := SubStr( cPicMask, nFor, 1 ) if cChar $ ",." .and. SubStr( cBuffer, nFor, 1 ) $ ",." cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + cChar + SubStr( cBuffer, nFor + 1 ) endif @@ -1206,7 +1218,7 @@ METHOD PutMask( xValue, lEdit ) CLASS Get endif if ::cType == "D" .and. ::BadDate - cBuffer := ::Buffer + cBuffer := ::cBuffer endif return cBuffer @@ -1215,25 +1227,31 @@ return cBuffer METHOD BackSpace( lDisplay ) CLASS Get - local nPos := ::Pos + local nPos local nMinus + if ! ::HasFocus + return Self + endif + + nPos := ::nPos + DEFAULT lDisplay TO .t. - if nPos > 1 .and. nPos == ::FirstEditable() .and. ::lMinus + if nPos > 1 .and. nPos == ::FirstEditable() .and. ::lMinus2 /* To delete the parenthesis (negative indicator) in a non editable position */ - nMinus := At( "(", SubStr( ::Buffer, 1, nPos-1 ) ) + nMinus := At( "(", SubStr( ::cBuffer, 1, nPos-1 ) ) - if nMinus > 0 .and. SubStr( ::cPicMask, nMinus, 1 ) != "(" + if nMinus > 0 .and. !( SubStr( ::cPicMask, nMinus, 1 ) == "(" ) ::lEdit := .t. - ::Buffer := SubStr( ::Buffer, 1, nMinus - 1 ) + " " +; - SubStr( ::Buffer, nMinus + 1 ) + ::cBuffer := SubStr( ::cBuffer, 1, nMinus - 1 ) + " " +; + SubStr( ::cBuffer, nMinus + 1 ) - ::Changed := .t. + ::lChanged := .t. if lDisplay ::Display() @@ -1247,7 +1265,7 @@ METHOD BackSpace( lDisplay ) CLASS Get ::Left() - if ::Pos < nPos + if ::nPos < nPos ::Delete( lDisplay ) endif @@ -1257,16 +1275,23 @@ return Self METHOD _Delete( lDisplay ) CLASS Get - LOCAL nMaxLen := ::nMaxLen, n + local nMaxLen + local n + + if ! ::HasFocus + return Self + endif + + nMaxLen := ::nMaxLen DEFAULT lDisplay TO .t. - ::Clear := .f. + ::lClear := .f. ::lEdit := .t. if ::lPicComplex - // Calculating diferent nMaxLen for ::lPicComplex - for n := ::Pos to nMaxLen + // Calculating different nMaxLen for ::lPicComplex + for n := ::nPos to nMaxLen if !::IsEditable( n ) exit endif @@ -1274,21 +1299,15 @@ METHOD _Delete( lDisplay ) CLASS Get nMaxLen := n - 1 endif - if ::cType == "N" .and. SubStr( ::Buffer, ::Pos, 1 ) $ "(-" - ::lMinus := .f. + if ::cType == "N" .and. SubStr( ::cBuffer, ::nPos, 1 ) $ "(-" + ::lMinus2 := .f. endif - ::Buffer := PadR( SubStr( ::Buffer, 1, ::Pos - 1 ) + ; - SubStr( ::Buffer, ::Pos + 1, nMaxLen - ::Pos ) + " " +; - SubStr( ::Buffer, nMaxLen + 1 ), ::nMaxLen ) + ::cBuffer := PadR( SubStr( ::cBuffer, 1, ::nPos - 1 ) + ; + SubStr( ::cBuffer, ::nPos + 1, nMaxLen - ::nPos ) + " " +; + SubStr( ::cBuffer, nMaxLen + 1 ), ::nMaxLen ) - if ::cType == "D" - ::BadDate := IsBadDate( ::Buffer, ::cPicFunc ) - else - ::BadDate := .f. - endif - - ::Changed := .t. + ::lChanged := .t. if lDisplay ::Display() @@ -1302,6 +1321,10 @@ METHOD DeleteAll() CLASS Get local xValue + if ! ::HasFocus + return Self + endif + ::lEdit := .t. do case @@ -1309,16 +1332,15 @@ METHOD DeleteAll() CLASS Get xValue := Space( ::nMaxlen ) case ::cType == "N" xValue := 0 - ::lMinus := .f. + ::lMinus2 := .f. case ::cType == "D" xValue := CToD( "" ) - ::BadDate := .f. case ::cType == "L" xValue := .f. endcase - ::Buffer := ::PutMask( xValue, .t. ) - ::Pos := ::FirstEditable() + ::cBuffer := ::PutMask( xValue, .t. ) + ::Pos := ::FirstEditable() return Self @@ -1326,16 +1348,17 @@ return Self METHOD DelEnd() CLASS Get - local nPos := ::Pos + local nPos if ! ::HasFocus return Self endif + nPos := ::nPos ::Pos := ::nMaxEdit ::Delete( .f. ) - do while ::Pos > nPos + do while ::nPos > nPos ::BackSpace( .f. ) enddo @@ -1374,8 +1397,8 @@ METHOD DelWordLeft() CLASS Get return Self endif - if !( SubStr( ::Buffer, ::Pos, 1 ) == " " ) - if SubStr( ::Buffer, ::Pos - 1, 1 ) == " " + if !( SubStr( ::cBuffer, ::nPos, 1 ) == " " ) + if SubStr( ::cBuffer, ::nPos - 1, 1 ) == " " ::BackSpace( .f. ) else ::WordRight() @@ -1383,11 +1406,11 @@ METHOD DelWordLeft() CLASS Get endif endif - if SubStr( ::Buffer, ::Pos, 1 ) == " " + if SubStr( ::cBuffer, ::nPos, 1 ) == " " ::Delete( .f. ) endif - do while ::Pos > 1 .and. !( SubStr( ::Buffer, ::Pos - 1, 1 ) == " " ) + do while ::nPos > 1 .and. !( SubStr( ::cBuffer, ::nPos - 1, 1 ) == " " ) ::BackSpace( .f. ) enddo @@ -1404,18 +1427,18 @@ METHOD DelWordRight() CLASS Get endif ::TypeOut := .f. - ::Clear := .f. + ::lClear := .f. - if ::Pos == ::nMaxEdit + if ::nPos == ::nMaxEdit ::TypeOut := .t. return Self endif - do while ::Pos <= ::nMaxEdit .and. !( SubStr( ::Buffer, ::Pos, 1 ) == " " ) + do while ::nPos <= ::nMaxEdit .and. !( SubStr( ::cBuffer, ::nPos, 1 ) == " " ) ::Delete( .f. ) enddo - if ::Pos <= ::nMaxEdit + if ::nPos <= ::nMaxEdit ::Delete( .f. ) endif @@ -1434,24 +1457,83 @@ return Self METHOD ColorSpec( cColorSpec ) CLASS Get - local cClrUnSel + local nClrUns + local nClrEnh local cClrEnh - if cColorSpec != NIL + if PCount() == 0 + return ::cColorSpec + endif - cClrUnSel := iif( !Empty( hb_ColorIndex( cColorSpec, GET_CLR_UNSELECTED ) ),; - hb_ColorIndex( cColorSpec, GET_CLR_UNSELECTED ),; - hb_ColorIndex( SetColor(), CLR_UNSELECTED ) ) + if ISCHARACTER( cColorSpec ) - cClrEnh := iif( !Empty( hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ) ),; - hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ),; - cClrUnSel ) + nClrUns := hb_ColorToN( hb_ColorIndex( cColorSpec, GET_CLR_UNSELECTED ) ) + nClrEnh := hb_ColorToN( cClrEnh := hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ) ) - ::cColorSpec := cClrUnSel + "," + cClrEnh + ::cColorSpec := hb_NToColor( nClrUns ) +; + "," +; + hb_NToColor( iif( ( nClrEnh != 0 .or. Upper( StrTran( cClrEnh, " ", "" ) ) == "N/N" ), nClrEnh, nClrUns ) ) + + return cColorSpec endif -return ::cColorSpec +return iif( ValType( cColorSpec ) $ "UNDBA", NIL, cColorSpec ) /* ; CA-Cl*pper oddity [vszakats] */ + +/* ------------------------------------------------------------------------- */ + +METHOD Pos( nPos ) CLASS Get + + local tmp + + if PCount() == 0 + return ::nPos + endif + + if ISNUMBER( nPos ) + + if ::HasFocus + + do case + case nPos > ::nMaxLen + + if ::nMaxLen == 0 + ::nPos := 1 + else + ::nPos := ::nMaxLen + endif + ::TypeOut := .t. + + case nPos > 0 + + /* NOTE: CA-Cl*pper has a bug where negative nPos value will be translated to 16bit unsigned int, + so the behaviour will be different in this case. [vszakats] */ + + for tmp := nPos to ::nMaxLen + if ::IsEditable( tmp ) + ::nPos := tmp + return nPos + endif + next + for tmp := nPos - 1 to 1 step -1 + if ::IsEditable( tmp ) + ::nPos := tmp + return nPos + endif + next + + ::nPos := ::nMaxLen + 1 + ::TypeOut := .t. + + endcase + + endif + + return nPos + + endif + +return 0 /* ------------------------------------------------------------------------- */ @@ -1470,12 +1552,18 @@ METHOD Picture( cPicture ) CLASS Get local nFor local cNum - if cPicture != NIL + if PCount() == 0 .or. cPicture == NIL + return ::cPicture + endif + + ::cPicture := cPicture + ::cPicFunc := "" + ::cPicMask := "" + ::lPicComplex := .f. + + IF ISCHARACTER( cPicture ) ::nDispLen := NIL - - ::cPicture := cPicture - cNum := "" if Left( cPicture, 1 ) == "@" @@ -1532,10 +1620,10 @@ METHOD Picture( cPicture ) CLASS Get ::lCleanZero := .f. endif - if ::cType == NIL - ::Original := ::xVarGet - ::cType := ValType( ::Original ) - endif +// if ::cType == NIL +// ::Original := ::xVarGet +// ::cType := ValType( ::Original ) +// endif if ::cType == "D" ::cPicMask := LTrim( ::cPicMask ) @@ -1544,81 +1632,62 @@ METHOD Picture( cPicture ) CLASS Get // 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 - endif endif + + // 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" -return ::cPicture + ::cPicMask := Replicate( "9", Len( ::xVarGet ) ) + ::cPicFunc := "" + + endcase + + endif + + // Comprobar si tiene caracteres embebidos no modificables en la plantilla + + if ! Empty( ::cPicMask ) + for nFor := 1 to Len( ::cPicMask ) + cChar := SubStr( ::cPicMask, nFor, 1 ) + if !( cChar $ "!ANX9#" ) + ::lPicComplex := .t. + exit + endif + next + endif + +return cPicture /* ------------------------------------------------------------------------- */ METHOD Type() CLASS Get - ::cType := ValType( iif( ::HasFocus, ::xVarGet, ::VarGet() ) ) - -return ::cType +return ::cType := ValType( iif( ::HasFocus, ::xVarGet, ::VarGet() ) ) /* ------------------------------------------------------------------------- */ @@ -1633,15 +1702,15 @@ return ::cType METHOD Block( bBlock ) CLASS Get - if bBlock != NIL .and. !::HasFocus - - ::bBlock := bBlock - ::cType := ValType( ::Original ) - ::xVarGet := NIL - + if PCount() == 0 .or. bBlock == NIL + return ::bBlock endif -return ::bBlock + ::bBlock := bBlock + ::xVarGet := ::Original + ::cType := ValType( ::xVarGet ) + +return bBlock /* ------------------------------------------------------------------------- */ @@ -1649,12 +1718,12 @@ return ::bBlock METHOD HitTest( nMRow, nMCol ) CLASS Get - if ::Row != nMRow + if ::nRow != nMRow return HTNOWHERE endif - if nMCol >= ::Col .and. ; - nMCol <= ::Col + ::nDispLen + iif( ::cDelimit == NIL, 0, 2 ) + if nMCol >= ::nCol .and. ; + nMCol <= ::nCol + ::nDispLen + iif( ::cDelimit == NIL, 0, 2 ) return HTCLIENT endif @@ -1708,26 +1777,142 @@ METHOD LastEditable() CLASS Get /* ------------------------------------------------------------------------- */ -STATIC FUNCTION IsBadDate( cBuffer, cPicFunc ) +METHOD ResetPar() CLASS Get - local nFor, nLen - - if "E" $ cPicFunc - cBuffer := SubStr( cBuffer, 4, 3 ) + SubStr( cBuffer, 1, 3 ) + SubStr( cBuffer, 7 ) - endif - - if cBuffer == NIL .or. ! Empty( CToD( cBuffer ) ) - return .f. - endif - - nLen := Len( cBuffer ) - - for nFor := 1 to nLen - if IsDigit( SubStr( cBuffer, nFor, 1 ) ) - return .t. + ::nMaxLen := Len( ::cBuffer ) + + if ::cType == "N" + ::DecPos := At( iif( ::lDecRev .or. "E" $ ::cPicFunc, ",", "." ), ::cBuffer ) + if ::DecPos == 0 + ::DecPos := Len( ::cBuffer ) + 1 endif - next + ::lMinus2 := ( ::xVarGet < 0 ) + else + ::DecPos := 0 /* ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. [vszakats] */ + endif + + if ::nDispLen == NIL + ::nDispLen := ::nMaxLen + endif - return .f. +return Self /* ------------------------------------------------------------------------- */ + +METHOD Buffer( cBuffer ) CLASS Get + + if PCount() == 0 + return ::cBuffer + endif + +return iif( ::HasFocus, ::cBuffer := cBuffer, cBuffer ) + +/* ------------------------------------------------------------------------- */ + +/* NOTE: In contrary to CA-Cl*pper docs, this var is assignable. [vszakats] */ + +METHOD Changed( lChanged ) CLASS Get + + if PCount() == 0 + return ::lChanged + endif + + if ISLOGICAL( lChanged ) + return iif( ::HasFocus, ::lChanged := lChanged, lChanged ) + endif + +return .f. + +/* ------------------------------------------------------------------------- */ + +METHOD Clear( lClear ) CLASS Get + + if PCount() == 0 + return ::lClear + endif + + if ISLOGICAL( lClear ) + return iif( ::HasFocus, ::lClear := lClear, lClear ) + endif + +return .f. + +/* ------------------------------------------------------------------------- */ + +METHOD Minus( lMinus ) CLASS Get + + if PCount() == 0 + return ::lMinus + endif + + if ISLOGICAL( lMinus ) + return iif( ::HasFocus, ::lMinus := lMinus, lMinus ) + endif + +return .f. + +/* ------------------------------------------------------------------------- */ + +/* NOTE: CA-Cl*pper has a bug where negative nRow value will be translated to 16bit unsigned int, + so the behaviour will be different in this case. [vszakats] */ + +METHOD Row( nRow ) CLASS Get + + if PCount() > 0 + ::nRow := iif( ISNUMBER( nRow ), nRow, 0 ) + endif + +return ::nRow + +/* ------------------------------------------------------------------------- */ + +/* NOTE: CA-Cl*pper has a bug where negative nCol value will be translated to 16bit unsigned int, + so the behaviour will be different in this case. [vszakats] */ + +METHOD Col( nCol ) CLASS Get + + if PCount() > 0 + ::nCol := iif( ISNUMBER( nCol ), nCol, 0 ) + endif + +return ::nCol + +/* ------------------------------------------------------------------------- */ + +METHOD Name( cName ) CLASS Get + + if PCount() > 0 .and. cName != NIL + ::cName := cName + endif + +return ::cName + +/* ------------------------------------------------------------------------- */ + +#ifdef HB_COMPAT_XPP + +/* NOTE: Not tested or compared to XBase++. [vszakats] */ + +METHOD PosInBuffer( nRow, nCol ) CLASS Get + + if nRow == ::nRow .and. ; + nCol >= ::nCol + ::nPos - 1 .and. ; + nCol <= ::nCol + ::nMaxLen + + return nCol - ::nCol + 1 + endif + +return 0 + +#endif + +/* ------------------------------------------------------------------------- */ + +METHOD BadDate() CLASS Get + + local xValue + +return ::HasFocus .and. ; + ::Type == "D" .and. ; + ( xValue := ::UnTransform() ) == hb_SToD( "" ) .and. ; + !( ::cBuffer == Transform( xValue, ::cPicture ) ) diff --git a/harbour/source/vm/cmdarg.c b/harbour/source/vm/cmdarg.c index 5cad7b5092..25396202ef 100644 --- a/harbour/source/vm/cmdarg.c +++ b/harbour/source/vm/cmdarg.c @@ -119,8 +119,8 @@ BOOL hb_cmdargIsInternal( const char * szArg ) HB_TRACE(HB_TR_DEBUG, ("hb_cmdargIsInternal(%s)", szArg)); return strlen( szArg ) >= 2 && - szArg[ 0 ] == '/' && - szArg[ 1 ] == '/'; + ( ( szArg[ 0 ] == '/' && szArg[ 1 ] == '/' ) || + ( szArg[ 0 ] == '-' && szArg[ 1 ] == '-' ) ) ; } static char * hb_cmdargGet( const char * pszName, BOOL bRetValue ) diff --git a/harbour/source/vm/fm.c b/harbour/source/vm/fm.c index 43f60ad6b5..eeae480756 100644 --- a/harbour/source/vm/fm.c +++ b/harbour/source/vm/fm.c @@ -587,7 +587,7 @@ HB_EXPORT void hb_xexit( void ) /* Deinitialize fixed memory subsystem */ hb_conOutErr( hb_conNewLine(), 0 ); hb_conOutErr( "----------------------------------------", 0 ); hb_conOutErr( hb_conNewLine(), 0 ); - snprintf( buffer, sizeof( buffer ), "Total memory allocated: %li bytes (%li blocks)", s_lMemoryMaxConsumed, s_lMemoryMaxBlocks ); + snprintf( buffer, sizeof( buffer ), "Total memory allocated: %li bytes (%li block(s))", s_lMemoryMaxConsumed, s_lMemoryMaxBlocks ); hb_conOutErr( buffer, 0 ); if ( hLog ) @@ -606,7 +606,7 @@ HB_EXPORT void hb_xexit( void ) /* Deinitialize fixed memory subsystem */ if( s_lMemoryBlocks ) { hb_conOutErr( hb_conNewLine(), 0 ); - snprintf( buffer, sizeof( buffer ), "WARNING! Memory allocated but not released: %li bytes (%li blocks)", s_lMemoryConsumed, s_lMemoryBlocks ); + snprintf( buffer, sizeof( buffer ), "WARNING! Memory allocated but not released: %li bytes (%li block(s))", s_lMemoryConsumed, s_lMemoryBlocks ); hb_conOutErr( buffer, 0 ); if ( hLog ) fprintf( hLog, "%s\n", buffer ); diff --git a/harbour/tests/rto_get.prg b/harbour/tests/rto_get.prg index 6dfb2e68ca..195efa6f96 100644 --- a/harbour/tests/rto_get.prg +++ b/harbour/tests/rto_get.prg @@ -52,10 +52,12 @@ /* NOTE: This source can be compiled with both Harbour and CA-Cl*pper. */ +#include "common.ch" +#include "error.ch" #include "fileio.ch" #ifndef __HARBOUR__ - #define HB_OSNewLine() ( Chr( 13 ) + Chr( 10 ) ) + #define hb_OSNewLine() ( Chr( 13 ) + Chr( 10 ) ) #endif #translate TEST_LINE( ) => TEST_CALL( o, #, {|| } ) @@ -63,14 +65,38 @@ STATIC s_cTest := "" STATIC s_xVar := NIL STATIC s_fhnd +STATIC s_lCallBackStack +STATIC s_lRTEDetails +STATIC s_lC5xDump -FUNCTION Main() +FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) LOCAL nInt01 := 98 - LOCAL nStr01 := "AbC DeF 974" + LOCAL cStr01 := "AbC DF 974" + LOCAL cStr02E := "" + LOCAL dDate01 LOCAL bOldBlock LOCAL o + LOCAL cCommandLine + + DEFAULT cArg01 TO "" + DEFAULT cArg02 TO "" + DEFAULT cArg03 TO "" + DEFAULT cArg04 TO "" + + SET DATE ANSI + + // ; + + cCommandLine := cArg01 + " " + cArg02 + " " + cArg03 + " " + cArg04 + + s_lCallBackStack := "CALLBACKSTACK" $ Upper( cCommandLine ) + s_lRTEDetails := "RTEDETAILS" $ Upper( cCommandLine ) + s_lC5xDump := "C5XDUMP" $ Upper( cCommandLine ) + + // ; + #ifdef __HARBOUR__ s_fhnd := FCreate( "tget_hb.txt", FC_NORMAL ) #else @@ -81,20 +107,184 @@ FUNCTION Main() RETURN 1 ENDIF + FWrite( s_fhnd, Set( _SET_DATEFORMAT ) + hb_OSNewLine() ) + + // ; Picture + + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999999999",, ) + TEST_LINE( o:Picture := "99" ) + TEST_LINE( o:Picture := "!!" ) + TEST_LINE( o:Picture := NIL ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Picture := "99" ) + TEST_LINE( o:Picture := "!!" ) + TEST_LINE( o:Picture := NIL ) + + // ; Assign + + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999999999",, ) + o:SetFocus() + TEST_LINE( o:OverStrike( "z" ) ) + TEST_LINE( o:Assign() ) + + // ; Buffer + + s_xVar := "abcdefg" + SetPos( 14, 14 ) ; o := _GET_( s_xVar, "s_xVar",,, ) + TEST_LINE( o:buffer := "1234567" ) + TEST_LINE( o:buffer := "abcdefg" ) + + s_xVar := "abcdefg" + SetPos( 14, 14 ) ; o := _GET_( s_xVar, "s_xVar",,, ) + o:SetFocus() + TEST_LINE( o:buffer := "1234567" ) + TEST_LINE( o:buffer := "abcdefg" ) + + // ; Clear + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, ) + TEST_LINE( o:Clear := .T. ) + TEST_LINE( o:Clear := .F. ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Clear := .T. ) + TEST_LINE( o:Clear := .F. ) + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, ) + TEST_LINE( o:Clear := .T. ) + TEST_LINE( o:Clear := .F. ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Clear := .F. ) + TEST_LINE( o:Clear := .T. ) + + // ; Minus + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, ) + TEST_LINE( o:Minus := .T. ) + TEST_LINE( o:Minus := .F. ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Minus := .T. ) + TEST_LINE( o:Minus := .F. ) + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, ) + TEST_LINE( o:Minus := .F. ) + TEST_LINE( o:Minus := .T. ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Minus := .F. ) + TEST_LINE( o:Minus := .T. ) + + // ; Changed + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, ) + TEST_LINE( o:Changed := .T. ) + TEST_LINE( o:Changed := .F. ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Changed := .T. ) + TEST_LINE( o:Changed := .F. ) + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, ) + TEST_LINE( o:Changed := .F. ) + TEST_LINE( o:Changed := .T. ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Changed := .F. ) + TEST_LINE( o:Changed := .T. ) + + // ; ColorSpec + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01",,, ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "" ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := ",N/G" ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G" ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "," ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N/N" ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N /N" ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N/ N" ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G, N/N" ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G, N/N " ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,hkjhkj" ) + o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "n/g,n/bg" ) + + // ; Pos + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, ) + o:SetFocus() + TEST_LINE( o:Pos := 5 ) + TEST_LINE( o:ToDecPos() ) + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.",, ) + o:SetFocus() + TEST_LINE( o:Pos := 5 ) + TEST_LINE( o:ToDecPos() ) + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999",, ) + o:SetFocus() + TEST_LINE( o:Pos := 5 ) + TEST_LINE( o:ToDecPos() ) + TEST_LINE( o:Pos := 0 ) + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999",, ) + o:SetFocus() + TEST_LINE( o:Pos := 10 ) + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999",, ) + o:SetFocus() + TEST_LINE( o:Pos := 0 ) + + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999--9999",, ) + o:SetFocus() + TEST_LINE( o:Pos := 5 ) + TEST_LINE( o:Pos := 6 ) + + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999------",, ) + o:SetFocus() + TEST_LINE( o:Pos := 5 ) + TEST_LINE( o:Pos := 6 ) + + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "----------",, ) + o:SetFocus() + TEST_LINE( o:Pos := 5 ) + TEST_LINE( o:Pos := 6 ) + + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999999999",, ) + o:SetFocus() + TEST_LINE( o:Pos := 11 ) + + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999999999",, ) + o:SetFocus() +// TEST_LINE( o:Pos := -2 ) + + SetPos( 14, 14 ) ; o := _GET_( cStr02E, "cStr02E",,, ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Pos := 1 ) + + // ; Error conditions + + TGetAssign( NIL ) +// TGetAssign( -1 ) // ; CA-Cl*pper has too many differences due to the low level implementation here + TGetAssign( 0 ) + TGetAssign( 1 ) + TGetAssign( 3 ) + TGetAssign( 100 ) + TGetAssign( "" ) + TGetAssign( "az" ) + TGetAssign( hb_SToD( "20070425" ) ) + TGetAssign( .F. ) + TGetAssign( .T. ) + TGetAssign( {|| NIL } ) + TGetAssign( {} ) + TGetAssign( { "" } ) + // ; Type change N -> C - SetPos( 14, 14 ) - o := _GET_( nInt01, "nInt01",,, ) + 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:block := {| h | LogMe( h ), iif( h == NIL, cStr01, cStr01 := h ) } ) TEST_LINE( o:SetFocus() ) // ; Reform - SetPos( 14, 14 ) - o := _GET_( nStr01, "nStr01",,, ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) TEST_LINE( GET_CREATE() ) TEST_LINE( o:SetFocus() ) TEST_LINE( o:picture := "!!!!!!!!" ) @@ -105,8 +295,7 @@ FUNCTION Main() // ; Minus - SetPos( 14, 14 ) - o := _GET_( nInt01, "nInt01",,, ) + 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 ) ) } ) @@ -117,38 +306,411 @@ FUNCTION Main() o:minus := .T. TEST_LINE( o:SetFocus() ) + // ; + + SET CENTURY ON + + SetPos( 14, 14 ) ; dDate01 := hb_SToD( "20070425" ) + o := _GET_( dDate01, "dDate01" ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:OverStrike("12345678") ) + TEST_LINE( o:KillFocus() ) + + SetPos( 14, 14 ) ; dDate01 := hb_SToD( "20070425" ) + o := _GET_( dDate01, "dDate01", "@E" ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:OverStrike("12345678") ) + TEST_LINE( o:KillFocus() ) + + SET CENTURY OFF + + SetPos( 14, 14 ) ; dDate01 := hb_SToD( "20070425" ) + o := _GET_( dDate01, "dDate01" ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:OverStrike("12345678") ) + TEST_LINE( o:KillFocus() ) + + SetPos( 14, 14 ) ; dDate01 := hb_SToD( "20070425" ) + o := _GET_( dDate01, "dDate01", "@E" ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:OverStrike("12345678") ) + TEST_LINE( o:KillFocus() ) + + SetPos( 14, 14 ) ; cStr01 := "hello world" + o := _GET_( cStr01, "cStr01", "!!LY!!!!!!" ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:OverStrike("12345678") ) + TEST_LINE( o:KillFocus() ) + + SetPos( 14, 14 ) ; cStr01 := "hello world" + o := _GET_( cStr01, "cStr01", "!!!.!!!!!!" ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:OverStrike("12345678") ) + TEST_LINE( o:KillFocus() ) + + SetPos( 14, 14 ) ; cStr01 := "hello world" + o := _GET_( cStr01, "cStr01", "@R !!LY!!!!!!" ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:OverStrike("12345678") ) + TEST_LINE( o:KillFocus() ) + + SetPos( 14, 14 ) ; cStr01 := "hello world" + o := _GET_( cStr01, "cStr01", "@R !!!.!!!!!!" ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:OverStrike("12345678") ) + TEST_LINE( o:KillFocus() ) + // ; Exercises TGetTest( 98, NIL ) + TGetTest( 98, "99999" ) + TGetTest( 98, "99999." ) TGetTest( 98, "99999.99" ) TGetTest( -98, NIL ) + TGetTest( -98, "99999" ) + TGetTest( -98, "99999." ) TGetTest( -98, "99999.99" ) TGetTest( "hello world", NIL ) TGetTest( "hello world", "@!" ) TGetTest( "hello world", "!!!" ) TGetTest( "hello world", "@S5" ) + TGetTest( .T., NIL ) + TGetTest( .T., "Y" ) + SET CENTURY ON + TGetTest( hb_SToD( "20070425" ), NIL ) + SET CENTURY OFF + TGetTest( hb_SToD( "20070425" ), NIL ) + TGetTest( NIL, NIL ) + TGetTest( NIL, "!!!!" ) + TGetTest( {|| "" }, NIL ) FClose( s_fhnd ) RETURN 0 +PROCEDURE TGetAssign( xVar ) + LOCAL o + LOCAL nInt01 := 76 + LOCAL cStr01 := "AbC DeF 974" + LOCAL dDat01 := hb_SToD( "20070425" ) + LOCAL lLog01 := .F. + LOCAL bBlo01 := {|| NIL } + + s_xVar := xVar + + s_cTest := "Non-Focus Assign To N: " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:BadDate := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Block := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Buffer := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Cargo := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Changed := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Clear := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Col := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:ColorSpec := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:DecPos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:ExitState := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:HasFocus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Minus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Name := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Original := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Picture := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Pos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:PostBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:PreBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Reader := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Rejected := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Row := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:SubScript := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Type := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:TypeOut := xVar ) + + s_cTest := "Non-Focus Assign To C: " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:BadDate := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Block := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Buffer := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Cargo := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Changed := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Clear := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Col := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:ColorSpec := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:DecPos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:ExitState := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:HasFocus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Minus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Name := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Original := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Picture := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Pos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:PostBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:PreBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Reader := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Rejected := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Row := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:SubScript := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Type := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:TypeOut := xVar ) + + s_cTest := "Non-Focus Assign To D: " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:BadDate := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Block := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Buffer := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Cargo := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Changed := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Clear := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Col := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:ColorSpec := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:DecPos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:ExitState := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:HasFocus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Minus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Name := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Original := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Picture := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Pos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:PostBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:PreBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Reader := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Rejected := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Row := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:SubScript := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Type := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:TypeOut := xVar ) + + s_cTest := "Non-Focus Assign To L: " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:BadDate := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Block := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Buffer := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Cargo := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Changed := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Clear := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Col := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:ColorSpec := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:DecPos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:ExitState := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:HasFocus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Minus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Name := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Original := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Picture := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Pos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:PostBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:PreBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Reader := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Rejected := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Row := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:SubScript := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Type := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:TypeOut := xVar ) + + s_cTest := "Non-Focus Assign To B: " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:BadDate := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Block := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Buffer := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Cargo := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Changed := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Clear := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Col := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:ColorSpec := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:DecPos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:ExitState := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:HasFocus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Minus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Name := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Original := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Picture := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Pos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:PostBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:PreBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Reader := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Rejected := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Row := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:SubScript := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Type := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:TypeOut := xVar ) + + s_cTest := "InFocus Assign to N: " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:BadDate := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Block := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Buffer := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Cargo := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Changed := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Clear := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Col := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:ColorSpec := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:DecPos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:ExitState := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:HasFocus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Minus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Name := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Original := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Picture := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Pos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:PostBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:PreBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Reader := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Rejected := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Row := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:SubScript := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Type := xVar ) + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar ) + + s_cTest := "InFocus Assign to C: " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:BadDate := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Block := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Buffer := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Cargo := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Changed := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Clear := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Col := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:ColorSpec := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:DecPos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:ExitState := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:HasFocus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Minus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Name := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Original := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Picture := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Pos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:PostBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:PreBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Reader := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Rejected := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Row := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:SubScript := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Type := xVar ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar ) + + s_cTest := "InFocus Assign to D: " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:BadDate := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Block := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Buffer := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Cargo := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Changed := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Clear := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Col := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:ColorSpec := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:DecPos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:ExitState := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:HasFocus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Minus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Name := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Original := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Picture := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Pos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:PostBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:PreBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Reader := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Rejected := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Row := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:SubScript := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Type := xVar ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar ) + + s_cTest := "InFocus Assign to L: " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:BadDate := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Block := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Buffer := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Cargo := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Changed := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Clear := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Col := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:ColorSpec := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:DecPos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:ExitState := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:HasFocus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Minus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Name := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Original := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Picture := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Pos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:PostBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:PreBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Reader := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Rejected := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Row := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:SubScript := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Type := xVar ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar ) + + s_cTest := "InFocus Assign to B: " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:BadDate := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Block := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Buffer := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Cargo := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Changed := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Clear := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Col := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:ColorSpec := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:DecPos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:ExitState := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:HasFocus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Minus := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Name := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Original := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Picture := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Pos := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:PostBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:PreBlock := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Reader := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Rejected := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Row := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:SubScript := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Type := xVar ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar ) + + s_cTest := "InFocus/SetFocus " + XToStr( xVar ) + + SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:SetFocus ) + SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:SetFocus ) + SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:SetFocus ) + SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:SetFocus ) + SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:SetFocus ) + + RETURN + PROCEDURE TGetTest( xVar, cPic ) LOCAL bOldBlock LOCAL o s_xVar := xVar + // ; Display + + s_cTest := "Display Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic ) + + SetPos( 14, 14 ) ; o := _GET_( s_xVar, "s_xVar" ) + TEST_LINE( GET_CREATE() ) + TEST_LINE( o:Display() ) + // ; In focus s_cTest := "InFocus Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic ) - SetPos( 14, 14 ) - o := _GET_( s_xVar, "s_xVar",,, ) + 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 := "99999" ) TEST_LINE( o:picture := cPic ) TEST_LINE( o:picture := NIL ) ENDIF @@ -162,12 +724,12 @@ PROCEDURE TGetTest( xVar, cPic ) s_cTest := "NotFocus Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic ) - SetPos( 14, 14 ) - o := _GET_( s_xVar, "s_xVar",,, ) + 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 := "99999" ) TEST_LINE( o:picture := cPic ) TEST_LINE( o:picture := NIL ) ENDIF @@ -181,8 +743,7 @@ PROCEDURE TGetTest( xVar, cPic ) s_cTest := "InFocus #2 Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic ) - SetPos( 14, 14 ) - o := _GET_( s_xVar, "s_xVar",,, ) + 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() ) @@ -213,9 +774,23 @@ PROCEDURE TGetTest( xVar, cPic ) RETURN PROCEDURE TEST_CALL( o, cBlock, bBlock ) - LOCAL xRetVal := Eval( bBlock ) + LOCAL xResult + LOCAL bOldError + LOCAL oError - LogGETVars( o, cBlock, xRetVal ) + SetPos( 0, 0 ) // ; To check where the cursor was moved after evaluating the block. + + bOldError := ErrorBlock( {|oError| Break( oError ) } ) + + BEGIN SEQUENCE + xResult := Eval( bBlock ) + RECOVER USING oError + xResult := ErrorMessage( oError ) + END SEQUENCE + + ErrorBlock( bOldError ) + + LogGETVars( o, cBlock, xResult ) RETURN @@ -224,7 +799,7 @@ PROCEDURE LogMe( data, desc ) LOCAL cStack cStack := "" - FOR nLevel := 2 TO 2 + FOR nLevel := 2 TO 5 IF Empty( ProcName( nLevel ) ) EXIT ENDIF @@ -236,17 +811,19 @@ PROCEDURE LogMe( data, desc ) ENDIF desc := s_cTest + " " + desc - cStack := "" + IF !s_lCallBackStack + cStack := "" + ENDIF IF PCount() > 2 - FWrite( s_fhnd, cStack + "BLOCK_SET " + iif( data == NIL, "NIL", data ) + " " + desc + HB_OSNewLine() ) + FWrite( s_fhnd, cStack + "BLOCK_SET " + iif( data == NIL, "NIL", data ) + " " + desc + hb_OSNewLine() ) ELSE - FWrite( s_fhnd, cStack + "BLOCK_GET " + desc + HB_OSNewLine() ) + FWrite( s_fhnd, cStack + "BLOCK_GET " + desc + hb_OSNewLine() ) ENDIF RETURN -PROCEDURE LogGETVars( o, desc, xRetVal ) +PROCEDURE LogGETVars( o, desc, xResult ) LOCAL nLevel LOCAL cStack @@ -263,40 +840,59 @@ PROCEDURE LogGETVars( o, desc, xRetVal ) 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() ) + 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, " xResult " + XToStr( xResult ) + hb_OSNewLine() ) + FWrite( s_fhnd, " Row() " + XToStr( Row() ) + hb_OSNewLine() ) + FWrite( s_fhnd, " Col() " + XToStr( Col() ) + hb_OSNewLine() ) + FWrite( s_fhnd, " UnTransform() " + XToStr( o:UnTransform() ) + 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() ) +#ifndef __HARBOUR + IF s_lC5xDump + FWrite( s_fhnd, " _dump_ " + GetToList( o ) + hb_OSNewLine() ) + ENDIF +#endif + FWrite( s_fhnd, "---------------------" + hb_OSNewLine() ) RETURN +STATIC FUNCTION GetToList( o ) + LOCAL cString := "" + LOCAL tmp + + FOR tmp := 1 TO Len( o ) + cString += XToStr( o[ tmp ] ) + IF tmp < Len( o ) + cString += ", " + ENDIF + NEXT + + RETURN cString + FUNCTION XToStr( xValue ) LOCAL cType := ValType( xValue ) @@ -323,6 +919,123 @@ FUNCTION XToStr( xValue ) RETURN "" +FUNCTION XToStrE( 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 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 "" + +STATIC FUNCTION ErrorMessage( oError ) + LOCAL cMessage := "" + LOCAL tmp + + IF s_lRTEDetails + + IF ValType( oError:severity ) == "N" + DO CASE + CASE oError:severity == ES_WHOCARES ; cMessage += "M " + CASE oError:severity == ES_WARNING ; cMessage += "W " + CASE oError:severity == ES_ERROR ; cMessage += "E " + CASE oError:severity == ES_CATASTROPHIC ; cMessage += "C " + ENDCASE + ENDIF + IF ValType( oError:subsystem ) == "C" + cMessage += oError:subsystem + " " + ENDIF + IF ValType( oError:subCode ) == "N" + cMessage += LTrim( Str( oError:subCode ) ) + " " + ENDIF + IF ValType( oError:description ) == "C" + cMessage += oError:description + " " + ENDIF + IF !Empty( oError:operation ) + cMessage += oError:operation + " " + ENDIF + IF !Empty( oError:filename ) + cMessage += oError:filename + " " + ENDIF + + IF ValType( oError:Args ) == "A" + cMessage += "A:" + LTrim( Str( Len( oError:Args ) ) ) + ":" + FOR tmp := 1 TO Len( oError:Args ) + cMessage += ValType( oError:Args[ tmp ] ) + ":" + XToStrE( oError:Args[ tmp ] ) + IF tmp < Len( oError:Args ) + cMessage += ";" + ENDIF + NEXT + cMessage += " " + ENDIF + + IF oError:canDefault .OR. ; + oError:canRetry .OR. ; + oError:canSubstitute + + cMessage += "F:" + IF oError:canDefault + cMessage += "D" + ENDIF + IF oError:canRetry + cMessage += "R" + ENDIF + IF oError:canSubstitute + cMessage += "S" + ENDIF + ENDIF + ENDIF + + RETURN cMessage + +#ifdef __XPP__ +FUNCTION HB_SToD( cDate ) + RETURN SToD( cDate ) +#endif + +#ifndef HAVE_HBCLIP +#ifndef __HARBOUR__ +#ifndef __XPP__ + +FUNCTION HB_SToD( cDate ) + LOCAL cOldDateFormat + LOCAL dDate + + IF ValType( cDate ) == "C" .AND. !Empty( cDate ) + cOldDateFormat := Set( _SET_DATEFORMAT, "yyyy/mm/dd" ) + + dDate := CToD( SubStr( cDate, 1, 4 ) + "/" +; + SubStr( cDate, 5, 2 ) + "/" +; + SubStr( cDate, 7, 2 ) ) + + Set( _SET_DATEFORMAT, cOldDateFormat ) + ELSE + dDate := CToD( "" ) + ENDIF + + RETURN dDate + +#endif +#endif +#endif + PROCEDURE GET_CREATE() // ; Dummy