From e8777b2dfd0c3ede9b1dfafe7d55aa516e086d87 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 4 Feb 2009 18:21:23 +0000 Subject: [PATCH] 2009-02-04 19:20 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * include/hbextern.ch * source/rtl/tbcolumn.prg * source/rtl/tbrowse.prg * source/rtl/tget.prg * source/rtl/tgetx.prg ! Using new method to solve the GET()/TBROWSE()/TBCOLUMN() symbol problem (these aren't public symbols in Clipper). The method used is the one already implemented for other C53 CUI classes. This allows inheritance, doesn't mess up the class name, and won't declare above public symbols. * Moved Xbase++ compatible GET()/TBROWSE()/TBCOLUMN() functionality into separate classes, all inheriting from original Harbour classes. This means that Xbase++ compatible methods are only accessible when using the derived classes. The separation will allow us to move XPP (and other HB_COMPAT_*) compatible functionality into a separate libraries in the future, allowing more freedom to resolve clashing features, symbol names, etc.. * Xbase++ compatible classes are named: xpp_Get(), xpp_TBrowse(), xpp_TBColumn(). This is a slight incompatibility compared to Xbase++ and also to previous Harbour. Technically it seems possible to give them the names GET()/TBROWSE()/TBCOLUMN(), if the class is defined in a different file, but let's first discuss it. * source/rtl/tgetint.prg * Using GetNew() instead of Get():New(). ; Finally I didn't use '( ... )' to pass parameters in GetNew(), as it's a tiny bit less efficient with -gc3. * include/hbusrrdd.ch * include/hbapi.h + Comment. --- harbour/ChangeLog | 38 ++++++++ harbour/include/hbapi.h | 2 +- harbour/include/hbextern.ch | 5 +- harbour/include/hbusrrdd.ch | 2 +- harbour/source/rtl/tbcolumn.prg | 59 +++++++------ harbour/source/rtl/tbrowse.prg | 73 +++++++++++++--- harbour/source/rtl/tget.prg | 150 ++++++++++++++++---------------- harbour/source/rtl/tgetint.prg | 4 +- harbour/source/rtl/tgetx.prg | 10 +-- 9 files changed, 217 insertions(+), 126 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f87fc219db..60c35dcfbd 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,44 @@ 2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2009-02-04 19:20 UTC+0100 Viktor Szakats (harbour.01 syenar hu) + * include/hbextern.ch + * source/rtl/tbcolumn.prg + * source/rtl/tbrowse.prg + * source/rtl/tget.prg + * source/rtl/tgetx.prg + ! Using new method to solve the GET()/TBROWSE()/TBCOLUMN() + symbol problem (these aren't public symbols in Clipper). + The method used is the one already implemented for other + C53 CUI classes. + This allows inheritance, doesn't mess up the class name, + and won't declare above public symbols. + * Moved Xbase++ compatible GET()/TBROWSE()/TBCOLUMN() + functionality into separate classes, all inheriting from + original Harbour classes. This means that Xbase++ + compatible methods are only accessible when using the + derived classes. The separation will allow us to + move XPP (and other HB_COMPAT_*) compatible functionality + into a separate libraries in the future, allowing more + freedom to resolve clashing features, symbol names, etc.. + * Xbase++ compatible classes are named: xpp_Get(), + xpp_TBrowse(), xpp_TBColumn(). This is a slight + incompatibility compared to Xbase++ and also to + previous Harbour. Technically it seems possible + to give them the names GET()/TBROWSE()/TBCOLUMN(), if + the class is defined in a different file, but let's first + discuss it. + + * source/rtl/tgetint.prg + * Using GetNew() instead of Get():New(). + + ; Finally I didn't use '( ... )' to pass parameters in GetNew(), + as it's a tiny bit less efficient with -gc3. + + * include/hbusrrdd.ch + * include/hbapi.h + + Comment. + 2009-02-04 14:42 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * include/hbextern.ch * common.mak diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 086d45bc99..bd6bae3f15 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -444,7 +444,7 @@ typedef USHORT HB_ERRCODE; #define HB_SUCCESS 0 #define HB_FAILURE 1 -/* Compatibility #defines */ +/* Compatibility #defines. Don't use them with new code and in Harbour sources. */ #define ERRCODE HB_ERRCODE #define SUCCESS HB_SUCCESS #define FAILURE HB_FAILURE diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index a5eb1617ff..23be05edc2 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -780,7 +780,9 @@ EXTERNAL SHOWMSG #ifdef HB_COMPAT_XPP -EXTERNAL GET +EXTERNAL XPP_GET +EXTERNAL XPP_TBROWSE +EXTERNAL XPP_TBCOLUMN EXTERNAL BIN2U EXTERNAL DBPACK EXTERNAL DBZAP @@ -1321,7 +1323,6 @@ EXTERNAL HBLOGICAL EXTERNAL HBNIL EXTERNAL HBNUMERIC #endif /* HB_REQUEST_SCALAR */ -EXTERNAL HBGET /* FlagShip extension */ diff --git a/harbour/include/hbusrrdd.ch b/harbour/include/hbusrrdd.ch index 54cb394e98..c9cf6e5c16 100644 --- a/harbour/include/hbusrrdd.ch +++ b/harbour/include/hbusrrdd.ch @@ -359,6 +359,6 @@ #define HB_SUCCESS 0 #define HB_FAILURE 1 -/* Compatibility #defines */ +/* Compatibility #defines. Don't use them with new code and in Harbour sources. */ #define SUCCESS HB_SUCCESS #define FAILURE HB_FAILURE diff --git a/harbour/source/rtl/tbcolumn.prg b/harbour/source/rtl/tbcolumn.prg index 6cbaebf7b9..52e40edaaf 100644 --- a/harbour/source/rtl/tbcolumn.prg +++ b/harbour/source/rtl/tbcolumn.prg @@ -56,15 +56,9 @@ #include "common.ch" #include "tbrowse.ch" -/* NOTE: In CA-Cl*pper TBCOLUMN class does not inherit from any other classes - and there is no public class function like TBColumn(). There is - in XPP though. */ +/* NOTE: In CA-Cl*pper TBCOLUMN class does not inherit from any other classes. */ -#if defined( HB_C52_STRICT ) .AND. !defined( HB_COMPAT_XPP ) -CREATE CLASS TBColumn STATIC -#else -CREATE CLASS TBColumn -#endif +CREATE CLASS TBCOLUMN FUNCTION HBBColumn EXPORTED: @@ -96,17 +90,17 @@ CREATE CLASS TBColumn METHOD headSep( cHeadSep ) SETGET /* Heading separator character */ METHOD footSep( cFootSep ) SETGET /* Footing separator character */ METHOD width( nWidth ) SETGET /* Column display width */ -#ifdef HB_COMPAT_C53 +#ifdef HB_COMPAT_C53 METHOD preBlock( bPreBlock ) SETGET /* Code block determining editing */ METHOD postBlock( bPostBlock ) SETGET /* Code block validating values */ - METHOD setStyle( nStyle, lSetting ) -#endif - + METHOD setStyle( nStyle, lSetting ) +#endif + METHOD New( cHeading, bBlock ) /* NOTE: This method is a Harbour extension [vszakats] */ ENDCLASS -METHOD block( bBlock ) CLASS TBColumn +METHOD block( bBlock ) CLASS TBCOLUMN IF bBlock != NIL ::bBlock := __eInstVar53( Self, "BLOCK", bBlock, "B", 1001 ) @@ -114,7 +108,7 @@ METHOD block( bBlock ) CLASS TBColumn RETURN ::bBlock -METHOD colorBlock( bColorBlock ) CLASS TBColumn +METHOD colorBlock( bColorBlock ) CLASS TBCOLUMN IF bColorBlock != NIL ::bColorBlock := __eInstVar53( Self, "COLORBLOCK", bColorBlock, "B", 1001 ) @@ -122,7 +116,7 @@ METHOD colorBlock( bColorBlock ) CLASS TBColumn RETURN ::bColorBlock -METHOD defColor( aDefColor ) CLASS TBColumn +METHOD defColor( aDefColor ) CLASS TBCOLUMN IF aDefColor != NIL ::aDefColor := __eInstVar53( Self, "DEFCOLOR", aDefColor, "A", 1001 ) @@ -130,7 +124,7 @@ METHOD defColor( aDefColor ) CLASS TBColumn RETURN ::aDefColor -METHOD colSep( cColSep ) CLASS TBColumn +METHOD colSep( cColSep ) CLASS TBCOLUMN IF cColSep != NIL ::cColSep := __eInstVar53( Self, "COLSEP", cColSep, "C", 1001 ) @@ -138,7 +132,7 @@ METHOD colSep( cColSep ) CLASS TBColumn RETURN ::cColSep -METHOD heading( cHeading ) CLASS TBColumn +METHOD heading( cHeading ) CLASS TBCOLUMN IF cHeading != NIL ::cHeading := __eInstVar53( Self, "HEADING", cHeading, "C", 1001 ) @@ -146,7 +140,7 @@ METHOD heading( cHeading ) CLASS TBColumn RETURN ::cHeading -METHOD footing( cFooting ) CLASS TBColumn +METHOD footing( cFooting ) CLASS TBCOLUMN IF cFooting != NIL ::cFooting := __eInstVar53( Self, "FOOTING", cFooting, "C", 1001 ) @@ -154,7 +148,7 @@ METHOD footing( cFooting ) CLASS TBColumn RETURN ::cFooting -METHOD headSep( cHeadSep ) CLASS TBColumn +METHOD headSep( cHeadSep ) CLASS TBCOLUMN IF cHeadSep != NIL ::cHeadSep := __eInstVar53( Self, "HEADSEP", cHeadSep, "C", 1001 ) @@ -162,7 +156,7 @@ METHOD headSep( cHeadSep ) CLASS TBColumn RETURN ::cHeadSep -METHOD footSep( cFootSep ) CLASS TBColumn +METHOD footSep( cFootSep ) CLASS TBCOLUMN IF cFootSep != NIL ::cFootSep := __eInstVar53( Self, "FOOTSEP", cFootSep, "C", 1001 ) @@ -170,7 +164,7 @@ METHOD footSep( cFootSep ) CLASS TBColumn RETURN ::cFootSep -METHOD width( nWidth ) CLASS TBColumn +METHOD width( nWidth ) CLASS TBCOLUMN IF nWidth != NIL ::nWidth := __eInstVar53( Self, "WIDTH", nWidth, "N", 1001 ) @@ -180,7 +174,7 @@ METHOD width( nWidth ) CLASS TBColumn #ifdef HB_COMPAT_C53 -METHOD preBlock( bPreBlock ) CLASS TBColumn +METHOD preBlock( bPreBlock ) CLASS TBCOLUMN IF bPreBlock != NIL ::bPreBlock := __eInstVar53( Self, "PREBLOCK", bPreBlock, "B", 1001 ) @@ -188,7 +182,7 @@ METHOD preBlock( bPreBlock ) CLASS TBColumn RETURN ::bPreBlock -METHOD postBlock( bPostBlock ) CLASS TBColumn +METHOD postBlock( bPostBlock ) CLASS TBCOLUMN IF bPostBlock != NIL ::bPostBlock := __eInstVar53( Self, "POSTBLOCK", bPostBlock, "B", 1001 ) @@ -196,15 +190,15 @@ METHOD postBlock( bPostBlock ) CLASS TBColumn RETURN ::bPostBlock -METHOD setStyle( nStyle, lNewValue ) CLASS TBColumn +METHOD setStyle( nStyle, lNewValue ) CLASS TBCOLUMN - /* NOTE: CA-Cl*pper 5.3 does no checks on the value of nStyle, so in case + /* NOTE: CA-Cl*pper 5.3 does no checks on the value of nStyle, so in case it is zero or non-numeric, a regular RTE will happen. [vszakats] */ - + IF nStyle > Len( ::aSetStyle ) .AND. nStyle <= 4096 /* Some reasonable limit for maximum number of styles */ ASize( ::aSetStyle, nStyle ) ENDIF - + IF ISLOGICAL( lNewValue ) ::aSetStyle[ nStyle ] := lNewValue ENDIF @@ -213,7 +207,7 @@ METHOD setStyle( nStyle, lNewValue ) CLASS TBColumn #endif -METHOD New( cHeading, bBlock ) CLASS TBColumn +METHOD New( cHeading, bBlock ) CLASS TBCOLUMN ::cHeading := cHeading /* NOTE: CA-Cl*pper will allow any types for the heading here. [vszakats] */ ::bBlock := bBlock /* NOTE: CA-Cl*pper allows any types here. [vszakats] */ @@ -221,4 +215,11 @@ METHOD New( cHeading, bBlock ) CLASS TBColumn RETURN Self FUNCTION TBColumnNew( cHeading, bBlock ) - RETURN TBColumn():New( cHeading, bBlock ) + RETURN HBBColumn():New( cHeading, bBlock ) + +#ifdef HB_COMPAT_XPP + +CREATE CLASS xpp_TBColumn INHERIT HBBColumn +ENDCLASS + +#endif diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index 2cdd68bc86..054401895f 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * TBrowse Class + * TBrowse Class * * Copyright 2008 Przemyslaw Czerpak * This implementation contains code and notes by: @@ -67,7 +67,7 @@ /* HB_BRW_STATICMOUSE controls if mouse position is static * and set by call to hitTest() method or dynamic calculated * by calls to MPOS() / MCOL(). CL53 uses dynamic mouse but - * I guess that some Harbour GUI libraries inherit from TBROWSE() + * I guess that some Harbour GUI libraries inherit from TBROWSE * and because they do not support MCOL()/MROW() (when someone * will create GUI library integrated with GT system?) then they * need static mouse with positions passed by GUI code. [druzus] @@ -109,14 +109,7 @@ #define _TBR_COORD( n ) Int( n ) -/* NOTE: In CA-Cl*pper TBROWSE class does not inherit from any other classes - and there is no public class function like TBrowse(). There is - in XPP though. */ -#if defined( HB_C52_STRICT ) .AND. !defined( HB_COMPAT_XPP ) -CREATE CLASS TBrowse STATIC -#else -CREATE CLASS TBrowse -#endif +CREATE CLASS TBROWSE FUNCTION HBBrowse /* The first 18 instance variables are exactly the same as in Clipper * so also some code which access them directly by array indexes should work @@ -317,7 +310,7 @@ ENDCLASS FUNCTION TBrowseNew( nTop, nLeft, nBottom, nRight ) - RETURN TBrowse():new( nTop, nLeft, nBottom, nRight ) + RETURN HBBrowse():new( nTop, nLeft, nBottom, nRight ) METHOD new( nTop, nLeft, nBottom, nRight ) CLASS TBROWSE @@ -2763,3 +2756,61 @@ FUNCTION TBMouse( oBrw, nMRow, nMCol ) RETURN TBR_EXCEPTION #endif + +#ifdef HB_COMPAT_XPP + +CREATE CLASS xpp_TBrowse INHERIT HBBrowse + +EXPORTED: + + METHOD viewArea() + METHOD firstScrCol() + + METHOD _left() + METHOD _right() + METHOD _end() + +ENDCLASS + +METHOD viewArea() CLASS xpp_TBrowse + + LOCAL nWidth, nFrozenWidth + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + // TOFIX + + nWidth := nFrozenWidth := _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 + _MAXFREEZE( ::nFrozen, ::aColData, @nWidth ) + nFrozenWidth -= nWidth + + RETURN { ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ),; + ::n_Left,; + ::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ),; + ::n_Right,; + nFrozenWidth } + +/* NOTE: Returns the left margin relative column position of the first + non-frozen column. Xbase++ compatible method. */ +METHOD firstScrCol() CLASS xpp_TBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + // TOFIX + + RETURN iif( ::leftVisible == 0, 0, ::aColData[ ::leftVisible ][ _TBCI_COLPOS ] ) + +METHOD _left() CLASS xpp_TBrowse + RETURN ::left() + +METHOD _right() CLASS xpp_TBrowse + RETURN ::right() + +METHOD _end() CLASS xpp_TBrowse + RETURN ::end() + +#endif diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 9750716916..7568012dde 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -70,7 +70,7 @@ /* NOTE: In CA-Cl*pper, TGET class does not inherit from any other classes. */ -CREATE CLASS HBGet +CREATE CLASS GET FUNCTION HBGet PROTECTED: @@ -233,7 +233,7 @@ CREATE CLASS HBGet ENDCLASS -METHOD assign() CLASS HBGet +METHOD assign() CLASS GET LOCAL xValue IF ::hasFocus @@ -246,7 +246,7 @@ METHOD assign() CLASS HBGet RETURN Self -METHOD updateBuffer() CLASS HBGet +METHOD updateBuffer() CLASS GET IF ::hasFocus ::cBuffer := ::PutMask( ::varGet() ) @@ -258,7 +258,7 @@ METHOD updateBuffer() CLASS HBGet RETURN Self -METHOD display() CLASS HBGet +METHOD display() CLASS GET LOCAL nOldCursor := SetCursor( SC_NONE ) LOCAL cBuffer @@ -373,14 +373,14 @@ METHOD display() CLASS HBGet /* ------------------------------------------------------------------------- */ -METHOD colorDisp( cColorSpec ) CLASS HBGet +METHOD colorDisp( cColorSpec ) CLASS GET ::colorSpec := cColorSpec ::display() RETURN Self -METHOD end() CLASS HBGet +METHOD end() CLASS GET LOCAL nLastCharPos LOCAL nPos @@ -407,7 +407,7 @@ METHOD end() CLASS HBGet RETURN Self -METHOD home() CLASS HBGet +METHOD home() CLASS GET IF ::hasFocus ::pos := ::FirstEditable() @@ -419,7 +419,7 @@ METHOD home() CLASS HBGet RETURN Self -METHOD reset() CLASS HBGet +METHOD reset() CLASS GET IF ::hasFocus ::cBuffer := ::PutMask( ::varGet(), .F. ) @@ -436,7 +436,7 @@ METHOD reset() CLASS HBGet RETURN Self -METHOD undo() CLASS HBGet +METHOD undo() CLASS GET IF ::hasFocus IF ::original != NIL @@ -448,7 +448,7 @@ METHOD undo() CLASS HBGet RETURN Self -METHOD setFocus() CLASS HBGet +METHOD setFocus() CLASS GET LOCAL xVarGet @@ -487,7 +487,7 @@ METHOD setFocus() CLASS HBGet RETURN Self -METHOD killFocus() CLASS HBGet +METHOD killFocus() CLASS GET LOCAL lHadFocus := ::hasFocus @@ -509,7 +509,7 @@ METHOD killFocus() CLASS HBGet RETURN Self -METHOD varPut( xValue ) CLASS HBGet +METHOD varPut( xValue ) CLASS GET LOCAL aSubs LOCAL nLen @@ -540,7 +540,7 @@ METHOD varPut( xValue ) CLASS HBGet RETURN xValue -METHOD varGet() CLASS HBGet +METHOD varGet() CLASS GET LOCAL aSubs LOCAL nLen @@ -571,7 +571,7 @@ METHOD varGet() CLASS HBGet /* NOTE: CA-Cl*pper will corrupt memory if cChar contains multiple chars. [vszakats] */ -METHOD overStrike( cChar ) CLASS HBGet +METHOD overStrike( cChar ) CLASS GET IF ::hasFocus @@ -622,7 +622,7 @@ METHOD overStrike( cChar ) CLASS HBGet /* NOTE: CA-Cl*pper will corrupt memory if cChar contains multiple chars. [vszakats] */ -METHOD insert( cChar ) CLASS HBGet +METHOD insert( cChar ) CLASS GET LOCAL nFor LOCAL nMaxEdit @@ -689,7 +689,7 @@ METHOD insert( cChar ) CLASS HBGet RETURN Self -METHOD right() CLASS HBGet +METHOD right() CLASS GET IF ::hasFocus .AND. ; ::rightLow() @@ -700,7 +700,7 @@ METHOD right() CLASS HBGet RETURN Self -METHOD left() CLASS HBGet +METHOD left() CLASS GET IF ::hasFocus .AND. ; ::leftLow() @@ -711,7 +711,7 @@ METHOD left() CLASS HBGet RETURN Self -METHOD wordLeft() CLASS HBGet +METHOD wordLeft() CLASS GET LOCAL nPos @@ -757,7 +757,7 @@ METHOD wordLeft() CLASS HBGet RETURN Self -METHOD wordRight() CLASS HBGet +METHOD wordRight() CLASS GET LOCAL nPos @@ -797,7 +797,7 @@ METHOD wordRight() CLASS HBGet RETURN Self -METHOD toDecPos() CLASS HBGet +METHOD toDecPos() CLASS GET IF ::hasFocus @@ -819,7 +819,7 @@ METHOD toDecPos() CLASS HBGet RETURN Self -METHOD backSpace() CLASS HBGet +METHOD backSpace() CLASS GET IF ::hasFocus .AND. ; ::backSpaceLow() @@ -829,7 +829,7 @@ METHOD backSpace() CLASS HBGet RETURN Self -METHOD delete() CLASS HBGet +METHOD delete() CLASS GET IF ::hasFocus ::deleteLow() @@ -838,7 +838,7 @@ METHOD delete() CLASS HBGet RETURN Self -METHOD delEnd() CLASS HBGet +METHOD delEnd() CLASS GET LOCAL nPos @@ -857,7 +857,7 @@ METHOD delEnd() CLASS HBGet RETURN Self -METHOD delLeft() CLASS HBGet +METHOD delLeft() CLASS GET ::leftLow() ::deleteLow() @@ -865,7 +865,7 @@ METHOD delLeft() CLASS HBGet RETURN Self -METHOD delRight() CLASS HBGet +METHOD delRight() CLASS GET ::rightLow() ::deleteLow() @@ -876,7 +876,7 @@ METHOD delRight() CLASS HBGet /* ::wordLeft() ::delWordRight() */ -METHOD delWordLeft() CLASS HBGet +METHOD delWordLeft() CLASS GET IF ::hasFocus @@ -902,7 +902,7 @@ METHOD delWordLeft() CLASS HBGet RETURN Self -METHOD delWordRight() CLASS HBGet +METHOD delWordRight() CLASS GET IF ::hasFocus @@ -934,10 +934,10 @@ METHOD delWordRight() CLASS HBGet * be used for GET_CLR_UNSELECTED and GET_CLR_ENHANCED. */ -METHOD getColorSpec() CLASS HBGet +METHOD getColorSpec() CLASS GET RETURN ::cColorSpec -METHOD setColorSpec( cColorSpec ) CLASS HBGet +METHOD setColorSpec( cColorSpec ) CLASS GET LOCAL nClrUns LOCAL nClrOth @@ -979,10 +979,10 @@ METHOD setColorSpec( cColorSpec ) CLASS HBGet RETURN cColorSpec -METHOD getPos() CLASS HBGet +METHOD getPos() CLASS GET RETURN ::nPos -METHOD setPos( nPos ) CLASS HBGet +METHOD setPos( nPos ) CLASS GET LOCAL tmp @@ -1037,7 +1037,7 @@ METHOD setPos( nPos ) CLASS HBGet * several tasks to adjust the internal data of the object. */ -METHOD picture( cPicture ) CLASS HBGet +METHOD picture( cPicture ) CLASS GET LOCAL nAt LOCAL nFor @@ -1162,7 +1162,7 @@ METHOD picture( cPicture ) CLASS HBGet RETURN ::cPicture -METHOD PutMask( xValue, lEdit ) CLASS HBGet +METHOD PutMask( xValue, lEdit ) CLASS GET LOCAL cChar LOCAL cBuffer @@ -1244,7 +1244,7 @@ METHOD PutMask( xValue, lEdit ) CLASS HBGet RETURN cBuffer -METHOD unTransform() CLASS HBGet +METHOD unTransform() CLASS GET LOCAL cBuffer LOCAL xValue @@ -1378,7 +1378,7 @@ METHOD unTransform() CLASS HBGet RETURN xValue -METHOD type() CLASS HBGet +METHOD type() CLASS GET RETURN ::cType := ValType( iif( ::hasFocus, ::xVarGet, ::varGet() ) ) @@ -1391,7 +1391,7 @@ METHOD type() CLASS HBGet * to display correctly. */ -METHOD block( bBlock ) CLASS HBGet +METHOD block( bBlock ) CLASS GET IF PCount() == 0 .OR. bBlock == NIL RETURN ::bBlock @@ -1403,7 +1403,7 @@ METHOD block( bBlock ) CLASS HBGet RETURN bBlock -METHOD firstEditable() CLASS HBGet +METHOD firstEditable() CLASS GET LOCAL nFor @@ -1423,7 +1423,7 @@ METHOD firstEditable() CLASS HBGet RETURN 0 -METHOD lastEditable() CLASS HBGet +METHOD lastEditable() CLASS GET LOCAL nFor @@ -1439,7 +1439,7 @@ METHOD lastEditable() CLASS HBGet RETURN 0 -METHOD badDate() CLASS HBGet +METHOD badDate() CLASS GET LOCAL xValue @@ -1450,7 +1450,7 @@ METHOD badDate() CLASS HBGet #ifdef HB_C52_UNDOC -METHOD reform() CLASS HBGet +METHOD reform() CLASS GET IF ::hasFocus ::cBuffer := ::PutMask( ::unTransform(), .F. ) @@ -1463,7 +1463,7 @@ METHOD reform() CLASS HBGet #ifdef HB_COMPAT_C53 -METHOD hitTest( nMRow, nMCol ) CLASS HBGet +METHOD hitTest( nMRow, nMCol ) CLASS GET IF ISOBJECT( ::oControl ) RETURN ::oControl:hitTest( nMRow, nMCol ) @@ -1482,7 +1482,7 @@ METHOD hitTest( nMRow, nMCol ) CLASS HBGet RETURN HTNOWHERE -METHOD control( oControl ) CLASS HBGet +METHOD control( oControl ) CLASS GET IF PCount() == 1 .AND. ( oControl == NIL .OR. ISOBJECT( oControl ) ) ::oControl := oControl @@ -1490,7 +1490,7 @@ METHOD control( oControl ) CLASS HBGet RETURN ::oControl -METHOD caption( cCaption ) CLASS HBGet +METHOD caption( cCaption ) CLASS GET IF ISCHARACTER( cCaption ) ::cCaption := cCaption @@ -1498,7 +1498,7 @@ METHOD caption( cCaption ) CLASS HBGet RETURN ::cCaption -METHOD capRow( nCapRow ) CLASS HBGet +METHOD capRow( nCapRow ) CLASS GET IF ISNUMBER( nCapRow ) ::nCapRow := Int( nCapRow ) @@ -1506,7 +1506,7 @@ METHOD capRow( nCapRow ) CLASS HBGet RETURN ::nCapRow -METHOD capCol( nCapCol ) CLASS HBGet +METHOD capCol( nCapCol ) CLASS GET IF ISNUMBER( nCapCol ) ::nCapCol := Int( nCapCol ) @@ -1514,7 +1514,7 @@ METHOD capCol( nCapCol ) CLASS HBGet RETURN ::nCapCol -METHOD message( cMessage ) CLASS HBGet +METHOD message( cMessage ) CLASS GET IF ISCHARACTER( cMessage ) ::cMessage := cMessage @@ -1526,7 +1526,7 @@ METHOD message( cMessage ) CLASS HBGet /* ------------------------------------------------------------------------- */ -METHOD rightLow() CLASS HBGet +METHOD rightLow() CLASS GET LOCAL nPos @@ -1552,7 +1552,7 @@ METHOD rightLow() CLASS HBGet RETURN .T. -METHOD leftLow() CLASS HBGet +METHOD leftLow() CLASS GET LOCAL nPos @@ -1578,7 +1578,7 @@ METHOD leftLow() CLASS HBGet RETURN .T. -METHOD backSpaceLow() CLASS HBGet +METHOD backSpaceLow() CLASS GET LOCAL nMinus LOCAL nPos := ::nPos @@ -1610,7 +1610,7 @@ METHOD backSpaceLow() CLASS HBGet RETURN .F. -METHOD deleteLow() CLASS HBGet +METHOD deleteLow() CLASS GET LOCAL nMaxLen := ::nMaxLen LOCAL n @@ -1640,7 +1640,7 @@ METHOD deleteLow() CLASS HBGet RETURN NIL -METHOD DeleteAll() CLASS HBGet +METHOD DeleteAll() CLASS GET LOCAL xValue @@ -1666,7 +1666,7 @@ METHOD DeleteAll() CLASS HBGet RETURN Self -METHOD IsEditable( nPos ) CLASS HBGet +METHOD IsEditable( nPos ) CLASS GET LOCAL cChar @@ -1697,7 +1697,7 @@ METHOD IsEditable( nPos ) CLASS HBGet RETURN .F. -METHOD Input( cChar ) CLASS HBGet +METHOD Input( cChar ) CLASS GET LOCAL cPic @@ -1792,18 +1792,18 @@ METHOD Input( cChar ) CLASS HBGet /* ------------------------------------------------------------------------- */ -METHOD getBuffer() CLASS HBGet +METHOD getBuffer() CLASS GET RETURN ::cBuffer -METHOD setBuffer( cBuffer ) CLASS HBGet +METHOD setBuffer( cBuffer ) CLASS GET RETURN iif( ::hasFocus, ::cBuffer := cBuffer, cBuffer ) /* NOTE: In contrary to CA-Cl*pper docs, this var is assignable. [vszakats] */ -METHOD getChanged() CLASS HBGet +METHOD getChanged() CLASS GET RETURN ::lChanged -METHOD setChanged( lChanged ) CLASS HBGet +METHOD setChanged( lChanged ) CLASS GET IF ISLOGICAL( lChanged ) RETURN iif( ::hasFocus, ::lChanged := lChanged, lChanged ) @@ -1811,10 +1811,10 @@ METHOD setChanged( lChanged ) CLASS HBGet RETURN .F. -METHOD getClear() CLASS HBGet +METHOD getClear() CLASS GET RETURN ::lClear -METHOD setClear( lClear ) CLASS HBGet +METHOD setClear( lClear ) CLASS GET IF ISLOGICAL( lClear ) RETURN iif( ::hasFocus, ::lClear := lClear, lClear ) @@ -1822,10 +1822,10 @@ METHOD setClear( lClear ) CLASS HBGet RETURN .F. -METHOD getMinus() CLASS HBGet +METHOD getMinus() CLASS GET RETURN ::lMinus -METHOD setMinus( lMinus ) CLASS HBGet +METHOD setMinus( lMinus ) CLASS GET IF ISLOGICAL( lMinus ) RETURN iif( ::hasFocus, ::lMinus := lMinus, lMinus ) @@ -1836,22 +1836,22 @@ METHOD setMinus( lMinus ) CLASS HBGet /* 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 getRow() CLASS HBGet +METHOD getRow() CLASS GET RETURN ::nRow -METHOD setRow( nRow ) CLASS HBGet +METHOD setRow( nRow ) CLASS GET RETURN ::nRow := iif( ISNUMBER( nRow ), Int( nRow ), 0 ) /* 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 getCol() CLASS HBGet +METHOD getCol() CLASS GET RETURN ::nCol -METHOD setCol( nCol ) CLASS HBGet +METHOD setCol( nCol ) CLASS GET RETURN ::nCol := iif( ISNUMBER( nCol ), Int( nCol ), 0 ) -METHOD name( cName ) CLASS HBGet +METHOD name( cName ) CLASS GET IF PCount() > 0 .AND. cName != NIL ::cName := cName @@ -1859,7 +1859,7 @@ METHOD name( cName ) CLASS HBGet RETURN ::cName -METHOD SubScript( xValue ) CLASS HBGet +METHOD SubScript( xValue ) CLASS GET IF xValue != NIL ::xSubScript := xValue @@ -1867,7 +1867,7 @@ METHOD SubScript( xValue ) CLASS HBGet RETURN ::xSubScript -METHOD PostBlock( xValue ) CLASS HBGet +METHOD PostBlock( xValue ) CLASS GET IF xValue != NIL ::bPostBlock := xValue @@ -1875,7 +1875,7 @@ METHOD PostBlock( xValue ) CLASS HBGet RETURN ::bPostBlock -METHOD PreBlock( xValue ) CLASS HBGet +METHOD PreBlock( xValue ) CLASS GET IF xValue != NIL ::bPreBlock := xValue @@ -1883,7 +1883,7 @@ METHOD PreBlock( xValue ) CLASS HBGet RETURN ::bPreBlock -METHOD Cargo( xValue ) CLASS HBGet +METHOD Cargo( xValue ) CLASS GET IF xValue != NIL ::xCargo := xValue @@ -1891,7 +1891,7 @@ METHOD Cargo( xValue ) CLASS HBGet RETURN ::xCargo -METHOD ExitState( xValue ) CLASS HBGet +METHOD ExitState( xValue ) CLASS GET IF xValue != NIL ::xExitState := xValue @@ -1899,7 +1899,7 @@ METHOD ExitState( xValue ) CLASS HBGet RETURN ::xExitState -METHOD Reader( xValue ) CLASS HBGet +METHOD Reader( xValue ) CLASS GET IF xValue != NIL ::bReader := xValue @@ -1909,7 +1909,7 @@ METHOD Reader( xValue ) CLASS HBGet #ifdef HB_EXTENSION -METHOD hideInput( lHideInput ) CLASS HBGet +METHOD hideInput( lHideInput ) CLASS GET IF lHideInput != NIL ::lHideInput := __eInstVar53( Self, "HIDEINPUT", lHideInput, "L", 1001 ) @@ -1917,7 +1917,7 @@ METHOD hideInput( lHideInput ) CLASS HBGet RETURN ::lHideInput -METHOD style( cStyle ) CLASS HBGet +METHOD style( cStyle ) CLASS GET IF cStyle != NIL ::cStyle := __eInstVar53( Self, "STYLE", cStyle, "C", 1001, {|| Len( cStyle ) == 1 } ) @@ -1929,7 +1929,7 @@ METHOD style( cStyle ) CLASS HBGet /* ------------------------------------------------------------------------- */ -METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS HBGet +METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS GET DEFAULT nRow TO Row() DEFAULT nCol TO Col() + iif( Set( _SET_DELIMITERS ), 1, 0 ) diff --git a/harbour/source/rtl/tgetint.prg b/harbour/source/rtl/tgetint.prg index 5f37615a59..1367c6673f 100644 --- a/harbour/source/rtl/tgetint.prg +++ b/harbour/source/rtl/tgetint.prg @@ -67,7 +67,7 @@ FUNCTION __GET( bSetGet, cVarName, cPicture, bValid, bWhen ) ENDIF ENDIF - oGet := HBGet():New( , , bSetGet, cVarName, cPicture ) + oGet := GetNew( , , bSetGet, cVarName, cPicture ) oGet:PreBlock := bWhen oGet:PostBlock := bValid @@ -88,7 +88,7 @@ FUNCTION __GETA( bGetArray, cVarName, cPicture, bValid, bWhen, aIndex ) ENDIF ENDIF - oGet := HBGet():New( , , bGetArray, cVarName, cPicture ) + oGet := GetNew( , , bGetArray, cVarName, cPicture ) oGet:SubScript := aIndex oGet:PreBlock := bWhen diff --git a/harbour/source/rtl/tgetx.prg b/harbour/source/rtl/tgetx.prg index 56d4aafbf0..7cc1f3c8f5 100644 --- a/harbour/source/rtl/tgetx.prg +++ b/harbour/source/rtl/tgetx.prg @@ -56,7 +56,7 @@ #ifdef HB_COMPAT_XPP -CREATE CLASS Get INHERIT HBGet +CREATE CLASS xpp_Get INHERIT HBGet EXPORTED: @@ -71,7 +71,7 @@ ENDCLASS /* NOTE: Not tested or compared to Xbase++. [vszakats] */ /* TOFIX: To make it work when @S was used. [vszakats] */ -METHOD posInBuffer( nRow, nCol ) CLASS Get +METHOD posInBuffer( nRow, nCol ) CLASS xpp_Get IF ::hasFocus .AND. ; nRow == ::nRow .AND. ; @@ -83,13 +83,13 @@ METHOD posInBuffer( nRow, nCol ) CLASS Get RETURN 0 -METHOD _end() CLASS Get +METHOD _end() CLASS xpp_Get RETURN ::end() -METHOD _assign() CLASS Get +METHOD _assign() CLASS xpp_Get RETURN ::assign() -METHOD _delete() CLASS Get +METHOD _delete() CLASS xpp_Get RETURN ::delete() #endif