From 5fdd83dc2719601475ad4faa6f83c963a547c29b Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Tue, 17 Apr 2007 18:01:15 +0000 Subject: [PATCH] 2007-04-17 20:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/rdd/dbcmd.c ! update NetErr() in ordListAdd() If you know other then dbCreate()/dbUseArea() functions which reset NetErr() flag in Clipper then please report them. We will have to update our functions (dbSetIndex() is a wrapper to ordListAdd() so you nay not report it ;)) * harbour/source/rtl/gtstd/gtstd.c * do not stop Harbour process when controlling terminal has TOSTOP attribute set (as long as no direct out is done) * harbour/source/rtl/tclass.prg * harbour/source/rtl/terror.prg * harbour/source/rtl/tobject.prg * set valid class function * harbour/source/rtl/tmenuitm.prg * harbour/source/rtl/tpopup.prg ! I think that no one has been checking what these code does for very long time. Both MenuItem() and PopUp() on each call tries to create new _CLASSES_ called "MenuItem" and "PopUpMenu" instead of creating only new instance of these classes (new objects) Updated to use standard hbclass.ch commands. If possible try to not create classes manually and always use documented commands from hbclass.ch --- harbour/ChangeLog | 27 +++++ harbour/source/rdd/dbcmd.c | 4 +- harbour/source/rtl/gtstd/gtstd.c | 28 ++++-- harbour/source/rtl/tclass.prg | 4 +- harbour/source/rtl/terror.prg | 2 +- harbour/source/rtl/tmenuitm.prg | 60 ++++++----- harbour/source/rtl/tobject.prg | 78 +++++++-------- harbour/source/rtl/tpopup.prg | 166 +++++++++++++++---------------- 8 files changed, 203 insertions(+), 166 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 6b09f7084e..7dc624b16b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,33 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-04-17 20:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/source/rdd/dbcmd.c + ! update NetErr() in ordListAdd() + If you know other then dbCreate()/dbUseArea() functions which reset + NetErr() flag in Clipper then please report them. We will have to + update our functions (dbSetIndex() is a wrapper to ordListAdd() so + you nay not report it ;)) + + * harbour/source/rtl/gtstd/gtstd.c + * do not stop Harbour process when controlling terminal has TOSTOP + attribute set (as long as no direct out is done) + + * harbour/source/rtl/tclass.prg + * harbour/source/rtl/terror.prg + * harbour/source/rtl/tobject.prg + * set valid class function + + * harbour/source/rtl/tmenuitm.prg + * harbour/source/rtl/tpopup.prg + ! I think that no one has been checking what these code does for + very long time. Both MenuItem() and PopUp() on each call tries + to create new _CLASSES_ called "MenuItem" and "PopUpMenu" + instead of creating only new instance of these classes (new objects) + Updated to use standard hbclass.ch commands. If possible try + to not create classes manually and always use documented commands + from hbclass.ch + 2007-04-17 19:34 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * harbour/source/common/hbver.c + Added Vista and 2003 Windows versions. diff --git a/harbour/source/rdd/dbcmd.c b/harbour/source/rdd/dbcmd.c index bb96ba85c5..f3edf14664 100644 --- a/harbour/source/rdd/dbcmd.c +++ b/harbour/source/rdd/dbcmd.c @@ -3356,6 +3356,7 @@ HB_FUNC( ORDLISTADD ) DBORDERINFO pOrderInfo; AREAP pArea = HB_CURRENT_WA; + s_bNetError = FALSE; if( pArea ) { memset( &pOrderInfo, 0, sizeof( DBORDERINFO ) ); @@ -3368,13 +3369,12 @@ HB_FUNC( ORDLISTADD ) return; } pOrderInfo.itmResult = hb_itemNew( NULL ); - SELF_ORDLSTADD( pArea, &pOrderInfo ); + s_bNetError = SELF_ORDLSTADD( pArea, &pOrderInfo ) != SUCCESS; hb_itemReturn( pOrderInfo.itmResult ); hb_itemRelease( pOrderInfo.itmResult ); } else hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "ORDLISTADD" ); - } HB_FUNC( ORDLISTCLEAR ) diff --git a/harbour/source/rtl/gtstd/gtstd.c b/harbour/source/rtl/gtstd/gtstd.c index cfe0ff426a..5fdab4322c 100644 --- a/harbour/source/rtl/gtstd/gtstd.c +++ b/harbour/source/rtl/gtstd/gtstd.c @@ -68,6 +68,7 @@ #include #include #include + #include #include #include #else @@ -187,7 +188,6 @@ static void hb_gt_std_Init( FHANDLE hFilenoStdin, FHANDLE hFilenoStdout, FHANDLE s_ulCrLf = strlen( (char *) s_szCrLf ); hb_fsSetDevMode( s_hFilenoStdout, FD_BINARY ); - HB_GTSUPER_INIT( hFilenoStdin, hFilenoStdout, hFilenoStderr ); #if defined( OS_UNIX_COMPATIBLE ) @@ -199,10 +199,11 @@ static void hb_gt_std_Init( FHANDLE hFilenoStdin, FHANDLE hFilenoStdout, FHANDLE s_fRestTTY = TRUE; /* if( s_saved_TIO.c_lflag & TOSTOP ) != 0 */ - sigaction( SIGTTOU, 0, &old ); + sigaction( SIGTTOU, NULL, &old ); memcpy( &act, &old, sizeof( struct sigaction ) ); act.sa_handler = sig_handler; - act.sa_flags = SA_RESTART; + /* do not use SA_RESTART - new Linux kernels will repeat the operation */ + act.sa_flags = SA_ONESHOT; sigaction( SIGTTOU, &act, 0 ); tcgetattr( hFilenoStdin, &s_saved_TIO ); @@ -215,7 +216,7 @@ static void hb_gt_std_Init( FHANDLE hFilenoStdin, FHANDLE hFilenoStdout, FHANDLE tcsetattr( hFilenoStdin, TCSAFLUSH, &s_curr_TIO ); act.sa_handler = SIG_DFL; - sigaction( SIGTTOU, &old, 0 ); + sigaction( SIGTTOU, &old, NULL ); } if( s_bStdoutConsole ) @@ -303,11 +304,20 @@ static int hb_gt_std_ReadKey( int iEventMask ) } #elif defined( OS_UNIX_COMPATIBLE ) { - USHORT uiErrorOld = hb_fsError(); /* Save current user file error code */ - BYTE bChar; - if( hb_fsRead( s_hFilenoStdin, &bChar, 1 ) == 1 ) - ch = s_keyTransTbl[ bChar ]; - hb_fsSetError( uiErrorOld ); /* Restore last user file error code */ + struct timeval tv; + fd_set rfds; + tv.tv_sec = 0; + tv.tv_usec = 0; + FD_ZERO( &rfds ); + FD_SET( s_hFilenoStdin, &rfds); + if( select( s_hFilenoStdin + 1, &rfds, NULL, NULL, &tv ) > 0 ) + { + USHORT uiErrorOld = hb_fsError(); /* Save current user file error code */ + BYTE bChar; + if( hb_fsRead( s_hFilenoStdin, &bChar, 1 ) == 1 ) + ch = s_keyTransTbl[ bChar ]; + hb_fsSetError( uiErrorOld ); /* Restore last user file error code */ + } } #else diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index 3af76a7e5e..9408274fbf 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -83,8 +83,8 @@ FUNCTION HBClass() STATIC s_hClass /* NOTE: Automatically default to NIL */ IF s_hClass == NIL - s_hClass := __clsNew( "HBCLASS", 16) -/* s_hClass := __clsNew( "HBCLASS", 17) */ + s_hClass := __clsNew( "HBCLASS", 16,, @HBClass() ) +/* s_hClass := __clsNew( "HBCLASS", 17,, @HBClass()) */ __clsAddMsg( s_hClass, "New" , @New() , HB_OO_MSG_METHOD ) __clsAddMsg( s_hClass, "Create" , @Create() , HB_OO_MSG_METHOD ) diff --git a/harbour/source/rtl/terror.prg b/harbour/source/rtl/terror.prg index dc72e023ad..27782587df 100644 --- a/harbour/source/rtl/terror.prg +++ b/harbour/source/rtl/terror.prg @@ -58,7 +58,7 @@ FUNCTION ErrorNew() STATIC s_oClass IF s_oClass == NIL - s_oClass := HBClass():New( "ERROR" ) + s_oClass := HBClass():New( "ERROR",, @ErrorNew() ) s_oClass:AddData( "Args" , 0 ) s_oClass:AddData( "CanDefault" , .F. ) diff --git a/harbour/source/rtl/tmenuitm.prg b/harbour/source/rtl/tmenuitm.prg index 9381fedaf4..c9e88ec984 100644 --- a/harbour/source/rtl/tmenuitm.prg +++ b/harbour/source/rtl/tmenuitm.prg @@ -50,15 +50,36 @@ * */ +#include "hbclass.ch" #include "common.ch" #include "button.ch" #ifdef HB_COMPAT_C53 //--------------------------------------------------------------------------// -function MenuItem( cCaption, boData, nShortcut, cMsg, nID ) +FUNCTION MenuItem( cCaption, boData, nShortcut, cMsg, nID ) +RETURN __MenuItem():New( cCaption, boData, nShortcut, cMsg, nID ) +//--------------------------------------------------------------------------// +CLASS MenuItem STATIC FUNCTION __MenuItem - LOCAL oClass + DATA caption init "" + DATA cargo + DATA checked init FALSE + DATA column init 0 + DATA data + DATA enabled + DATA id + DATA message + DATA row init 0 + DATA shortcut + DATA style init HB_TMENUITEM_STYLE + + METHOD New( cCaption, boData, nShortcut, cMsg, nID ) + METHOD isPopUp() + +ENDCLASS +//--------------------------------------------------------------------------// +METHOD New( cCaption, boData, nShortcut, cMsg, nID ) CLASS MenuItem if ISBLOCK( boData ) .or. ISOBJECT( boData ) boData := iif( cCaption != MENU_SEPARATOR, boData, nil ) @@ -70,37 +91,26 @@ function MenuItem( cCaption, boData, nShortcut, cMsg, nID ) DEFAULT cMsg TO "" DEFAULT nID TO 0 - oClass := HBClass():New( "MENUITEM" ) - - oClass:AddData( "caption" , cCaption ) - oClass:AddData( "cargo" ) - oClass:AddData( "checked" , FALSE ) - oClass:AddData( "column" , 0 ) - oClass:AddData( "data" , boData ) - oClass:AddData( "enabled" , iif( cCaption != MENU_SEPARATOR, TRUE, FALSE ) ) - oClass:AddData( "id" , nID ) - oClass:AddData( "message" , cMsg ) - oClass:AddData( "row" , 0 ) - oClass:AddData( "shortcut" , nShortcut ) - oClass:AddData( "style" , HB_TMENUITEM_STYLE ) - - oClass:AddMethod( "isPopup", @isPopup() ) - - oClass:Create() - -return oClass:Instance() + ::caption := cCaption + ::checked := FALSE + ::column := 0 + ::data := boData + ::enabled := iif( cCaption != MENU_SEPARATOR, TRUE, FALSE ) + ::id := nID + ::message := cMsg + ::row := 0 + ::shortcut := nShortcut + ::style := HB_TMENUITEM_STYLE +return Self //--------------------------------------------------------------------------// -static function isPopUp() - - LOCAL Self := QSelf() +METHOD isPopUp() CLASS MenuItem if ISOBJECT( ::data ) .and. ::data:ClassName() == "POPUPMENU" return TRUE endif return FALSE - //--------------------------------------------------------------------------// #endif diff --git a/harbour/source/rtl/tobject.prg b/harbour/source/rtl/tobject.prg index 680c0b52b9..314bccf2c3 100644 --- a/harbour/source/rtl/tobject.prg +++ b/harbour/source/rtl/tobject.prg @@ -77,82 +77,80 @@ FUNCTION HBObject() STATIC s_oClass - LOCAL nScope := HB_OO_CLSTP_EXPORTED - Local oInstance IF s_oClass == NIL - s_oClass := HBClass():New( "HBObject", ) + s_oClass := HBClass():New( "HBObject",, @HBObject() ) /* Those Five worked fine but their C version from classes.c are probably better in term of speed */ - /*s_oClass:AddInline( "CLASSNAME" , {| Self | __OBJGETCLSNAME( Self ) }, nScope ) */ - /*s_oClass:AddInline( "CLASSH" , {| Self | __CLASSH( Self ) }, nScope ) */ - /*s_oClass:AddInline( "CLASSSEL" , {| Self | __CLASSSEL( Self:CLASSH() ) }, nScope ) */ - /*s_oClass:AddInline( "EVAL" , {| Self | __EVAL( Self ) }, nScope ) */ + /*s_oClass:AddInline( "CLASSNAME" , {| Self | __OBJGETCLSNAME( Self ) }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "CLASSH" , {| Self | __CLASSH( Self ) }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "CLASSSEL" , {| Self | __CLASSSEL( Self:CLASSH() ) }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "EVAL" , {| Self | __EVAL( Self ) }, HB_OO_CLSTP_EXPORTED ) */ /* xBase++ */ - s_oClass:AddInline( "ISDERIVEDFROM" , {| Self, xPar1 | __ObjDerivedFrom( Self, xPar1 ) }, nScope ) + s_oClass:AddInline( "ISDERIVEDFROM" , {| Self, xPar1 | __ObjDerivedFrom( Self, xPar1 ) }, HB_OO_CLSTP_EXPORTED ) /* Class(y) */ - s_oClass:AddInline( "ISKINDOF" , {| Self, xPar1 | __ObjDerivedFrom( Self, xPar1 ) }, nScope ) + s_oClass:AddInline( "ISKINDOF" , {| Self, xPar1 | __ObjDerivedFrom( Self, xPar1 ) }, HB_OO_CLSTP_EXPORTED ) - s_oClass:AddMethod( "NEW" , @HBObject_New() , nScope ) - s_oClass:AddMethod( "INIT" , @HBObject_Init() , nScope ) + s_oClass:AddMethod( "NEW" , @HBObject_New() , HB_OO_CLSTP_EXPORTED ) + s_oClass:AddMethod( "INIT" , @HBObject_Init() , HB_OO_CLSTP_EXPORTED ) - s_oClass:AddMethod( "ERROR", @HBObject_Error() , nScope ) + s_oClass:AddMethod( "ERROR", @HBObject_Error() , HB_OO_CLSTP_EXPORTED ) s_oClass:SetOnError( @HBObject_DftonError() ) - s_oClass:AddInline( "MSGNOTFOUND" , {| Self, cMsg | ::Error( "Message not found", __OBJGETCLSNAME( Self ), cMsg, iif(substr(cMsg,1,1)=="_",1005,1004) ) }, nScope ) + s_oClass:AddInline( "MSGNOTFOUND" , {| Self, cMsg | ::Error( "Message not found", __OBJGETCLSNAME( Self ), cMsg, iif(substr(cMsg,1,1)=="_",1005,1004) ) }, HB_OO_CLSTP_EXPORTED ) - /*s_oClass:AddMultiData(,,nScope,{"CLASS"}, .F. )*/ + /*s_oClass:AddMultiData(,,HB_OO_CLSTP_EXPORTED,{"CLASS"}, .F. )*/ - /*s_oClass:AddInline( "ADDMETHOD" , { | Self, cMeth, pFunc, nScopeMeth | __clsAddMsg( __CLASSH( Self ) , cMeth , pFunc ,HB_OO_MSG_METHOD , NIL, iif(nScopeMeth==NIL,1,nScopeMeth) ) }, nScope ) */ + /*s_oClass:AddInline( "ADDMETHOD" , { | Self, cMeth, pFunc, nScopeMeth | __clsAddMsg( __CLASSH( Self ) , cMeth , pFunc ,HB_OO_MSG_METHOD , NIL, iif(nScopeMeth==NIL,1,nScopeMeth) ) }, HB_OO_CLSTP_EXPORTED ) */ /*s_oClass:AddInline( "ADDVAR" , { | Self, cVAR, nScopeMeth, uiData , hClass | __clsAddMsg( hClass:=__CLASSH( Self ) , cVar , uidata := __CLS_INCDATA(hClass) , HB_OO_MSG_ACCESS, NIL , iif(nScopeMeth==NIL,1,nScopeMeth) ) , ; */ - /* __clsAddMsg( hClass , "_"+cVar , uiData , HB_OO_MSG_ASSIGN, NIL , iif(nScopeMeth==NIL,1,nScopeMeth) ) }, nScope ) */ + /* __clsAddMsg( hClass , "_"+cVar , uiData , HB_OO_MSG_ASSIGN, NIL , iif(nScopeMeth==NIL,1,nScopeMeth) ) }, HB_OO_CLSTP_EXPORTED ) */ /* Those one exist within Class(y), so we will probably try to implement it */ - /*s_oClass:AddInline( "asString" , {| Self | ::class:name + " object" }, nScope ) */ - /*s_oClass:AddInline( "asExpStr" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "basicSize" , {| Self | Len( Self ) }, nScope ) */ - /*s_oClass:AddInline( "become" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "isEqual" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "isScalar" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "copy" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "deepCopy" , {| Self | }, nScope ) */ + /*s_oClass:AddInline( "asString" , {| Self | ::class:name + " object" }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "asExpStr" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "basicSize" , {| Self | Len( Self ) }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "become" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "isEqual" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "isScalar" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "copy" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "deepCopy" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ - /*s_oClass:AddInline( "deferred" , {| Self | }, nScope ) */ + /*s_oClass:AddInline( "deferred" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ - /*s_oClass:AddInline( "exec" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "error , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "hash" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "null" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "size" , {| Self | Len( Self ) }, nScope ) */ + /*s_oClass:AddInline( "exec" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "error , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "hash" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "null" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "size" , {| Self | Len( Self ) }, HB_OO_CLSTP_EXPORTED ) */ /* Those three are already treated within Classes.c */ - /*s_oClass:AddInline( "protectErr" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "hiddenErr" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "readOnlyErr" , {| Self | }, nScope ) */ + /*s_oClass:AddInline( "protectErr" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "hiddenErr" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "readOnlyErr" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ /* No idea when those two could occur !!? */ - /*s_oClass:AddInline( "wrongClass" , {| Self | }, nScope ) */ - /*s_oClass:AddInline( "badMethod" , {| Self | }, nScope ) */ + /*s_oClass:AddInline( "wrongClass" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "badMethod" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ /* this one exist within VO and seem to be Auto Called when object ran out of scope */ - /*s_oClass:AddInline( "Axit" , {| Self | }, nScope ) */ + /*s_oClass:AddInline( "Axit" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ s_oClass:Create() ENDIF +/* oInstance := s_oClass:Instance() - /*oInstance:class := s_oClass*/ - + oInstance:class := s_oClass RETURN oInstance +*/ + RETURN s_oClass:Instance() -/* Currently limited to 20 param */ -/* Will be re-written in C later to avoid this */ static function HBObject_New( ... ) return QSelf():Init( ... ) diff --git a/harbour/source/rtl/tpopup.prg b/harbour/source/rtl/tpopup.prg index 5e81773bb3..8ab7c8eb8c 100644 --- a/harbour/source/rtl/tpopup.prg +++ b/harbour/source/rtl/tpopup.prg @@ -50,6 +50,7 @@ * */ +#include "hbclass.ch" #include "box.ch" #include "button.ch" #include "color.ch" @@ -68,9 +69,57 @@ and small functions. [jlalin] */ //--------------------------------------------------------------------------// -function PopUp( nTop, nLeft, nBottom, nRight ) +FUNCTION PopUp( nTop, nLeft, nBottom, nRight ) +RETURN PopUpMenu():New( nTop, nLeft, nBottom, nRight ) +//--------------------------------------------------------------------------// +CLASS PopUpMenu STATIC FUNCTION PopUpMenu - LOCAL oClass + DATA aItems init {} + DATA border init B_SINGLE + SEPARATOR_SINGLE + DATA bottom + DATA cargo + DATA colorSpec init "N/W,W/N,W+/W,W+/N,N+/W,W/N" + DATA current init 0 + DATA itemCount init 0 + DATA left + DATA opened init FALSE PROTECTED + DATA right + DATA saveScr init "" PROTECTED + DATA top + DATA width init 0 + +#ifdef HB_EXTENSION + DATA shadowed init FALSE +#endif + + METHOD New( nTop, nLeft, nBottom, nRight ) + + METHOD AddItem( oItem ) + METHOD Close( lClose ) + METHOD DelItem( nPos ) + METHOD Display() + METHOD GetAccel( nKey ) + METHOD GetFirst() + METHOD GetItem( nPos ) + METHOD GetLast() + METHOD GetNext() + METHOD GetPrev() + METHOD GetShortct( nKey ) + METHOD HitTest( nRow, nCol ) + METHOD InsItem( nPos, oItem ) + METHOD IsOpen() + METHOD Open() + MESSAGE Select( nPos ) METHOD _Select( nPos ) + METHOD SetItem( nPos, oItem ) + + /* NOTE: This method is new in Harbour */ +#ifdef HB_EXTENSION + METHOD SetCoors( nRow, nCol, lTop ) +#endif + +ENDCLASS +//--------------------------------------------------------------------------// +METHOD New( nTop, nLeft, nBottom, nRight ) CLASS PopUpMenu /* NOTE: When a PopUp is created and attached to a TopBar object, its coords are initialized to -1, so the TopBar can update them @@ -81,54 +130,20 @@ function PopUp( nTop, nLeft, nBottom, nRight ) DEFAULT nBottom TO 0 DEFAULT nRight TO 0 - oClass := HBClass():New( "POPUPMENU" ) - - oClass:AddData( "aItems" , {} ) - oClass:AddData( "border" , B_SINGLE + SEPARATOR_SINGLE ) - oClass:AddData( "bottom" , nBottom ) - oClass:AddData( "cargo" ) - oClass:AddData( "colorSpec" , "N/W,W/N,W+/W,W+/N,N+/W,W/N" ) - oClass:AddData( "current" , 0 ) - oClass:AddData( "itemCount" , 0 ) - oClass:AddData( "left" , nLeft ) - oClass:AddData( "opened" , FALSE ) - oClass:AddData( "right" , nRight ) - oClass:AddData( "saveScr" , "" ) - oClass:AddData( "top" , nTop ) - oClass:AddData( "width" , 0 ) + ::bottom := nBottom + ::left := nLeft + ::opened := FALSE + ::right := nRight + ::top := nTop #ifdef HB_EXTENSION - oClass:AddData( "shadowed" , FALSE ) + ::shadowed := FALSE #endif - oClass:AddMethod( "AddItem" , @AddItem() ) - oClass:AddMethod( "Close" , @Close() ) - oClass:AddMethod( "DelItem" , @DelItem() ) - oClass:AddMethod( "Display" , @Display() ) - oClass:AddMethod( "GetAccel" , @GetAccel() ) - oClass:AddMethod( "GetFirst" , @GetFirst() ) - oClass:AddMethod( "GetItem" , @GetItem() ) - oClass:AddMethod( "GetLast" , @GetLast() ) - oClass:AddMethod( "GetNext" , @GetNext() ) - oClass:AddMethod( "GetPrev" , @GetPrev() ) - oClass:AddMethod( "GetShortct", @GetShortct() ) - oClass:AddMethod( "HitTest" , @HitTest() ) - oClass:AddMethod( "InsItem" , @InsItem() ) - oClass:AddMethod( "IsOpen" , @IsOpen() ) - oClass:AddMethod( "Open" , @Open() ) - oClass:AddMethod( "Select" , @_Select() ) - oClass:AddMethod( "SetItem" , @SetItem() ) - - /* NOTE: This method is new in Harbour */ - oClass:AddMethod( "SetCoors" , @SetCoors() ) - - oClass:Create() - -return oClass:Instance() +return Self //--------------------------------------------------------------------------// -static function AddItem( oItem ) +METHOD AddItem( oItem ) CLASS PopUpMenu - LOCAL Self := QSelf() LOCAL nLen aAdd( ::aItems, oItem ) @@ -139,9 +154,7 @@ static function AddItem( oItem ) return Self //--------------------------------------------------------------------------// -static function Close( lClose ) - - LOCAL Self := QSelf() +METHOD Close( lClose ) CLASS PopUpMenu DEFAULT lClose TO TRUE @@ -161,9 +174,7 @@ static function Close( lClose ) return Self //--------------------------------------------------------------------------// -static function DelItem( nPos ) - - LOCAL Self := QSelf() +METHOD DelItem( nPos ) CLASS PopUpMenu if nPos > 0 .and. nPos <= ::itemCount aDel( ::aItems, nPos ) @@ -182,9 +193,8 @@ return Self first item is disabled 2) when a menuitem is disabled it will ignore the key [jlalin] */ -static function GetAccel( nKey ) +METHOD GetAccel( nKey ) CLASS PopUpMenu - LOCAL Self := QSelf() LOCAL nAt := 0 LOCAL cKey := Upper( Chr( nKey ) ) LOCAL n @@ -199,9 +209,8 @@ static function GetAccel( nKey ) return 0 //--------------------------------------------------------------------------// -static function GetFirst() +METHOD GetFirst() CLASS PopUpMenu - LOCAL Self := QSelf() LOCAL n for n := 1 to ::itemCount @@ -212,9 +221,8 @@ static function GetFirst() return 0 //--------------------------------------------------------------------------// -static function GetItem( nPos ) +METHOD GetItem( nPos ) CLASS PopUpMenu - LOCAL Self := QSelf() LOCAL oItem if nPos > 0 .and. nPos <= ::itemCount @@ -223,9 +231,8 @@ static function GetItem( nPos ) return oItem //--------------------------------------------------------------------------// -static function GetLast() +METHOD GetLast() CLASS PopUpMenu - LOCAL Self := QSelf() LOCAL n for n := ::itemCount to 1 step -1 @@ -236,9 +243,8 @@ static function GetLast() return 0 //--------------------------------------------------------------------------// -static function GetNext() +METHOD GetNext() CLASS PopUpMenu - LOCAL Self := QSelf() LOCAL n if ::current < ::itemCount @@ -251,9 +257,8 @@ static function GetNext() return 0 //--------------------------------------------------------------------------// -static function GetPrev() +METHOD GetPrev() CLASS PopUpMenu - LOCAL Self := QSelf() LOCAL n if ::current > 1 @@ -269,9 +274,8 @@ return 0 /* NOTE: This method corrects a bug in Cl*pper: 1) when a menuitem is disabled it will ignore the key [jlalin] */ -static function GetShortct( nKey ) +METHOD GetShortct( nKey ) CLASS PopUpMenu - LOCAL Self := QSelf() LOCAL n for n := 1 to ::itemCount @@ -287,9 +291,8 @@ return 0 is disabled 2) when a menuitem is disabled it will ignore the click [jlalin] */ -static function HitTest( nRow, nCol ) +METHOD HitTest( nRow, nCol ) CLASS PopUpMenu - LOCAL Self := QSelf() LOCAL nHit := HTNOWHERE do case @@ -325,9 +328,7 @@ static function HitTest( nRow, nCol ) return nHit //--------------------------------------------------------------------------// -static function InsItem( nPos, oItem ) - - LOCAL Self := QSelf() +METHOD InsItem( nPos, oItem ) CLASS PopUpMenu if nPos > 0 .and. nPos <= ::itemCount aSize( ::aItems, ::itemCount ) @@ -342,15 +343,11 @@ static function InsItem( nPos, oItem ) return Self //--------------------------------------------------------------------------// -static function IsOpen() - - LOCAL Self := QSelf() +METHOD IsOpen() CLASS PopUpMenu return ::opened //--------------------------------------------------------------------------// -static function Open() - - LOCAL Self := QSelf() +METHOD Open() CLASS PopUpMenu if !::opened ::opened := TRUE @@ -360,9 +357,7 @@ static function Open() return Self //--------------------------------------------------------------------------// -static function _Select( nPos ) - - LOCAL Self := QSelf() +METHOD _Select( nPos ) CLASS PopUpMenu if ( nPos > 0 .and. nPos <= ::itemCount ) .and. ; ::current != nPos .and. ::aItems[ nPos ]:enabled @@ -378,9 +373,7 @@ static function _Select( nPos ) return Self //--------------------------------------------------------------------------// -static function SetItem( nPos, oItem ) - - LOCAL Self := QSelf() +METHOD SetItem( nPos, oItem ) CLASS PopUpMenu if nPos > 0 .and. nPos <= ::itemCount ::aItems[ nPos ] := oItem @@ -389,9 +382,8 @@ static function SetItem( nPos, oItem ) return Self //--------------------------------------------------------------------------// -static function Display() +METHOD Display() CLASS PopUpMenu - LOCAL Self := QSelf() LOCAL nTop := ::top LOCAL nAt := 0 LOCAL lPopup := FALSE @@ -453,9 +445,8 @@ static function Display() return Self //--------------------------------------------------------------------------// -static function SetCoors( nItem, nRow, nCol ) - - LOCAL Self := QSelf() +#ifdef HB_EXTENSION +METHOD SetCoors( nItem, nRow, nCol ) CLASS PopUpMenu if ::top == -1 .or. ::left == -1 ::top := nRow @@ -464,7 +455,7 @@ static function SetCoors( nItem, nRow, nCol ) ::right := ::left + ::width - 1 /* Just to avoid the warning by now (compiling with -w2) */ - nItem := nItem + HB_SYMBOL_UNUSED( nItem ) /* UNTESTED: I will wait until the bug in the classes.c module is fixed. However it should work this way. @@ -477,6 +468,7 @@ static function SetCoors( nItem, nRow, nCol ) endif return Self +#endif //--------------------------------------------------------------------------// #endif