diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f1bb29b37d..dadcbf5008 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,96 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-08-30 03:55 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbapi.h + * harbour/source/rtl/console.c + * changed hb_conOutAlt() from static to global function. + + * harbour/include/hbapi.h + * harbour/source/common/hbver.c + + added hb_verBuildDate() + + * harbour/source/rtl/accept.c + ! Fixed ACCEPT to respect SET CONSOLE and similar sets. + + * harbour/source/rtl/hbgtcore.c + * harbour/contrib/libct/ctwin.c + ! fixed chr(8) console output - it should erase character on the screen + + * harbour/include/set.ch + * harbour/include/hbset.h + * harbour/source/rtl/set.c + * harbour/source/rtl/filesys.c + + added _SET_TRIMFILENAME - when enabled low level hb_fs*() functions + strip trailing and leading spaces from file names to emulate DOS + like behavior - switch compatible with xHarbour + + + * harbour/source/rtl/run.c + * remove compiler type checking - if system() is not supported by + some platform/compiler then I'd prefer to exclude it explicitly. + + * harbour/source/rtl/dircmd.prg + + added support for extended DBF types and replaced some of + Bin2W() by ASC() + + * harbour/source/rtl/defpath.c + * use OS_HAS_DRIVE_LETTER macro to detect if platform supports drive + letters + + * harbour/source/rtl/philes.c + + added HB_FCOMMIT(), HB_OSERROR(), HB_OSDRIVESEPARATOR() + Question: why we have HB_F_EOF() instead HB_FEOF() + + * harbour/source/rtl/oldbox.c + * harbour/source/rtl/box.c + ! fixed __BOX() to be Clipper compatible + + * harbour/source/rtl/math.c + * harbour/source/rtl/dateshb.c + * formatting and some minor improvements + + * harbour/source/rtl/isprint.c + * harbour/source/vm/itemapi.c + * harbour/source/rtl/ampm.c + * harbour/source/rtl/inkey.c + * harbour/source/rtl/gete.c + * harbour/source/rtl/fkmax.c + * harbour/source/rtl/langapi.c + * harbour/source/rtl/colorind.c + * harbour/source/rtl/mouseapi.c + * harbour/source/rtl/readvar.prg + * harbour/source/rtl/devoutp.prg + * harbour/source/rtl/readkey.prg + * code checking and formatting + ! some minor fixes + % some speed improvements + + * harbour/source/rtl/menuto.prg + * harbour/source/rtl/radiogrp.prg + * harbour/source/rtl/listbox.prg + * harbour/source/rtl/checkbox.prg + * harbour/source/rtl/pushbtn.prg + * harbour/source/rtl/radiobtn.prg + * code checking and formatting + ! added fixes borrowed from xHarbour + ! some other fixes + % some speed improvements + + * harbour/source/rtl/filehb.c + + added commment + + * harbour/source/rtl/transfrm.c + ! fixed integer numbers transformation when _SET_FIXED is on to + be Clipper compatible + + * harbour/source/rtl/version.c + + added HB_PCODEVER() and HB_BUILDDATE() + + * harbour/source/rtl/copyfile.c + ! fixed __COPYFILE() - source and destination files should respect + _SET_DEFAULT + 2007-08-28 14:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/rtl/diskspac.c * formatting diff --git a/harbour/contrib/libct/ctwin.c b/harbour/contrib/libct/ctwin.c index 956d7bf008..d4e6928f5f 100644 --- a/harbour/contrib/libct/ctwin.c +++ b/harbour/contrib/libct/ctwin.c @@ -1017,6 +1017,16 @@ static void hb_ctw_gt_WriteCon( BYTE * pText, ULONG ulLength ) --iRow; bDisp = TRUE; } + if( bDisp ) + { + if( iLen ) + szString[ iLen - 1 ] = ' '; + else + { + hb_gt_SetPos( iRow, iCol ); + szString[ iLen++ ] = ' '; + } + } break; case HB_CHAR_LF: diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 09aad84873..11d82fb7d8 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -897,6 +897,7 @@ extern void hb_conRelease( void ); /* release the console API system */ extern char * hb_conNewLine( void ); /* retrieve a pointer to a static buffer containing new-line characters */ extern void hb_conOutStd( const char * pStr, ULONG ulLen ); /* output an string to STDOUT */ extern void hb_conOutErr( const char * pStr, ULONG ulLen ); /* output an string to STDERR */ +extern void hb_conOutAlt( const char * pStr, ULONG ulLen ); /* output an string to the screen and/or printer and/or alternate */ extern USHORT hb_conSetCursor( BOOL bSetCursor, USHORT usNewCursor ); /* retrieve and optionally set cursor shape */ extern char * hb_conSetColor( const char * szColor ); /* retrieve and optionally set console color */ extern void hb_conXSaveRestRelease( void ); /* release the save/restore API */ @@ -942,6 +943,7 @@ extern char * hb_verPlatform( void ); /* retrieves a newly allocated buffer cont extern char * hb_verCompiler( void ); /* retrieves a newly allocated buffer containing compiler version */ extern char * hb_verHarbour( void ); /* retrieves a newly allocated buffer containing harbour version */ extern char * hb_verPCode( void ); /* retrieves a newly allocated buffer containing PCode version */ +extern char * hb_verBuildDate( void ); /* retrieves a newly allocated buffer containing build date and time */ extern void hb_verBuildInfo( void ); /* display harbour, compiler, and platform versions to standard console */ extern HB_EXPORT BOOL hb_iswinnt( void ); /* return .T. if OS == WinNt, 2000, XP */ diff --git a/harbour/include/hbset.h b/harbour/include/hbset.h index 25361cd1fd..1e9ce0cbdc 100644 --- a/harbour/include/hbset.h +++ b/harbour/include/hbset.h @@ -131,7 +131,8 @@ typedef enum HB_SET_FORCEOPT = 107, HB_SET_DBFLOCKSCHEME = 108, HB_SET_DEFEXTENSIONS = 109, - HB_SET_EOL = 110 + HB_SET_EOL = 110, + HB_SET_TRIMFILENAME = 111 } HB_set_enum; @@ -200,6 +201,7 @@ typedef struct BOOL HB_SET_FORCEOPT; BOOL HB_SET_DEFEXTENSIONS; char * HB_SET_EOL; + BOOL HB_SET_TRIMFILENAME; } HB_SET_STRUCT; diff --git a/harbour/include/set.ch b/harbour/include/set.ch index 913e300522..f82ce8428f 100644 --- a/harbour/include/set.ch +++ b/harbour/include/set.ch @@ -125,8 +125,9 @@ #define _SET_DBFLOCKSCHEME 108 /* Harbour extension */ #define _SET_DEFEXTENSIONS 109 /* Harbour extension */ #define _SET_EOL 110 /* Harbour extension */ +#define _SET_TRIMFILENAME 111 /* Harbour extension */ #define HB_SET_BASE 100 -#define HB_SET_COUNT 11 +#define HB_SET_COUNT 12 #endif /* _SET_CH */ diff --git a/harbour/source/common/hbver.c b/harbour/source/common/hbver.c index 363716875c..c46167cc19 100644 --- a/harbour/source/common/hbver.c +++ b/harbour/source/common/hbver.c @@ -546,3 +546,15 @@ char * hb_verPCode( void ) return pszPCode; } + +char * hb_verBuildDate( void ) +{ + char * pszDate; + + HB_TRACE(HB_TR_DEBUG, ("hb_verBuildDate()")); + + pszDate = ( char * ) hb_xgrab( 64 ); + snprintf( pszDate, 64, "%s %s", __DATE__, __TIME__ ); + + return pszDate; +} diff --git a/harbour/source/rtl/accept.c b/harbour/source/rtl/accept.c index a73bd50529..cf446902a6 100644 --- a/harbour/source/rtl/accept.c +++ b/harbour/source/rtl/accept.c @@ -62,6 +62,7 @@ */ #include "hbapi.h" +#include "hbvm.h" #include "hbapigt.h" #include "inkey.ch" @@ -83,9 +84,8 @@ HB_FUNC( __ACCEPTSTR ) HB_FUNC( __ACCEPT ) { char szAcceptResult[ ACCEPT_BUFFER_LEN ]; - - int input; ULONG ulLen; + int input; /* cPrompt(s) passed ? */ if( hb_pcount() >= 1 ) @@ -96,7 +96,7 @@ HB_FUNC( __ACCEPT ) szAcceptResult[ 0 ] = '\0'; - while( input != K_ENTER ) + while( input != K_ENTER && hb_vmRequestQuery() == 0 ) { /* Wait forever, for keyboard events only */ input = hb_inkey( TRUE, 0.0, INKEY_KEYBOARD ); @@ -106,16 +106,16 @@ HB_FUNC( __ACCEPT ) case K_LEFT: if( ulLen > 0 ) { - hb_gtWriteCon( ( BYTE * ) "\x8 \x8", 3 ); /* Erase it from the screen. */ + hb_conOutAlt( "\x8", sizeof( char ) ); /* Erase it from the screen. */ ulLen--; /* Adjust input count to get rid of last character */ } break; default: - if( ulLen < ( ACCEPT_BUFFER_LEN - 1 ) && input >= 32 ) + if( ulLen < ( ACCEPT_BUFFER_LEN - 1 ) && input >= 32 && input <= 255 ) { szAcceptResult[ ulLen ] = input; /* Accept the input */ - hb_gtWriteCon( ( BYTE * ) &szAcceptResult[ ulLen ], sizeof( char ) ); /* Then display it */ + hb_conOutAlt( &szAcceptResult[ ulLen ], sizeof( char ) ); /* Then display it */ ulLen++; /* Then adjust the input count */ } } diff --git a/harbour/source/rtl/ampm.c b/harbour/source/rtl/ampm.c index 1da0e1d200..fd0ebc51eb 100644 --- a/harbour/source/rtl/ampm.c +++ b/harbour/source/rtl/ampm.c @@ -54,7 +54,6 @@ HB_FUNC( AMPM ) { - char * pszTime = hb_parc( 1 ); ULONG ulTimeLen = hb_parclen( 1 ); char * pszResult = ( char * ) hb_xgrab( HB_MAX( ulTimeLen, 2 ) + 3 + 1 ); USHORT uiHour = 0; @@ -62,6 +61,7 @@ HB_FUNC( AMPM ) if( ulTimeLen ) { + char * pszTime = hb_parc( 1 ); memcpy( pszResult, pszTime, ulTimeLen ); uiHour = ( USHORT ) hb_strVal( pszTime, ulTimeLen ); } diff --git a/harbour/source/rtl/box.c b/harbour/source/rtl/box.c index a4f0219be1..b3876bc98d 100644 --- a/harbour/source/rtl/box.c +++ b/harbour/source/rtl/box.c @@ -65,6 +65,7 @@ HB_FUNC( DISPBOX ) { char * pszColor = hb_parc( 6 ); char szOldColor[ CLR_STRLEN ]; + char * pszBox = hb_parc( 5 ); if( pszColor ) { @@ -72,14 +73,14 @@ HB_FUNC( DISPBOX ) hb_gtSetColorStr( pszColor ); } - if( ISCHAR( 5 ) ) + if( pszBox ) hb_gtBox( hb_itemGetNI( pTop ), hb_itemGetNI( pLeft), hb_itemGetNI( pBottom ), hb_itemGetNI( pRight ), - ( BYTE * ) hb_parc( 5 ) ); + ( BYTE * ) ( *pszBox ? pszBox : " " ) ); - else if( ISNUM( 5 ) && hb_parni( 5 ) == 2 ) + else if( hb_parni( 5 ) == 2 ) hb_gtBoxD( hb_itemGetNI( pTop ), hb_itemGetNI( pLeft), hb_itemGetNI( pBottom ), diff --git a/harbour/source/rtl/checkbox.prg b/harbour/source/rtl/checkbox.prg index f9ce006d4f..48520430c9 100644 --- a/harbour/source/rtl/checkbox.prg +++ b/harbour/source/rtl/checkbox.prg @@ -50,233 +50,239 @@ * */ -#include "common.ch" #include "hbclass.ch" +#include "common.ch" #include "button.ch" #ifdef HB_COMPAT_C53 -CLASS HBCHECKBOX +CREATE CLASS CHECKBOX FUNCTION HBCHECKBOX - Data Buffer init .f. - Data Caption - Data CapRow - Data CapCol - Data Cargo - Data Col - Data colorspec - Data FBlock - Data HasFocus init .f. - Data Message init "" - Data Row - Data SBlock - Data Style init "[û ]" - Data lCursor - Data Typeout init .f. - DATA ClassName init "CHECKBOX" + VAR Buffer INIT .f. + VAR Caption + VAR CapRow + VAR CapCol + VAR Cargo + VAR Col + VAR colorspec + VAR FBlock + VAR HasFocus INIT .f. + VAR Message INIT "" + VAR Row + VAR SBlock + VAR Style INIT "[û ]" + VAR lCursor + VAR Typeout INIT .f. - METHOD New(nRow,nCol,cCaption) + METHOD New( nRow, nCol, cCaption ) METHOD SetFocus() - MESSAGE Select() METHOD _Select + MESSAGE Select( lState ) METHOD _Select( lState ) METHOD KillFocus() - METHOD DisPlay() + METHOD Display() METHOD HitTest( nMouseRow, nMouseCol ) ENDCLASS -METHOD New(nRow,nCol,cCaption) - Local cColor:='' +METHOD New( nRow, nCol, cCaption ) CLASS CHECKBOX - ::Buffer := .f. - ::Caption := cCaption - ::CapRow := nRow - ::CapCol := nCol+3+1 - ::Col := nCol + LOCAL cColor := "" - if IsDefColor() + ::Buffer := .f. + ::Caption := cCaption + ::CapRow := nRow + ::CapCol := nCol + 3 + 1 + ::Col := nCol + + IF IsDefColor() ::ColorSpec:="W/N,W+/N,W/N,W+/N" + ELSE + cColor := SetColor() + ::ColorSpec := __guicolor( cColor, 5 ) + "," + ; + __guicolor( cColor, 2 ) + "," + ; + __guicolor( cColor, 1 ) + "," + ; + __guicolor( cColor, 4 ) + ENDIF - else - cColor := SetColor() - ::ColorSpec:= __guicolor(cColor, 5) + "," + ; - __guicolor(cColor, 2) + "," + __guicolor(cColor, 1) + ; - "," + __guicolor(cColor, 4) + ::HasFocus := .f. + ::Message := "" + ::Row := nRow - endif + ::Style := "[û ]" - ::HasFocus := .f. - ::Message := "" - ::Row := nRow + ::Typeout := .f. - ::Style := "[û ]" +RETURN Self - ::Typeout := .f. +METHOD SetFocus() CLASS CHECKBOX + IF !::HasFocus + ::lCursor := SetCursor( 0 ) + ::HasFocus := .T. + ::Display() + IF ISBLOCK( ::FBlock ) + Eval( ::FBlock ) + ENDIF + ENDIF - return Self +RETURN Self -METHOD SetFocus() CLASS HBCHECKBOX +METHOD _Select( lState ) CLASS CHECKBOX - if !::HasFocus .AND. ISBLOCK( ( ::lCursor := setcursor(0), ; - ::HasFocus := .T., ::display(), ::FBlock ) ) - eval(::FBlock) - endif + LOCAL lStatus := ::Buffer - return Self - -METHOD _Select(lState) CLASS HBCHECKBOX - Local lStatus := ::Buffer - - if ISLOGICAL( lState ) + IF ISLOGICAL( lState ) ::Buffer := lState - - else + ELSE ::Buffer := !::Buffer + ENDIF - endif + IF lStatus != ::Buffer + ::Display() + IF ISBLOCK( ::SBlock ) + Eval( ::SBlock ) + ENDIF + ENDIF - if lStatus != ::Buffer .AND. ISBLOCK( ( ::display(), ::SBlock ) ) - eval(::SBlock) - endif +RETURN Self - return Self +METHOD KillFocus() CLASS CHECKBOX -METHOD KillFocus() CLASS HBCHECKBOX - - if ::HasFocus + IF ::HasFocus ::HasFocus := .F. - if ISBLOCK( ::FBlock ) - eval(::FBlock) - endif + IF ISBLOCK( ::FBlock ) + Eval( ::FBlock ) + ENDIF - ::display() + ::Display() + SetCursor( ::lCursor ) - setcursor(::lCursor) + ENDIF - endif +RETURN Self - return Self +METHOD HitTest( nMouseRow, nMouseCol ) CLASS CHECKBOX -METHOD HitTest( nMouseRow, nMouseCol ) CLASS HBCHECKBOX - Local nPosAccel, nLenCaption + LOCAL nPosAccel, nLenCaption - if nMouseRow != ::Row - elseif nMouseCol < ::Col - elseif nMouseCol < ::Col + 3 - return HTCLIENT - endif + IF nMouseRow == ::Row .AND. ; + nMouseCol >= ::Col .AND. nMouseCol < ::Col + 3 + RETURN HTCLIENT + ENDIF - nLenCaption := Len(::Caption) + IF ISCHARACTER( ::Caption ) + nLenCaption := Len( ::Caption ) + IF ( nPosAccel := At( "&", ::Caption ) ) != 0 .AND. ; + nPosAccel < nLenCaption + nLenCaption-- + ENDIF - if ( nPosAccel := At("&", ::Caption) ) == 0 - elseif nPosAccel < nLenCaption - nLenCaption-- - endif + IF nMouseRow == ::CapRow .AND. ; + nMouseCol >= ::CapCol .AND. nMouseCol < ::CapCol + nLenCaption + RETURN HTCAPTION + ENDIF + ENDIF - if nMouseRow != ::CapRow - elseif nMouseCol < ::CapCol - elseif nMouseCol < ::CapCol + nLenCaption - return HTCAPTION - endif +RETURN HTNOWHERE - return 0 +METHOD Display() CLASS CHECKBOX -METHOD Display() CLASS HBCHECKBOX - Local cColor := SetColor(), nCurRow:= Row(), nCurCol:= Col(), ; - cOldStyle := ::Style, cCaption, nPos + LOCAL cColor := SetColor(), ; + nCurRow := Row(), nCurCol := Col(), ; + cOldStyle := ::Style, ; + cCaption, nPos DispBegin() - if ::HasFocus - set color to (__guicolor(::ColorSpec, 2)) - else - set color to (__guicolor(::ColorSpec, 1)) - endif + IF ::HasFocus + SET COLOR TO ( __GuiColor( ::ColorSpec, 2 ) ) + ELSE + SET COLOR TO ( __GuiColor( ::ColorSpec, 1 ) ) + ENDIF SetPos(::Row, ::Col + 1) - if ::Buffer - ?? SubStr(cOldStyle, 2, 1) - else - ?? SubStr(cOldStyle, 3, 1) - endif + IF ::Buffer + ?? Substr( cOldStyle, 2, 1 ) + ELSE + ?? Substr( cOldStyle, 3, 1 ) + ENDIF - set color to (__guicolor(::ColorSpec, 3)) + SET COLOR TO ( __GuiColor( ::ColorSpec, 3 ) ) + SetPos( ::Row, ::Col ) + ?? Left( cOldStyle, 1 ) + SetPos( ::Row, ::Col + 2 ) + ?? Right( cOldStyle, 1 ) - SetPos(::Row, ::Col) - ?? Left(cOldStyle, 1) + IF !Empty( cCaption := ::Caption ) + IF ( nPos := At( "&", cCaption ) ) != 0 + IF nPos == Len( cCaption ) + nPos := 0 + ELSE + cCaption := Stuff( cCaption, nPos, 1, "" ) + ENDIF + ENDIF - SetPos(::Row, ::Col + 2) - ?? right(cOldStyle, 1) + IF ::HasFocus + SET COLOR TO ( __GuiColor( ::ColorSpec, 4 ) ) + ENDIF - if !Empty(cCaption := ::Caption) - if ( nPos := At("&", cCaption) ) == 0 - elseif nPos == Len(cCaption) - nPos := 0 - else - cCaption := stuff(cCaption, nPos, 1, "") - endif - - SetPos(::CapRow, ::CapCol) + SetPos( ::CapRow, ::CapCol ) ?? cCaption - if nPos != 0 - set color to (__guicolor(::ColorSpec, 4)) - SetPos(::CapRow, ::CapCol + nPos - 1) - ?? SubStr(cCaption, nPos, 1) - endif + IF !::HasFocus .and. nPos != 0 + SET COLOR TO ( __GuiColor( ::ColorSpec, 4 ) ) + SetPos( ::CapRow, ::CapCol + nPos - 1 ) + ?? SubStr( cCaption, nPos, 1 ) + ENDIF + + ENDIF - endif DispEnd() - set color to (cColor) - SetPos(nCurRow, nCurCol) + SET COLOR TO ( cColor ) + SetPos( nCurRow, nCurCol ) - return Self +RETURN Self +FUNCTION _CHECKBOX_( lState, cCaption, cMessage, cColor, FBlock, SBlock, cStyle ) -function __GUICOLOR( cPair, nPos ) - Local cColor := cPair, nPosition:=0, nCommaPos:=0 + LOCAL oCheck - cColor := hb_ColorIndex( cPair, nPos-1 ) - return cColor + oCheck := hbCheckBox():New( Row(), Col(), cCaption ) -function _CHECKBOX_( lState, cCaption, cMessage, cColor, FBlock, SBlock, cStyle) - Local oCheck - - oCheck := HBCHECKBOX():New(Row(), Col(), cCaption) - - if !ISNIL( oCheck ) + IF !ISNIL( oCheck ) oCheck:Select( lState ) oCheck:Caption := cCaption - if !( cColor == nil ) + IF cColor != NIL oCheck:ColorSpec := cColor - endif + ENDIF oCheck:Message := cMessage - if !( cStyle == NIL ) + IF cStyle != NIL oCheck:Style := cStyle - endif + ENDIF oCheck:FBlock := FBlock oCheck:SBlock := SBlock - endif - return oCheck + ENDIF -function IsDefColor() - Local cColor:=SETCOLOR() +RETURN oCheck - Return ( cColor == "W/N,N/W,N/N,N/N,N/W" ) - -function Checkbox( nR, nCol, cCaption) +FUNCTION Checkbox( nRow, nCol, cCaption ) Default cCaption to '' - return HBCHECKBOX():New( nR, nCol, cCaption) +RETURN hbCheckBox():New( nRow, nCol, cCaption ) + +FUNCTION __GuiColor( cPair, nPos ) +RETURN hb_colorindex( cpair, npos - 1 ) + +FUNCTION IsDefColor() +RETURN UPPER( SetColor() ) == "W/N,N/W,N/N,N/N,N/W" #endif diff --git a/harbour/source/rtl/colorind.c b/harbour/source/rtl/colorind.c index 9031185d6f..5f1479b72a 100644 --- a/harbour/source/rtl/colorind.c +++ b/harbour/source/rtl/colorind.c @@ -56,7 +56,7 @@ HB_FUNC( HB_COLORINDEX ) { if( ISCHAR( 1 ) && ISNUM( 2 ) ) { - char * pszColor = hb_parc( 1 ); + char * pszColor = hb_parcx( 1 ); ULONG ulColorPos; ULONG ulColorLen; USHORT uiColorIndex = ( USHORT ) hb_parni( 2 ); diff --git a/harbour/source/rtl/console.c b/harbour/source/rtl/console.c index 16185797f5..e5f4611386 100644 --- a/harbour/source/rtl/console.c +++ b/harbour/source/rtl/console.c @@ -180,26 +180,6 @@ HB_FUNC( HB_OSNEWLINE ) hb_retc( s_szCrLf ); } -typedef void hb_out_func_typedef( const char *, ULONG ); - -/* Format items for output, then call specified output function */ -static void hb_conOut( USHORT uiParam, hb_out_func_typedef * pOutFunc ) -{ - char * pszString; - ULONG ulLen; - BOOL bFreeReq; - - HB_TRACE(HB_TR_DEBUG, ("hb_conOut(%hu, %p)", uiParam, pOutFunc)); - - pszString = hb_itemString( hb_param( uiParam, HB_IT_ANY ), &ulLen, &bFreeReq ); - - if ( ulLen ) - pOutFunc( pszString, ulLen ); - - if( bFreeReq ) - hb_xfree( pszString ); -} - /* Output an item to STDOUT */ void hb_conOutStd( const char * pStr, ULONG ulLen ) { @@ -225,7 +205,7 @@ void hb_conOutErr( const char * pStr, ULONG ulLen ) } /* Output an item to the screen and/or printer and/or alternate */ -static void hb_conOutAlt( const char * pStr, ULONG ulLen ) +void hb_conOutAlt( const char * pStr, ULONG ulLen ) { HB_TRACE(HB_TR_DEBUG, ("hb_conOutAlt(%s, %lu)", pStr, ulLen)); @@ -257,7 +237,8 @@ static void hb_conOutDev( const char * pStr, ULONG ulLen ) { HB_TRACE(HB_TR_DEBUG, ("hb_conOutDev(%s, %lu)", pStr, ulLen)); - if( hb_set.hb_set_printhan != FS_ERROR && hb_stricmp( hb_set.HB_SET_DEVICE, "PRINTER" ) == 0 ) + if( hb_set.hb_set_printhan != FS_ERROR && + hb_stricmp( hb_set.HB_SET_DEVICE, "PRINTER" ) == 0 ) { /* Display to printer if SET DEVICE TO PRINTER and valid printer file */ hb_fsWriteLarge( hb_set.hb_set_printhan, ( BYTE * ) pStr, ulLen ); @@ -268,6 +249,45 @@ static void hb_conOutDev( const char * pStr, ULONG ulLen ) hb_gtWrite( ( BYTE * ) pStr, ulLen ); } +typedef void hb_out_func_typedef( const char *, ULONG ); + +static char * hb_itemStringCon( PHB_ITEM pItem, ULONG * pulLen, BOOL * pfFreeReq ) +{ + /* logical values in device output (not console, stdout or stderr) are + shown as single letter */ + if( HB_IS_LOGICAL( pItem ) ) + { + *pulLen = 1; + *pfFreeReq = FALSE; + return ( char * ) ( hb_itemGetL( pItem ) ? "T" : "F" ); + } + return hb_itemString( pItem, pulLen, pfFreeReq ); +} + +/* Format items for output, then call specified output function */ +static void hb_conOut( USHORT uiParam, hb_out_func_typedef * pOutFunc ) +{ + char * pszString; + ULONG ulLen; + BOOL bFreeReq; + PHB_ITEM pItem; + + HB_TRACE(HB_TR_DEBUG, ("hb_conOut(%hu, %p)", uiParam, pOutFunc)); + + pItem = hb_param( uiParam, HB_IT_ANY ); + + if( pOutFunc == hb_conOutDev ) + pszString = hb_itemStringCon( pItem, &ulLen, &bFreeReq ); + else + pszString = hb_itemString( pItem, &ulLen, &bFreeReq ); + + if ( ulLen ) + pOutFunc( pszString, ulLen ); + + if( bFreeReq ) + hb_xfree( pszString ); +} + HB_FUNC( OUTSTD ) /* writes a list of values to the standard output device */ { USHORT uiPCount = hb_pcount(); @@ -365,7 +385,8 @@ static void hb_conDevPos( SHORT iRow, SHORT iCol ) /* Position printer if SET DEVICE TO PRINTER and valid printer file otherwise position console */ - if( hb_set.hb_set_printhan != FS_ERROR && hb_stricmp( hb_set.HB_SET_DEVICE, "PRINTER" ) == 0 ) + if( hb_set.hb_set_printhan != FS_ERROR && + hb_stricmp( hb_set.HB_SET_DEVICE, "PRINTER" ) == 0 ) { USHORT uiPRow = ( USHORT ) iRow; USHORT uiPCol = ( USHORT ) iCol + hb_set.HB_SET_MARGIN; @@ -474,7 +495,7 @@ HB_FUNC( DISPOUT ) /* writes a single value to the screen, but is not affected b hb_gtGetColorStr( szOldColor ); hb_gtSetColorStr( hb_parc( 2 ) ); - pszString = hb_itemString( hb_param( 1, HB_IT_ANY ), &ulLen, &bFreeReq ); + pszString = hb_itemStringCon( hb_param( 1, HB_IT_ANY ), &ulLen, &bFreeReq ); hb_gtWrite( ( BYTE * ) pszString, ulLen ); @@ -485,7 +506,7 @@ HB_FUNC( DISPOUT ) /* writes a single value to the screen, but is not affected b } else if( hb_pcount() >= 1 ) { - pszString = hb_itemString( hb_param( 1, HB_IT_ANY ), &ulLen, &bFreeReq ); + pszString = hb_itemStringCon( hb_param( 1, HB_IT_ANY ), &ulLen, &bFreeReq ); hb_gtWrite( ( BYTE * ) pszString, ulLen ); @@ -511,7 +532,7 @@ HB_FUNC( DISPOUTAT ) /* writes a single value to the screen at speficic position hb_gtGetColorStr( szOldColor ); hb_gtSetColorStr( hb_parc( 4 ) ); - pszString = hb_itemString( hb_param( 3, HB_IT_ANY ), &ulLen, &bFreeReq ); + pszString = hb_itemStringCon( hb_param( 3, HB_IT_ANY ), &ulLen, &bFreeReq ); hb_gtWriteAt( hb_parni( 1 ), hb_parni( 2 ), ( BYTE * ) pszString, ulLen ); @@ -522,7 +543,7 @@ HB_FUNC( DISPOUTAT ) /* writes a single value to the screen at speficic position } else if( hb_pcount() >= 3 ) { - pszString = hb_itemString( hb_param( 3, HB_IT_ANY ), &ulLen, &bFreeReq ); + pszString = hb_itemStringCon( hb_param( 3, HB_IT_ANY ), &ulLen, &bFreeReq ); hb_gtWriteAt( hb_parni( 1 ), hb_parni( 2 ), ( BYTE * ) pszString, ulLen ); diff --git a/harbour/source/rtl/copyfile.c b/harbour/source/rtl/copyfile.c index 6d279f3977..fe9f067135 100644 --- a/harbour/source/rtl/copyfile.c +++ b/harbour/source/rtl/copyfile.c @@ -68,11 +68,11 @@ static BOOL hb_fsCopy( char * szSource, char * szDest ) HB_TRACE(HB_TR_DEBUG, ("hb_fsCopy(%s, %s)", szSource, szDest)); - while( ( fhndSource = hb_fsOpen( ( BYTE * ) szSource, FO_READ | FO_SHARED | FO_PRIVATE ) ) == FS_ERROR ) + while( ( fhndSource = hb_spOpen( ( BYTE * ) szSource, FO_READ | FO_SHARED | FO_PRIVATE ) ) == FS_ERROR ) { USHORT uiAction = hb_errRT_BASE_Ext1( EG_OPEN, 2012, NULL, szSource, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 0 ); - if( uiAction == E_DEFAULT || uiAction == E_BREAK ) + if( uiAction != E_RETRY ) break; } @@ -80,11 +80,11 @@ static BOOL hb_fsCopy( char * szSource, char * szDest ) { FHANDLE fhndDest; - while( ( fhndDest = hb_fsCreate( ( BYTE * ) szDest, FC_NORMAL ) ) == FS_ERROR ) + while( ( fhndDest = hb_spCreate( ( BYTE * ) szDest, FC_NORMAL ) ) == FS_ERROR ) { USHORT uiAction = hb_errRT_BASE_Ext1( EG_CREATE, 2012, NULL, szDest, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 0 ); - if( uiAction == E_DEFAULT || uiAction == E_BREAK ) + if( uiAction != E_RETRY ) break; } @@ -107,7 +107,7 @@ static BOOL hb_fsCopy( char * szSource, char * szDest ) { USHORT uiAction = hb_errRT_BASE_Ext1( EG_WRITE, 2016, NULL, szDest, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 0 ); - if( uiAction == E_DEFAULT || uiAction == E_BREAK ) + if( uiAction != E_RETRY ) { bRetVal = FALSE; break; diff --git a/harbour/source/rtl/dateshb.c b/harbour/source/rtl/dateshb.c index e23e0053a0..ad3954ffeb 100644 --- a/harbour/source/rtl/dateshb.c +++ b/harbour/source/rtl/dateshb.c @@ -221,7 +221,7 @@ HB_FUNC( YEAR ) hb_dateDecode( hb_itemGetDL( pDate ), &iYear, &iMonth, &iDay ); - hb_retnllen( iYear, 5 ); + hb_retnilen( iYear, 5 ); } else hb_errRT_BASE_SubstR( EG_ARG, 1112, NULL, "YEAR", HB_ERR_ARGS_BASEPARAMS ); diff --git a/harbour/source/rtl/defpath.c b/harbour/source/rtl/defpath.c index b3ae34e788..1abe0b4949 100644 --- a/harbour/source/rtl/defpath.c +++ b/harbour/source/rtl/defpath.c @@ -57,20 +57,15 @@ HB_FUNC( DEFPATH ) { - char buffer[ _POSIX_PATH_MAX + 1 ]; - char delimiter[ 2 ] = ":"; - int size; - - buffer[0] = '\0'; + char buffer[ _POSIX_PATH_MAX + 2 ]; + int size = 0; if( hb_set.HB_SET_DEFAULT ) { /* Leave enough space to append a path delimiter */ - strncat( buffer, hb_set.HB_SET_DEFAULT, sizeof( buffer ) - 1 ); - size = sizeof( buffer ) - 2; /* ? */ - buffer[ size ] = '\0'; + hb_strncpy( buffer, hb_set.HB_SET_DEFAULT, sizeof( buffer ) - 1 ); + size = strlen( buffer ); } - size = strlen( buffer ); HB_TRACE(HB_TR_INFO, ("HB_DEFPATH: buffer is |%s|, size is %d, last char is |%c|", buffer, size, buffer[ size - 1])); HB_TRACE(HB_TR_INFO, ("HB_DEFPATH: OS_PATH_DELIMITER is |%c| and OS_PATH_LIST_SEPARATOR is |%c|", OS_PATH_DELIMITER, OS_PATH_LIST_SEPARATOR)); @@ -81,14 +76,21 @@ HB_FUNC( DEFPATH ) the path delimiter. This allows the use of a drive letter delimiter for DOS compatible operating systems while preventing it from being with a Unix compatible OS. */ - if( size && buffer[ size - 1 ] != ':' && buffer[ size - 1 ] != OS_PATH_DELIMITER ) +#ifdef OS_HAS_DRIVE_LETTER + if( size && buffer[ size - 1 ] != OS_PATH_DELIMITER && + buffer[ size - 1 ] != OS_DRIVE_DELIMITER ) { - if( size > 1 || OS_PATH_LIST_SEPARATOR == ':' ) - delimiter[ 0 ] = OS_PATH_DELIMITER; - hb_strncat( buffer, delimiter, _POSIX_PATH_MAX ); + if( size == 1 ) + buffer[ size++ ] = OS_DRIVE_DELIMITER; + else + buffer[ size++ ] = OS_PATH_DELIMITER; } +#else + if( size && buffer[ size - 1 ] != OS_PATH_DELIMITER ) + buffer[ size++ ] = OS_PATH_DELIMITER; +#endif - hb_retc( buffer ); + hb_retclen( buffer, size ); } HB_FUNC( __DEFPATH ) diff --git a/harbour/source/rtl/devoutp.prg b/harbour/source/rtl/devoutp.prg index 315a806ae9..05ff5d7813 100644 --- a/harbour/source/rtl/devoutp.prg +++ b/harbour/source/rtl/devoutp.prg @@ -52,11 +52,8 @@ PROCEDURE DevOutPict( xValue, cPicture, cColor ) - if valtype(xValue) $ "CNDLM" - + IF Valtype( xValue ) $ "CMNDL" DevOut( Transform( xValue, cPicture ), cColor ) + ENDIF - endif - - RETURN - +RETURN diff --git a/harbour/source/rtl/dircmd.prg b/harbour/source/rtl/dircmd.prg index c5c8caec32..d2ba91da42 100644 --- a/harbour/source/rtl/dircmd.prg +++ b/harbour/source/rtl/dircmd.prg @@ -64,7 +64,7 @@ PROCEDURE __Dir( cFileMask ) /* NOTE: Although Cl*pper has this string in the national language modul, it will not use it from here. - This is hard wired to English. So this is a small + This is hard wired to English. So this is a small incompatibility */ #ifdef HB_C52_STRICT @@ -101,13 +101,13 @@ STATIC PROCEDURE PutDBF( aDirEntry ) buffer := Replicate( Chr( 0 ), 8 ) IF FRead( fhnd, @buffer, 8 ) == 8 .AND. ; - ( Bin2W( Left( buffer, 1 ) ) == 3 .OR. ; - Bin2W( Left( buffer, 1 ) ) == 131 ) + AScan( { 0x03, 0x06, 0x30, 0x31, 0x83, 0x86, 0xE5, 0xE6, 0xF5, 0xF6 }, ; + ASC( buffer ) ) != 0 nRecCount := Bin2L( SubStr( buffer, 5, 4 ) ) - dLastUpdate := hb_SToD( StrZero( Bin2W( SubStr( buffer, 2, 1 ) ) + 1900, 4 ) +; - StrZero( Bin2W( SubStr( buffer, 3, 1 ) ), 2 ) +; - StrZero( Bin2W( SubStr( buffer, 4, 1 ) ), 2 ) ) + dLastUpdate := SToD( StrZero( ASC( SubStr( buffer, 2, 1 ) ) + 1900, 4 ) +; + StrZero( ASC( SubStr( buffer, 3, 1 ) ), 2 ) +; + StrZero( ASC( SubStr( buffer, 4, 1 ) ), 2 ) ) ENDIF diff --git a/harbour/source/rtl/filehb.c b/harbour/source/rtl/filehb.c index be14ed8c22..bba04e13a4 100644 --- a/harbour/source/rtl/filehb.c +++ b/harbour/source/rtl/filehb.c @@ -58,7 +58,10 @@ /* NOTE: CA-Cl*pper RTrim()s the filename before doing the existence check. This is not multiplatform friendly, so Harbour doesn't do any - modification on the filename. [vszakats] */ + modification on the filename. [vszakats] + It seems to be rather DOS not Clipper behavior. In Harbour we have + _SET_TRIMFILENAME which can enable emulation of such behavior in + other OS-es. [druzus] */ HB_FUNC( FILE ) { diff --git a/harbour/source/rtl/filesys.c b/harbour/source/rtl/filesys.c index 922a32792d..94d85193e7 100644 --- a/harbour/source/rtl/filesys.c +++ b/harbour/source/rtl/filesys.c @@ -1905,14 +1905,12 @@ HB_EXPORT USHORT hb_fsCurDirBuff( USHORT uiDrive, BYTE * pbyBuffer, ULONG ulLen * It will allow us to add drive emulation in hb_fsCurDrv()/hb_fsChDrv() * and hb_fileNameConv() */ -#if !defined(HB_OS_OS2) +#if !defined(HB_OS_OS2) && !defined(__MINGW32__) if( uiDrive ) { uiCurDrv = hb_fsCurDrv() + 1; if( uiDrive != uiCurDrv ) - { hb_fsChDrv( uiDrive - 1 ); - } } #endif @@ -2016,7 +2014,7 @@ HB_EXPORT USHORT hb_fsChDrv( BYTE nDrive ) uiResult = (USHORT) FS_ERROR; hb_fsSetError( (USHORT) FS_ERROR ); } - } + } #else HB_SYMBOL_UNUSED( nDrive ); @@ -2061,7 +2059,6 @@ HB_EXPORT USHORT hb_fsIsDrv( BYTE nDrive ) } HB_FS_SETDRIVE( uiSave ); } - #else HB_SYMBOL_UNUSED( nDrive ); @@ -2344,7 +2341,7 @@ HB_EXPORT BYTE * hb_fileNameConv( char *str ) { char *filename; ULONG ulDirLen, ulFileLen; -#ifdef __XHARBOUR__ + /* strip trailing and leading spaces */ if( hb_set.HB_SET_TRIMFILENAME ) { char *szFileTrim; @@ -2358,7 +2355,6 @@ HB_EXPORT BYTE * hb_fileNameConv( char *str ) { } str[ulLen] = '\0'; } -#endif if( hb_set.HB_SET_DIRSEPARATOR != '\\' ) { diff --git a/harbour/source/rtl/fkmax.c b/harbour/source/rtl/fkmax.c index 35b8eb13a0..5976f0d4d5 100644 --- a/harbour/source/rtl/fkmax.c +++ b/harbour/source/rtl/fkmax.c @@ -76,11 +76,8 @@ HB_FUNC( FKLABEL ) snprintf( szName, sizeof( szName ), "F%i", uiFKey ); hb_retc( szName ); + return; } - else - hb_retc( NULL ); } - else - hb_retc( NULL ); + hb_retc( NULL ); } - diff --git a/harbour/source/rtl/gete.c b/harbour/source/rtl/gete.c index b298cb1f17..cefc5a742a 100644 --- a/harbour/source/rtl/gete.c +++ b/harbour/source/rtl/gete.c @@ -107,7 +107,7 @@ HB_FUNC( GETENV ) { if( szValue ) hb_xfree( szValue ); - hb_retc( hb_parcx( 2 ) ); + hb_retc( hb_parc( 2 ) ); } } else diff --git a/harbour/source/rtl/hbgtcore.c b/harbour/source/rtl/hbgtcore.c index 69dba03caa..1b3dc920d3 100644 --- a/harbour/source/rtl/hbgtcore.c +++ b/harbour/source/rtl/hbgtcore.c @@ -938,6 +938,16 @@ static void hb_gt_def_WriteCon( BYTE * pText, ULONG ulLength ) --iRow; bDisp = TRUE; } + if( bDisp ) + { + if( iLen ) + szString[ iLen - 1 ] = ' '; + else + { + hb_gt_SetPos( iRow, iCol ); + szString[ iLen++ ] = ' '; + } + } break; case HB_CHAR_LF: diff --git a/harbour/source/rtl/inkey.c b/harbour/source/rtl/inkey.c index eca52b4e13..416d6317d1 100644 --- a/harbour/source/rtl/inkey.c +++ b/harbour/source/rtl/inkey.c @@ -599,11 +599,5 @@ HB_FUNC( LASTKEY ) HB_FUNC( HB_SETLASTKEY ) { if( ISNUM(1) ) - { - hb_retni( hb_setInkeyLast( hb_parni(1) ) ); - } - else - { - hb_ret(); - } + hb_retni( hb_setInkeyLast( hb_parni( 1 ) ) ); } diff --git a/harbour/source/rtl/isprint.c b/harbour/source/rtl/isprint.c index aa48aa3772..38dfa91685 100644 --- a/harbour/source/rtl/isprint.c +++ b/harbour/source/rtl/isprint.c @@ -66,10 +66,13 @@ #include "hbapi.h" #include "hbapifs.h" -#if defined(HB_OS_WIN_32) && !defined(__RSXNT__) - #include - #include +#undef HB_WIN_32_PRINTERS +#if defined(HB_OS_WIN_32) && !defined(__RSXNT__) && !defined(__CYGWIN__) + +# define HB_WIN_32_PRINTERS +# include +# include static BOOL IsPrinterError(HANDLE hPrinter); @@ -80,6 +83,8 @@ static BOOL DPGetDefaultPrinter(LPTSTR pPrinterName, LPDWORD pdwBufferSize); #endif +#define MAXBUFFERSIZE 255 + HB_EXPORT BOOL hb_printerIsReady( char * pszPrinterName ) { BOOL bIsPrinter; @@ -119,14 +124,17 @@ HB_EXPORT BOOL hb_printerIsReady( char * pszPrinterName ) bIsPrinter = FALSE; } -#elif defined(HB_OS_WIN_32) && !defined(__RSXNT__) +#elif defined(HB_WIN_32_PRINTERS) { HANDLE hPrinter; - OpenPrinter( pszPrinterName, &hPrinter, NULL ); - - bIsPrinter = ! IsPrinterError( hPrinter ); + bIsPrinter = FALSE; + if( *pszPrinterName && OpenPrinter( pszPrinterName, &hPrinter, NULL ) ) + { + bIsPrinter = ! IsPrinterError( hPrinter ); + CloseHandle( hPrinter ); + } } #else @@ -154,21 +162,21 @@ HB_EXPORT BOOL hb_printerIsReady( char * pszPrinterName ) HB_FUNC( ISPRINTER ) { - #if defined(HB_OS_WIN_32) && !defined(__RSXNT__) - { - char DefaultPrinter[ 80 ]; - DWORD pdwBufferSize = 80; - DPGetDefaultPrinter( ( LPTSTR ) &DefaultPrinter, &pdwBufferSize); - hb_retl( hb_printerIsReady( ISCHAR( 1 ) ? hb_parc( 1 ) : ( char * ) DefaultPrinter ) ); - } - #else - hb_retl( hb_printerIsReady( ISCHAR( 1 ) ? hb_parc( 1 ) : ( char * ) "LPT1" ) ); - #endif +#if defined(HB_WIN_32_PRINTERS) + char DefaultPrinter[MAXBUFFERSIZE]; + DWORD pdwBufferSize = MAXBUFFERSIZE; + DPGetDefaultPrinter( ( LPTSTR ) &DefaultPrinter, &pdwBufferSize ); + hb_retl( hb_printerIsReady( ISCHAR( 1 ) ? hb_parc( 1 ) : ( char * ) DefaultPrinter ) ); +#else + char * pszPrinter = hb_parc( 1 ); + hb_retl( hb_printerIsReady( pszPrinter ? pszPrinter : ( char * ) "LPT1" ) ); +#endif } + /* The code below does the check for the printer under Win32 */ -#if defined(HB_OS_WIN_32) && !defined(__RSXNT__) +#if defined(HB_WIN_32_PRINTERS) static BOOL IsPrinterError( HANDLE hPrinter ) { @@ -322,7 +330,7 @@ static BOOL GetJobs(HANDLE hPrinter, /* Handle to the printer. */ return TRUE; } -#define MAXBUFFERSIZE 250 + static BOOL DPGetDefaultPrinter(LPTSTR pPrinterName, LPDWORD pdwBufferSize) { BOOL bFlag; diff --git a/harbour/source/rtl/langapi.c b/harbour/source/rtl/langapi.c index 1c8c4a0a1f..e768631d03 100644 --- a/harbour/source/rtl/langapi.c +++ b/harbour/source/rtl/langapi.c @@ -366,9 +366,13 @@ char * hb_langDGetErrorDesc( ULONG ulIndex ) HB_FUNC( HB_LANGSELECT ) { + char * szNewLang; + hb_retc( hb_langID() ); - hb_langSelectID( hb_parc( 1 ) ); + szNewLang = hb_parc( 1 ); + if( szNewLang ) + hb_langSelectID( szNewLang ); } HB_FUNC( HB_LANGNAME ) diff --git a/harbour/source/rtl/listbox.prg b/harbour/source/rtl/listbox.prg index 2d33828914..37a483182c 100644 --- a/harbour/source/rtl/listbox.prg +++ b/harbour/source/rtl/listbox.prg @@ -57,7 +57,9 @@ #include "button.ch" #ifdef HB_COMPAT_C53 -Class HBListBox +CREATE CLASS LISTBOX FUNCTION HBListBox + +Exported: Method New( nTop, nLeft, nBottom, nRight, lDrop ) @@ -83,7 +85,6 @@ Class HBListBox Method SetFocus() Method SetItem( nPos, aitem ) Method SetText( nPos, xValue ) - Data ClassName Init "LISTBOX" Data Buffer Data CapCol Data CapRow @@ -126,7 +127,7 @@ Class HBListBox ACCESS TypeOut inline ::itemCount == 0 ASSIGN TypeOut( x ) inline IIF( x != nil, x, ::itemCount == 0 ) - Hidden: +Hidden: Method SetScroll( xData ) Data xTop Init 0 @@ -144,7 +145,8 @@ Class HBListBox Method SetTopItem( xTop ) Data cSaveScreen Init NIL Data nSaveTop, nSaveLeft, nSaveBottom, nSaveRight -Endclass + +ENDCLASS Method New( nTop, nLeft, nBottom, nRight, lDrop ) @@ -210,7 +212,7 @@ RETURN SELF /**** Get/Set Datas ****/ -Method SetScroll( xData ) Class HBListBox +Method SetScroll( xData ) Class ListBox IF ISOBJECT( xData ) /*.and. xData:Classname=="SCROLLBAR" .and. xData:orient==1)*/ ::vScrolls := xData @@ -219,7 +221,7 @@ Method SetScroll( xData ) Class HBListBox RETURN ::vScrolls -Method SetTop( xData ) Class HBListBox +Method SetTop( xData ) Class ListBox IF ISNUMBER( ::xTop := xData ) .and. ISOBJECT( ::vScroll ) ::vScroll:start := xData + 1 @@ -227,7 +229,7 @@ Method SetTop( xData ) Class HBListBox RETURN ::xTop -Method SetRight( xData ) Class HBListBox +Method SetRight( xData ) Class ListBox IF !( ISNIL( xData ) ) .and. ISOBJECT( ( ::xRight := xData, ::vScroll ) ) ::vScroll:offset := xData @@ -235,7 +237,7 @@ Method SetRight( xData ) Class HBListBox RETURN ::xRight -Method SetDropDown( xData ) Class HBListBox +Method SetDropDown( xData ) Class ListBox IF ISLOGICAL( xData ) ::xDropDown := xData @@ -249,7 +251,7 @@ Method SetDropDown( xData ) Class HBListBox RETURN ::xDropDown -Method SetCaption( xData ) Class HBListBox +Method SetCaption( xData ) Class ListBox IF ISCHARACTER( xData ) .and. ISNIL( ::Capcol ) ::cCaption := xData @@ -259,7 +261,7 @@ Method SetCaption( xData ) Class HBListBox RETURN ::cCaption -Method SetBottom( xData ) Class HBListBox +Method SetBottom( xData ) Class ListBox Local nBottom @@ -272,7 +274,7 @@ RETURN ::xBottom /*** Class Methods ***/ -Method ADDITEM( cText, xValue ) Class HBListBox +Method ADDITEM( cText, xValue ) Class ListBox IF ! ISCHARACTER( cText ) ELSEIF Valtype( xValue ) $ "CUN" @@ -288,7 +290,7 @@ Method ADDITEM( cText, xValue ) Class HBListBox RETURN SELF -Method Close() Class HBListBox +Method Close() Class ListBox IF ::isOpen @@ -341,7 +343,7 @@ Method DELITEM( xitem ) RETURN SELF -Method Getdata( xData ) Class HBListBox +Method Getdata( xData ) Class ListBox Local xRet := Nil @@ -352,7 +354,7 @@ Method Getdata( xData ) Class HBListBox RETURN xRet -Method FindData( cText, nPos, lCaseSensitive, lExact ) Class HBListBox +Method FindData( cText, nPos, lCaseSensitive, lExact ) Class ListBox Local nPosFound Local lOldExact @@ -414,7 +416,7 @@ Method FindData( cText, nPos, lCaseSensitive, lExact ) Class HBListBox RETURN nPosFound -Method FindText( cText, nPos, lCaseSensitive, lExact ) Class HBListBox +Method FindText( cText, nPos, lCaseSensitive, lExact ) Class ListBox Local nPosFound Local lOldExact @@ -476,7 +478,7 @@ Method FindText( cText, nPos, lCaseSensitive, lExact ) Class HBListBox RETURN nPosFound -Method NEXTITEM() Class HBListBox +Method NEXTITEM() Class ListBox Local nCurValue Local nValue @@ -496,7 +498,7 @@ Method NEXTITEM() Class HBListBox RETURN SELF -Method PREVITEM() Class HBListBox +Method PREVITEM() Class ListBox Local nCurValue Local nValue @@ -518,7 +520,7 @@ Method PREVITEM() Class HBListBox RETURN SELF -Method _SCROLL( nMethod ) Class HBListBox +Method _SCROLL( nMethod ) Class ListBox Local nPos Local nTopItem @@ -622,7 +624,7 @@ Method _SCROLL( nMethod ) Class HBListBox End RETURN SELF -Method SELECTS( nPosition ) Class HBListBox +Method SELECTS( nPosition ) Class ListBox Local nValue Local nPos @@ -689,7 +691,7 @@ Method SELECTS( nPosition ) Class HBListBox RETURN ::value -Method SetTOPITEM( xData ) Class HBListBox +Method SetTOPITEM( xData ) Class ListBox Local nSize Local nPos @@ -714,7 +716,7 @@ Method SetTOPITEM( xData ) Class HBListBox ENDIF RETURN ::xtopitem -Method Display() Class HBListBox +Method Display() Class ListBox Local nCurRow := Row() Local nCurCol := Col() @@ -835,7 +837,7 @@ Method Display() Class HBListBox RETURN SELF -Method GetItem( xItem ) Class HBListBox +Method GetItem( xItem ) Class ListBox Local xRet := Nil @@ -846,7 +848,7 @@ Method GetItem( xItem ) Class HBListBox RETURN xRet -Method GetText( xItem ) Class HBListBox +Method GetText( xItem ) Class ListBox Local xRet := Nil @@ -878,14 +880,13 @@ Method InsItem( nPosition, cText, xExp ) ENDIF RETURN SELF -Method HitTest( nMouseRow, nMouseCol ) Class HBListBox +Method HitTest( nMouseRow, nMouseCol ) Class ListBox Local nRet, nTop Local nHit := 0 - IF ! ::isopen - ELSEIF ! ISOBJECT( ::vScroll ) - ELSEIF ( nHit := ::vScroll:hittest( nMouseRow, nMouseCol ) ) != 0 + IF ::isopen .AND. ISOBJECT( ::vScroll ) .AND. ; + ( nHit := ::vScroll:hittest( nMouseRow, nMouseCol ) ) != 0 RETURN nHit ENDIF @@ -959,7 +960,7 @@ Method HitTest( nMouseRow, nMouseCol ) Class HBListBox RETURN 0 -Method KillFocus() Class HBListBox +Method KillFocus() Class ListBox IF ::hasfocus ::hasfocus := .F. @@ -983,7 +984,7 @@ Method KillFocus() Class HBListBox RETURN SELF -Method Open() Class HBListBox +Method Open() Class ListBox IF ! ::isopen @@ -998,7 +999,7 @@ Method Open() Class HBListBox ENDIF RETURN SELF -Method SetText( nPos, cText ) Class HBListBox +Method SetText( nPos, cText ) Class ListBox IF nPos < 1 ELSEIF nPos <= ::itemCount @@ -1006,7 +1007,7 @@ Method SetText( nPos, cText ) Class HBListBox ENDIF RETURN SELF -Method SetItem( nPos, cText ) Class HBListBox +Method SetItem( nPos, cText ) Class ListBox Do CASE CASE nPos < 1 @@ -1017,7 +1018,7 @@ Method SetItem( nPos, cText ) Class HBListBox ENDCASE RETURN SELF -Method SetFocus() Class HBListBox +Method SetFocus() Class ListBox IF ! ::hasfocus ::nCursor := Setcursor( 0 ) @@ -1034,7 +1035,7 @@ Method SetFocus() Class HBListBox RETURN SELF -Method SetData( nPos, xData ) Class HBListBox +Method SetData( nPos, xData ) Class ListBox IF nPos >= 1 .and. nPos <= ::itemCount ::aitems[ nPos, 2 ] := xData @@ -1205,5 +1206,3 @@ Function __CapLength( cCaption ) RETURN nRet #endif - -*+ EOF: LISTBOX.PRG diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index 9f0594fee1..66790099cc 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -56,10 +56,10 @@ */ #if defined(__DJGPP__) -#include +# include _LIB_VERSION_TYPE _LIB_VERSION = _XOPEN_; #else -#include +# include #endif #include "hbapi.h" @@ -69,10 +69,10 @@ _LIB_VERSION_TYPE _LIB_VERSION = _XOPEN_; #include "hbmath.h" #if defined(HB_MATH_ERRNO) -# include +# include #endif #if defined(HB_OS_SUNOS) -# include +# include #endif /* @@ -82,52 +82,51 @@ _LIB_VERSION_TYPE _LIB_VERSION = _XOPEN_; * ************************************************************ */ -static HB_MATH_EXCEPTION s_hb_exc = {HB_MATH_ERR_NONE, "", "", 0.0, 0.0, 0.0, 1, 0, 0}; +static HB_MATH_EXCEPTION s_hb_exc = { HB_MATH_ERR_NONE, "", "", 0.0, 0.0, 0.0, 1, 0, 0 }; /* reset math error information */ -void hb_mathResetError (void) +void hb_mathResetError( void ) { - HB_TRACE (HB_TR_DEBUG, ("hb_mathResetError()")); + HB_TRACE( HB_TR_DEBUG, ( "hb_mathResetError()" ) ); s_hb_exc.type = HB_MATH_ERR_NONE; s_hb_exc.funcname = ""; s_hb_exc.error = ""; s_hb_exc.arg1 = 0.0; s_hb_exc.arg2 = 0.0; s_hb_exc.retval = 0.0; - s_hb_exc.retvalwidth = -1; /* we don't know */ - s_hb_exc.retvaldec = -1; /* use standard SET DECIMALS */ + s_hb_exc.retvalwidth = -1; /* we don't know */ + s_hb_exc.retvaldec = -1; /* use standard SET DECIMALS */ s_hb_exc.handled = 1; - return; } /* get last math error */ -int hb_mathGetLastError (HB_MATH_EXCEPTION * phb_exc) +int hb_mathGetLastError( HB_MATH_EXCEPTION * phb_exc ) { - HB_TRACE (HB_TR_DEBUG, ("hb_mathGetLastError(%p)", phb_exc)); - if (phb_exc != NULL) + HB_TRACE( HB_TR_DEBUG, ( "hb_mathGetLastError(%p)", phb_exc ) ); + if( phb_exc != NULL ) { - phb_exc->type = s_hb_exc.type; - phb_exc->funcname = s_hb_exc.funcname; - phb_exc->error = s_hb_exc.error; - phb_exc->arg1 = s_hb_exc.arg1; - phb_exc->arg2 = s_hb_exc.arg2; - phb_exc->retval = s_hb_exc.retval; - phb_exc->retvalwidth = s_hb_exc.retvalwidth; - phb_exc->retvaldec = s_hb_exc.retvaldec; - phb_exc->handled = s_hb_exc.handled; + phb_exc->type = s_hb_exc.type; + phb_exc->funcname = s_hb_exc.funcname; + phb_exc->error = s_hb_exc.error; + phb_exc->arg1 = s_hb_exc.arg1; + phb_exc->arg2 = s_hb_exc.arg2; + phb_exc->retval = s_hb_exc.retval; + phb_exc->retvalwidth = s_hb_exc.retvalwidth; + phb_exc->retvaldec = s_hb_exc.retvaldec; + phb_exc->handled = s_hb_exc.handled; } - return (s_hb_exc.type); + return s_hb_exc.type; } /* is it reasonable to install math error handlers ? This depends on the C math lib we are using ! */ -int hb_mathIsMathErr (void) +int hb_mathIsMathErr( void ) { - HB_TRACE (HB_TR_DEBUG, ("hb_mathIsMathErr()")); + HB_TRACE( HB_TR_DEBUG, ( "hb_mathIsMathErr()" ) ); #if defined(HB_MATH_HANDLER) - return (1); + return 1; #else - return (0); + return 0; #endif } @@ -135,114 +134,107 @@ int hb_mathIsMathErr (void) #if defined(HB_MATH_HANDLER) int -#ifdef __BORLANDC__ -HB_EXPORT -#endif -matherr (struct exception * err) +# ifdef __BORLANDC__ + HB_EXPORT +# endif +matherr( struct exception *err ) { int retval; HB_MATH_HANDLERPROC mathHandler; - HB_TRACE (HB_TR_DEBUG, ("matherr(%p)", err)); + HB_TRACE( HB_TR_DEBUG, ( "matherr(%p)", err ) ); /* map math error types */ - switch (err->type) + switch( err->type ) { case DOMAIN: - { s_hb_exc.type = HB_MATH_ERR_DOMAIN; s_hb_exc.error = "Argument not in domain of function"; - }; break; + break; + case SING: - { s_hb_exc.type = HB_MATH_ERR_SING; s_hb_exc.error = "Calculation results in singularity"; - }; break; + break; + case OVERFLOW: - { s_hb_exc.type = HB_MATH_ERR_OVERFLOW; s_hb_exc.error = "Calculation result too large to represent"; - }; break; + break; + case UNDERFLOW: - { s_hb_exc.type = HB_MATH_ERR_UNDERFLOW; s_hb_exc.error = "Calculation result too small to represent"; - }; break; + break; + case TLOSS: - { s_hb_exc.type = HB_MATH_ERR_TLOSS; s_hb_exc.error = "Total loss of significant digits"; - }; break; + break; + case PLOSS: - { s_hb_exc.type = HB_MATH_ERR_PLOSS; s_hb_exc.error = "Partial loss of significant digits"; - }; break; + break; + default: - { s_hb_exc.type = HB_MATH_ERR_UNKNOWN; s_hb_exc.error = "Unknown math error"; - }; break; + break; } - s_hb_exc.funcname = (char *)err->name; /* (char *) Avoid warning in DJGPP */ + s_hb_exc.funcname = ( char * ) err->name; /* (char *) Avoid warning in DJGPP */ s_hb_exc.arg1 = err->arg1; s_hb_exc.arg2 = err->arg2; s_hb_exc.retval = err->retval; s_hb_exc.handled = 0; mathHandler = hb_mathGetHandler(); - if (mathHandler != NULL) + if( mathHandler != NULL ) { - retval = (*(mathHandler))(&s_hb_exc); - err->retval = s_hb_exc.retval; + retval = ( *( mathHandler ) ) ( &s_hb_exc ); + err->retval = s_hb_exc.retval; } else { - /* there is no custom math handler */ - retval = 1; /* don't print any message, don't set errno and use return value provided by C RTL */ + /* there is no custom math handler */ + retval = 1; /* don't print any message, don't set errno and use return value provided by C RTL */ } - return (retval); + return retval; } #elif defined(HB_MATH_ERRNO) -static int hb_mathErrSet( double dResult, double arg1, double arg2, char * szFunc, int errCode ) +static int hb_mathErrSet( double dResult, double arg1, double arg2, char *szFunc, int errCode ) { HB_MATH_HANDLERPROC mathHandler; - HB_TRACE (HB_TR_DEBUG, ("hb_mathErrSet(%f, %d)", dResult, errCode)); + HB_TRACE( HB_TR_DEBUG, ( "hb_mathErrSet(%f, %d)", dResult, errCode ) ); switch( errCode ) { case EDOM: case ERANGE: -#if defined(EOVERFLOW) +# if defined(EOVERFLOW) case EOVERFLOW: -#endif +# endif break; default: - if ( isnan( dResult ) ) - { + if( isnan( dResult ) ) errCode = EDOM; - } -#if defined(HB_OS_SUNOS) - else if ( !finite( dResult ) ) -#elif defined(HB_OS_OS2) - else if ( !isfinite( dResult ) ) -#else - else if ( isinf( dResult ) ) -#endif - { +# if defined(HB_OS_SUNOS) + else if( !finite( dResult ) ) +# elif defined(HB_OS_OS2) + else if( !isfinite( dResult ) ) +# else + else if( isinf( dResult ) ) +# endif errCode = ERANGE; - } } - if ( errCode == 0 ) - { + if( errCode == 0 ) return 0; - } hb_mathResetError(); @@ -258,12 +250,12 @@ static int hb_mathErrSet( double dResult, double arg1, double arg2, char * szFun s_hb_exc.type = HB_MATH_ERR_SING; s_hb_exc.error = "Calculation results in singularity"; break; -#if defined(EOVERFLOW) +# if defined(EOVERFLOW) case EOVERFLOW: s_hb_exc.type = HB_MATH_ERR_OVERFLOW; s_hb_exc.error = "Calculation result too large to represent"; break; -#endif +# endif default: s_hb_exc.type = HB_MATH_ERR_UNKNOWN; s_hb_exc.error = "Unknown math error"; @@ -279,7 +271,7 @@ static int hb_mathErrSet( double dResult, double arg1, double arg2, char * szFun mathHandler = hb_mathGetHandler(); if( mathHandler != NULL ) { - ( *( mathHandler ) )( &s_hb_exc ); + ( *( mathHandler ) ) ( &s_hb_exc ); } return 1; } @@ -292,48 +284,43 @@ static int hb_mathErrSet( double dResult, double arg1, double arg2, char * szFun * ************************************************************ */ -static int s_hb_matherr_mode = HB_MATH_ERRMODE_DEFAULT; /* TODO: make this thread safe */ +static int s_hb_matherr_mode = HB_MATH_ERRMODE_DEFAULT; /* TODO: make this thread safe */ /* set error handling mode of hb_matherr() */ -int hb_mathSetErrMode (int imode) +int hb_mathSetErrMode( int imode ) { - int oldmode; + int oldmode; - HB_TRACE (HB_TR_DEBUG, ("hb_mathSetErrMode (%i)", imode)); + HB_TRACE( HB_TR_DEBUG, ( "hb_mathSetErrMode (%i)", imode ) ); - oldmode = s_hb_matherr_mode; + oldmode = s_hb_matherr_mode; - if ((imode == HB_MATH_ERRMODE_DEFAULT) || - (imode == HB_MATH_ERRMODE_CDEFAULT) || - (imode == HB_MATH_ERRMODE_USER) || - (imode == HB_MATH_ERRMODE_USERDEFAULT) || - (imode == HB_MATH_ERRMODE_USERCDEFAULT)) - { - s_hb_matherr_mode = imode; - } + if( ( imode == HB_MATH_ERRMODE_DEFAULT ) || + ( imode == HB_MATH_ERRMODE_CDEFAULT ) || + ( imode == HB_MATH_ERRMODE_USER ) || + ( imode == HB_MATH_ERRMODE_USERDEFAULT ) || ( imode == HB_MATH_ERRMODE_USERCDEFAULT ) ) + { + s_hb_matherr_mode = imode; + } - return (oldmode); + return oldmode; } /* get error handling mode of hb_matherr() */ -int hb_mathGetErrMode (void) +int hb_mathGetErrMode( void ) { - HB_TRACE (HB_TR_DEBUG, ("hb_mathGetErrMode()")); - return (s_hb_matherr_mode); + HB_TRACE( HB_TR_DEBUG, ( "hb_mathGetErrMode()" ) ); + return s_hb_matherr_mode; } /* Harbour equivalent to mathSet/GetErrMode */ -HB_FUNC( HB_MATHERMODE ) /* ([]) -> */ +HB_FUNC( HB_MATHERMODE ) /* ([]) -> */ { - hb_retni (hb_mathGetErrMode()); + hb_retni( hb_mathGetErrMode() ); - /* set new mode */ - if (ISNUM (1)) - { - hb_mathSetErrMode( hb_parni( 1 ) ); - } - - return; + /* set new mode */ + if( ISNUM( 1 ) ) + hb_mathSetErrMode( hb_parni( 1 ) ); } /* Harbour default math error handling routine */ @@ -342,7 +329,7 @@ int hb_matherr( HB_MATH_EXCEPTION * pexc ) int mode = hb_mathGetErrMode(); int iRet = 1; - HB_TRACE(HB_TR_DEBUG, ("hb_matherr(%p)",pexc)); + HB_TRACE( HB_TR_DEBUG, ( "hb_matherr(%p)", pexc ) ); if( pexc == NULL || pexc->handled != 0 ) { @@ -360,7 +347,7 @@ int hb_matherr( HB_MATH_EXCEPTION * pexc ) /* NOTE: In case of HB_MATH_ERRMODE_USER[C]DEFAULT, I am setting both EF_CANSUBSTITUTE and EF_CANDEFAULT to .T. here. This is forbidden according to the original Cl*pper docs, but I think this reflects the situation best here: The error handler can either substitute the errorneous value (by returning a numeric value) or choose the - default error handling (by returning .F., as usual) [martin vogel]*/ + default error handling (by returning .F., as usual) [martin vogel] */ pError = hb_errRT_New_Subst( ES_ERROR, "MATH", EG_NUMERR, pexc->type, pexc->error, pexc->funcname, 0, EF_CANSUBSTITUTE | ( mode == HB_MATH_ERRMODE_USER ? 0 : EF_CANDEFAULT ) ); @@ -414,7 +401,7 @@ int hb_matherr( HB_MATH_EXCEPTION * pexc ) } } - return iRet; /* error handling successful */ + return iRet; /* error handling successful */ } @@ -426,14 +413,14 @@ int hb_matherr( HB_MATH_EXCEPTION * pexc ) */ /* static slot for current math error handler, this is hb_matherr by default */ -static HB_MATH_HANDLERPROC s_mathHandlerProc = hb_matherr; /* TODO: make this thread safe */ +static HB_MATH_HANDLERPROC s_mathHandlerProc = hb_matherr; /* TODO: make this thread safe */ /* install a harbour-like math error handler (that will be called by the matherr() function), return old handler */ HB_MATH_HANDLERPROC hb_mathSetHandler( HB_MATH_HANDLERPROC handlerproc ) { HB_MATH_HANDLERPROC oldHandlerProc; - HB_TRACE (HB_TR_DEBUG, ("hb_mathSetHandler (%p)", handlerproc)); + HB_TRACE( HB_TR_DEBUG, ( "hb_mathSetHandler (%p)", handlerproc ) ); oldHandlerProc = s_mathHandlerProc; s_mathHandlerProc = handlerproc; @@ -444,7 +431,7 @@ HB_MATH_HANDLERPROC hb_mathSetHandler( HB_MATH_HANDLERPROC handlerproc ) /* get current harbour-like math error handler */ HB_MATH_HANDLERPROC hb_mathGetHandler( void ) { - HB_TRACE (HB_TR_DEBUG, ("hb_mathGetHandler ()")); + HB_TRACE( HB_TR_DEBUG, ( "hb_mathGetHandler ()" ) ); return s_mathHandlerProc; } @@ -485,7 +472,7 @@ static int hb_matherrblock( HB_MATH_EXCEPTION * pexc ) /* launch error codeblock that can a) change the members of the array = {dRetval, lHandled} to set the return value of the math C RTL routine and - the and it + the and it b) can return an integer value to set the return value of matherr(). NOTE that these values are only used if lHandled was .F. and is set to .T. within the codeblock */ pRet = hb_itemDo( spMathErrorBlock, 6, pType, pFuncname, pError, pArg1, pArg2, pArray ); @@ -526,12 +513,12 @@ static int hb_matherrblock( HB_MATH_EXCEPTION * pexc ) } if( pRet != NULL && HB_IS_NUMERIC( pRet ) ) { - retval = hb_itemGetNI( pRet ); /* block may also return 0 to force C math lib warnings */ + retval = hb_itemGetNI( pRet ); /* block may also return 0 to force C math lib warnings */ hb_itemRelease( pRet ); } else { - retval = 1; /* default return value to suppress C math lib warnings */ + retval = 1; /* default return value to suppress C math lib warnings */ } } else @@ -544,7 +531,7 @@ static int hb_matherrblock( HB_MATH_EXCEPTION * pexc ) } else { - retval = 1; /* default return value to suppress C math lib warnings */ + retval = 1; /* default return value to suppress C math lib warnings */ } if( sPrevMathHandler != NULL ) @@ -552,62 +539,61 @@ static int hb_matherrblock( HB_MATH_EXCEPTION * pexc ) if( pexc->handled ) { /* the error is handled, so simply inform the previous handler */ - (*sPrevMathHandler)( pexc ); + ( *sPrevMathHandler ) ( pexc ); } else { /* else go on error handling within previous handler */ - retval = (*sPrevMathHandler)( pexc ); + retval = ( *sPrevMathHandler ) ( pexc ); } } return retval; } /* set/get math error block */ -HB_FUNC( HB_MATHERBLOCK ) /* ([]) -> */ +HB_FUNC( HB_MATHERBLOCK ) /* ([]) -> */ { - /* immediately install hb_matherrblock and keep it permanently installed ! - This is not dangerous because hb_matherrorblock will always call the previous error handler */ - if (sPrevMathHandler == NULL) - { - sPrevMathHandler = hb_mathSetHandler (hb_matherrblock); - } + /* immediately install hb_matherrblock and keep it permanently installed ! + This is not dangerous because hb_matherrorblock will always call the previous error handler */ + if( sPrevMathHandler == NULL ) + { + sPrevMathHandler = hb_mathSetHandler( hb_matherrblock ); + } - /* return old math handler */ - if (spMathErrorBlock == NULL) - { - hb_ret(); - } - else - { - hb_itemReturn (spMathErrorBlock); - } + /* return old math handler */ + if( spMathErrorBlock == NULL ) + { + hb_ret(); + } + else + { + hb_itemReturn( spMathErrorBlock ); + } - if (hb_pcount() > 0) - { - /* set new error block */ - PHB_ITEM pNewErrorBlock = hb_param (1, HB_IT_BLOCK); - if (pNewErrorBlock != NULL) - { - if (spMathErrorBlock == NULL) + if( hb_pcount() > 0 ) + { + /* set new error block */ + PHB_ITEM pNewErrorBlock = hb_param( 1, HB_IT_BLOCK ); + + if( pNewErrorBlock != NULL ) { - spMathErrorBlock = hb_itemNew (NULL); + if( spMathErrorBlock == NULL ) + { + spMathErrorBlock = hb_itemNew( NULL ); + } + hb_itemCopy( spMathErrorBlock, pNewErrorBlock ); } - hb_itemCopy (spMathErrorBlock, pNewErrorBlock); - } - else - { - /* a parameter other than a block has been passed -> delete error handler ! */ - if (spMathErrorBlock != NULL) + else { - hb_itemRelease (spMathErrorBlock); - spMathErrorBlock = NULL; + /* a parameter other than a block has been passed -> delete error handler ! */ + if( spMathErrorBlock ) + { + hb_itemRelease( spMathErrorBlock ); + spMathErrorBlock = NULL; + } } - } - } - - return; + } } /* @@ -636,6 +622,7 @@ HB_FUNC( EXP ) { /* the C-RTL provides a kind of matherr() mechanism */ int iLastError = hb_mathGetLastError( &hb_exc ); + if( iLastError != HB_MATH_ERR_NONE ) { if( hb_exc.handled ) @@ -645,7 +632,7 @@ HB_FUNC( EXP ) else { /* math exception is up to the Harbour function, so do this as Clipper compatible as possible */ - if ( iLastError == HB_MATH_ERR_OVERFLOW ) + if( iLastError == HB_MATH_ERR_OVERFLOW ) { hb_retndlen( HUGE_VAL, -1, -1 ); } @@ -665,10 +652,9 @@ HB_FUNC( EXP ) } } - HB_FUNC( LOG ) { - if( ISNUM ( 1 ) ) + if( ISNUM( 1 ) ) { HB_MATH_EXCEPTION hb_exc; double dResult, dArg = hb_parnd( 1 ); @@ -685,6 +671,7 @@ HB_FUNC( LOG ) { /* the C-RTL provides a kind of matherr() mechanism */ int iLastError = hb_mathGetLastError( &hb_exc ); + if( iLastError != HB_MATH_ERR_NONE ) { if( hb_exc.handled ) @@ -696,15 +683,14 @@ HB_FUNC( LOG ) /* math exception is up to the Harbour function, so do this as Clipper compatible as possible */ switch( iLastError ) { - case HB_MATH_ERR_SING: /* argument to log was 0.0 */ - case HB_MATH_ERR_DOMAIN: /* argument to log was < 0.0 */ - { - hb_retndlen( -HUGE_VAL, -1, -1 ); /* return -infinity */ - }; break; + case HB_MATH_ERR_SING: /* argument to log was 0.0 */ + case HB_MATH_ERR_DOMAIN: /* argument to log was < 0.0 */ + hb_retndlen( -HUGE_VAL, -1, -1 ); /* return -infinity */ + break; + default: - { hb_retnd( 0.0 ); - } + break; } } return; @@ -728,7 +714,7 @@ HB_FUNC( SQRT ) #if defined(HB_MATH_ERRNO) errno = 0; dResult = sqrt( dArg ); - if ( hb_mathErrSet( dResult, dArg, 0.0, "SQRT", errno ) ) + if( hb_mathErrSet( dResult, dArg, 0.0, "SQRT", errno ) ) #else hb_mathResetError(); dResult = sqrt( dArg ); @@ -737,6 +723,7 @@ HB_FUNC( SQRT ) { /* the C-RTL provides a kind of matherr() mechanism */ int iLastError = hb_mathGetLastError( &hb_exc ); + if( iLastError != HB_MATH_ERR_NONE ) { if( hb_exc.handled ) @@ -746,7 +733,7 @@ HB_FUNC( SQRT ) else { /* math exception is up to the Harbour function, so do this as Clipper compatible as possible */ - hb_retnd( 0.0 ); /* return 0.0 on all errors (all (?) of type DOMAIN) */ + hb_retnd( 0.0 ); /* return 0.0 on all errors (all (?) of type DOMAIN) */ } return; } diff --git a/harbour/source/rtl/menuto.prg b/harbour/source/rtl/menuto.prg index ba44a60bbb..1a31775ce6 100644 --- a/harbour/source/rtl/menuto.prg +++ b/harbour/source/rtl/menuto.prg @@ -20,10 +20,10 @@ #include "setcurs.ch" #xtranslate COLORARRAY() => &( '{"' + strtran(, ',', '","') + '"}' ) -static s_aLevel := {} -static s_nPointer := 1 +STATIC s_aLevel := {} +STATIC s_nPointer := 1 -function __AtPrompt( nRow, nCol, cPrompt, cMsg, cColor ) +FUNCTION __AtPrompt( nRow, nCol, cPrompt, cMsg, cColor ) if s_nPointer < 1 s_nPointer := 1 @@ -40,9 +40,9 @@ function __AtPrompt( nRow, nCol, cPrompt, cMsg, cColor ) // put this prompt on the screen right now DispOutAt( nRow, nCol, cPrompt, cColor ) - return .f. +RETURN .f. -function __MenuTo( bBlock, cVariable ) +FUNCTION __MenuTo( bBlock, cVariable ) local nKey local y @@ -139,26 +139,28 @@ function __MenuTo( bBlock, cVariable ) // save the current row q := n - if s_aLevel[ s_nPointer-1,n,5] <> nil - aColor := COLORARRAY( s_aLevel[ s_nPointer-1,n,5] ) - cFrontColor := IF( EMPTY( aColor[ 1 ] ) , NIL , aColor[ 1 ] ) - cBackColor := IF( LEN( aColor ) > 1 , aColor[2], NIL ) - + if s_aLevel[ s_nPointer - 1, n, 5 ] <> nil + aColor := COLORARRAY( s_aLevel[ s_nPointer - 1, n, 5 ] ) + cFrontColor := IIF( EMPTY( aColor[ 1 ] ) , NIL , aColor[ 1 ] ) + cBackColor := IIF( LEN( aColor ) > 1 , aColor[2], NIL ) endif if Set( _SET_INTENSITY ) - if(cBackColor<> Nil ,cBackColor, ColorSelect( CLR_ENHANCED )) + if cBackColor == Nil // Only select Color Enhace if no color was passed + ColorSelect( CLR_ENHANCED ) + endif endif // highlight the prompt DispOutAt( s_aLevel[ nPointer - 1, n, 1 ],; s_aLevel[ nPointer - 1, n, 2 ],; s_aLevel[ nPointer - 1, n, 3 ],; - if(cBackColor<> nil,cBackColor,nil)) + cBackColor ) if Set( _SET_INTENSITY ) - //ColorSelect( CLR_STANDARD ) - if(cFrontColor <> nil ,cFrontColor, ColorSelect( CLR_STANDARD )) + if cFrontColor == NIL // Only select Color Enhace if no color was passed + ColorSelect( CLR_STANDARD ) + endif endif if lExit @@ -189,48 +191,61 @@ function __MenuTo( bBlock, cVariable ) enddo // check for keystrokes - do case - case nKey == 1001 - case nKey == 1002 .OR. nKey == 1006 - if ( ( nMouseClik := hittest(s_aLevel[ nPointer-1 ], mrow(), mcol()) ) > 0 ) - n := nMouseClik - endif - if ( nKey == 1006 ) - lExit := .T. - endif - - case nKey == K_DOWN .or. nKey == K_RIGHT - if ++n > nArrLen - n := iif( Set( _SET_WRAP ), 1, nArrLen ) - endif - case nKey == K_UP .or. nKey == K_LEFT - if --n < 1 - n := iif( Set( _SET_WRAP ), nArrLen, 1 ) - endif - case nKey == K_HOME - n := 1 - case nKey == K_END - n := nArrLen - case nKey == K_ENTER .or. nKey == K_PGUP .or. nKey == K_PGDN - lExit := .T. - case nKey == K_ESC - n := 0 - otherwise - // did user hit a hot key? - for y := 1 to nArrLen - if upper( left( ltrim( s_aLevel[ nPointer - 1, y, 3 ] ), 1 ) ) == upper( chr( nKey ) ) - n := y - lExit := .T. - exit + SWITCH nKey + case K_MOUSEMOVE + EXIT + case K_LBUTTONDOWN + case K_LDBLCLK + if ( nMouseClik := hittest( s_aLevel[ nPointer - 1 ], ; + mrow(), mcol() ) ) > 0 + n := nMouseClik endif - next - endcase + if nKey == K_LDBLCLK + lExit := .T. + endif + EXIT + case K_DOWN + case K_RIGHT + if ++n > nArrLen + n := iif( Set( _SET_WRAP ), 1, nArrLen ) + endif + EXIT + case K_UP + case K_LEFT + if --n < 1 + n := iif( Set( _SET_WRAP ), nArrLen, 1 ) + endif + EXIT + case K_HOME + n := 1 + EXIT + case K_END + n := nArrLen + EXIT + case K_ENTER + case K_PGUP + case K_PGDN + lExit := .T. + EXIT + case K_ESC + n := 0 + EXIT + otherwise + // did user hit a hot key? + for y := 1 to nArrLen + if upper( left( ltrim( s_aLevel[ nPointer - 1, y, 3 ] ), 1 ) ) == upper( chr( nKey ) ) + n := y + lExit := .T. + exit + endif + next + end if n <> 0 DispOutAt( s_aLevel[ nPointer - 1, q, 1 ],; s_aLevel[ nPointer - 1, q, 2 ],; s_aLevel[ nPointer - 1, q, 3 ],; - if( cFrontColor <> nil , cFrontColor , nil ) ) + cFrontColor ) endif enddo @@ -252,16 +267,19 @@ function __MenuTo( bBlock, cVariable ) SetPos( MaxRow() - 1, 0) - return n +RETURN n -static function HITTEST( aMenu, nMouseRow, nMouseCol ) +STATIC FUNCTION HITTEST( aMenu, nMouseRow, nMouseCol ) - local nPos, nLen := Len(aMenu) - for nPos := 1 to nLen - if ( nMouseRow != aMenu[ nPos ][ 1 ] ) - elseif ( nMouseCol < aMenu[ nPos ][ 2 ] ) - elseif ( nMouseCol < aMenu[ nPos ][ 2 ] + Len(aMenu[ nPos ][ 3 ]) ) - return nPos - endif - next - return 0 + LOCAL aMenuItem + + FOR EACH aMenuItem IN aMenu + IF nMouseRow == aMenuItem[ 1 ] .AND. ; + nMouseCol >= aMenuItem[ 2 ] .AND. ; + nMouseCol < aMenuItem[ 2 ] + LEN( aMenuItem[ 3 ] ) + + RETURN aMenuItem:__enumIndex() + ENDIF + NEXT + +RETURN 0 diff --git a/harbour/source/rtl/mouseapi.c b/harbour/source/rtl/mouseapi.c index 1d43a401bc..72c247c0e3 100644 --- a/harbour/source/rtl/mouseapi.c +++ b/harbour/source/rtl/mouseapi.c @@ -238,7 +238,7 @@ HB_FUNC( MSETCURSOR ) HB_FUNC( MROW ) { - if( ISLOG( 1 ) ) + if( ISLOG( 1 ) && hb_parl( 1 ) ) { int iRow, iCol; @@ -251,7 +251,7 @@ HB_FUNC( MROW ) HB_FUNC( MCOL ) { - if( ISLOG( 1 ) ) + if( ISLOG( 1 ) && hb_parl( 1 ) ) { int iRow, iCol; diff --git a/harbour/source/rtl/oldbox.c b/harbour/source/rtl/oldbox.c index 529da743a0..42d5a8fad3 100644 --- a/harbour/source/rtl/oldbox.c +++ b/harbour/source/rtl/oldbox.c @@ -62,13 +62,14 @@ HB_FUNC( __BOX ) PHB_ITEM pLeft = hb_param( 2, HB_IT_NUMERIC ); PHB_ITEM pBottom = hb_param( 3, HB_IT_NUMERIC ); PHB_ITEM pRight = hb_param( 4, HB_IT_NUMERIC ); + char * pszBox = hb_parc( 5 ); - if( pTop && pLeft && pBottom && pRight ) + if( pTop && pLeft && pBottom && pRight && pszBox ) hb_gtBox( hb_itemGetNI( pTop ), - hb_itemGetNI( pLeft), - hb_itemGetNI( pBottom ), + hb_itemGetNI( pLeft), + hb_itemGetNI( pBottom ), hb_itemGetNI( pRight ), - ( BYTE * ) hb_parc( 5 ) ); + ( BYTE * ) ( *pszBox ? pszBox : " " ) ); } HB_FUNC( __BOXD ) @@ -80,8 +81,8 @@ HB_FUNC( __BOXD ) if( pTop && pLeft && pBottom && pRight ) hb_gtBoxD( hb_itemGetNI( pTop ), - hb_itemGetNI( pLeft), - hb_itemGetNI( pBottom ), + hb_itemGetNI( pLeft), + hb_itemGetNI( pBottom ), hb_itemGetNI( pRight ) ); } @@ -94,8 +95,8 @@ HB_FUNC( __BOXS ) if( pTop && pLeft && pBottom && pRight ) hb_gtBoxS( hb_itemGetNI( pTop ), - hb_itemGetNI( pLeft), - hb_itemGetNI( pBottom ), + hb_itemGetNI( pLeft), + hb_itemGetNI( pBottom ), hb_itemGetNI( pRight ) ); } diff --git a/harbour/source/rtl/philes.c b/harbour/source/rtl/philes.c index 39d98817f8..137dd48db7 100644 --- a/harbour/source/rtl/philes.c +++ b/harbour/source/rtl/philes.c @@ -273,7 +273,7 @@ HB_FUNC( CURDIR ) HB_FUNC( HB_F_EOF ) { - USHORT uiError = 0; + USHORT uiError = 6; if( ISNUM( 1 ) ) { @@ -285,6 +285,24 @@ HB_FUNC( HB_F_EOF ) hb_setFError( uiError ); } +HB_FUNC( HB_FCOMMIT ) +{ + USHORT uiError = 6; + + if( ISNUM( 1 ) ) + { + hb_fsCommit( hb_parni(1) ); + uiError = hb_fsError(); + } + + hb_setFError( uiError ); +} + +HB_FUNC( HB_OSERROR ) +{ + hb_retni( hb_fsOsError() ); +} + HB_FUNC( HB_OSPATHSEPARATOR ) { const char ret[ 2 ] = { OS_PATH_DELIMITER, 0 }; @@ -302,4 +320,14 @@ HB_FUNC( HB_OSPATHDELIMITERS ) hb_retc( OS_PATH_DELIMITER_LIST ); } +HB_FUNC( HB_OSDRIVESEPARATOR ) +{ +#ifdef OS_HAS_DRIVE_LETTER + char ret[ 2 ] = { OS_DRIVE_DELIMITER, 0 }; + hb_retc( ret ); +#else + hb_retc( NULL ); +#endif +} + #endif diff --git a/harbour/source/rtl/pushbtn.prg b/harbour/source/rtl/pushbtn.prg index 1f5ad34ddd..cd60dba9d5 100644 --- a/harbour/source/rtl/pushbtn.prg +++ b/harbour/source/rtl/pushbtn.prg @@ -52,13 +52,13 @@ #include 'hbclass.ch' #include "common.ch" +#include "button.ch" #ifdef HB_COMPAT_C53 -CLASS HBPushButton +CREATE CLASS PUSHBUTTON FUNCTION HBPushButton EXPORT: - DATA ClassName INIT "PUSHBUTTON" DATA Buffer DATA Caption DATA Cargo @@ -91,29 +91,31 @@ CLASS HBPushButton ENDCLASS -METHOD GetColor( xColor ) CLASS HBPushButton +METHOD GetColor( xColor ) CLASS PushButton - IF ( !( ISNIL( xColor ) ) ) - ::Color := IIF( Valtype( xColor ) == "C" .and. !Empty( __GuiColor( xColor, 4 ) ) .and. ; + IF ! ISNIL( xColor ) + ::Color := IIF( Valtype( xColor ) == "C" .and. ; + !Empty( __GuiColor( xColor, 4 ) ) .and. ; Empty( __GuiColor( xColor, 6 ) ), xColor, ) ENDIF RETURN ::Color -METHOD GetStyle( cStyle ) CLASS HBPushButton - - IF ( !( ISNIL( cStyle ) ) ) - ::curStyle := IIF( Valtype( cStyle ) == "C" .and. Ltrim( Str( Len( cStyle ) ) ) $ "0ù2ù8", cStyle, ) +METHOD GetStyle( cStyle ) CLASS PushButton + IF ! ISNIL( cStyle ) + ::curStyle := IIF( Valtype( cStyle ) == "C" .and. ; + Ltrim( Str( Len( cStyle ) ) ) $ "0ù2ù8", cStyle, ) ENDIF RETURN ::curStyle -METHOD New( nRow, nCol, cCaption ) CLASS HBPushButton +METHOD New( nRow, nCol, cCaption ) CLASS PushButton LOCAL cColor DEFAULT cCaption TO "" + ::Buffer := .F. ::Caption := cCaption ::Cargo := Nil @@ -126,53 +128,58 @@ METHOD New( nRow, nCol, cCaption ) CLASS HBPushButton ::lCursor := Nil ::Style := "<>" - IF ( Isdefcolor() ) + IF Isdefcolor() ::ColorSpec := "W/N,N/W,W+/N,W+/N" ELSE cColor := Setcolor() ::ColorSpec := __GuiColor( cColor, 5 ) + "," + ; - __GuiColor( cColor, 2 ) + "," + __GuiColor( cColor, 1 ) + ; - "," + __GuiColor( cColor, 4 ) + __GuiColor( cColor, 2 ) + "," + ; + __GuiColor( cColor, 1 ) + "," + ; + __GuiColor( cColor, 4 ) ENDIF RETURN Self -METHOD SetFocus() CLASS HBPushButton +METHOD SetFocus() CLASS PushButton - IF ( !::HasFocus .and. ISBLOCK( ( ::lCursor := Setcursor( 0 ), ; - ::HasFocus := .T., ::display(), ::fBlock ) ) ) - Eval( ::fBlock ) + IF !::HasFocus + ::lCursor := Setcursor( 0 ) + ::HasFocus := .T. + ::display() + IF ISBLOCK( ::fBlock ) + Eval( ::fBlock ) + ENDIF ENDIF RETURN Self -METHOD _Select( nPos ) CLASS HBPushButton +METHOD _Select( nPos ) CLASS PushButton LOCAL nCurPos := nPos - IF ( ::HasFocus ) + IF ::HasFocus ::Buffer := .T. ::display() - IF ( Isnumber( nPos ) ) + IF Isnumber( nPos ) - IF ( nPos == 32 ) + IF nPos == 32 Inkey( 0.4 ) - DO WHILE ( nCurPos == 32 ) + DO WHILE nCurPos == 32 nCurPos := Inkey( 0.1 ) ENDDO ELSE - DO WHILE ( nPos == Inkey( 0 ) ) + DO WHILE nPos == Inkey( 0 ) ENDDO ENDIF ENDIF - IF ( ISBLOCK( ::sBlock ) ) + IF ISBLOCK( ::sBlock ) Eval( ::sBlock ) ENDIF @@ -182,13 +189,13 @@ METHOD _Select( nPos ) CLASS HBPushButton RETURN Self -METHOD KillFocus() CLASS HBPushButton +METHOD KillFocus() CLASS PushButton - IF ( ::HasFocus ) + IF ::HasFocus ::HasFocus := .F. - IF ( ISBLOCK( ::fBlock ) ) + IF ISBLOCK( ::fBlock ) Eval( ::fBlock ) ENDIF @@ -198,36 +205,32 @@ METHOD KillFocus() CLASS HBPushButton RETURN Self -METHOD HitTest( nRow, nCol ) CLASS HBPushButton +METHOD HitTest( nRow, nCol ) CLASS PushButton LOCAL nCurrentPos := 1 LOCAL nLen := Len( ::Caption ) LOCAL cStyle LOCAL nAmpPos - IF ( ( nAmpPos := At( "&", ::Caption ) ) == 0 ) - ELSEIF ( nAmpPos < nLen ) - nLen -- + IF ( nAmpPos := At( "&", ::Caption ) ) != 0 .AND. nAmpPos < nLen + nLen-- ENDIF - IF ( ( cStyle := Len( ::Style ) ) == 2 ) + IF ( cStyle := Len( ::Style ) ) == 2 nLen += 2 - ELSEIF ( cStyle == 8 ) + ELSEIF cStyle == 8 nCurrentPos := 3 nLen += 2 ENDIF - DO CASE - CASE nRow < ::Row - CASE nCol < ::Col - CASE nRow >= ::Row + nCurrentPos - CASE nCol < ::Col + nLen - RETURN - 2049 - ENDCASE + IF nRow >= ::Row .AND. nCol >= ::Col .AND. ; + nRow < ::Row + nCurrentPos .AND. nCol < ::Col + nLen + RETURN HTCLIENT + ENDIF -RETURN 0 +RETURN HTNOWHERE -METHOD DISPLAY() CLASS HBPushButton +METHOD DISPLAY() CLASS PushButton LOCAL cOldColor := Setcolor() LOCAL cStyle @@ -245,21 +248,21 @@ METHOD DISPLAY() CLASS HBPushButton Dispbegin() - IF ( ::Buffer ) + IF ::Buffer SET COLOR TO (__GuiColor(::ColorSpec, 3)) cColor4 := __GuiColor( ::ColorSpec, 4 ) - IF ( Len( cColor4 ) == 0 ) + IF Len( cColor4 ) == 0 nColorNum := 0 ELSE nColorNum := _getnumcol( cColor4 ) ENDIF - ELSEIF ( ::HasFocus ) + ELSEIF ::HasFocus SET COLOR TO (__GuiColor(::ColorSpec, 2)) cColor4 := __GuiColor( ::ColorSpec, 4 ) - IF ( Len( cColor4 ) == 0 ) + IF Len( cColor4 ) == 0 nColorNum := 0 ELSE nColorNum := _getnumcol( cColor4 ) @@ -269,7 +272,7 @@ METHOD DISPLAY() CLASS HBPushButton SET COLOR TO (__GuiColor(::ColorSpec, 1)) cColor4 := __GuiColor( ::ColorSpec, 4 ) - IF ( Len( cColor4 ) == 0 ) + IF Len( cColor4 ) == 0 nColorNum := 0 ELSE nColorNum := _getnumcol( cColor4 ) @@ -281,17 +284,18 @@ METHOD DISPLAY() CLASS HBPushButton nCurCol := ::Col cCaption := ::Caption - IF ( ( nAmpPos := At( "&", cCaption ) ) == 0 ) - ELSEIF ( nAmpPos == Len( cCaption ) ) - nAmpPos := 0 - ELSE - cCaption := Stuff( cCaption, nAmpPos, 1, "" ) + IF ( nAmpPos := At( "&", cCaption ) ) != 0 + IF nAmpPos == Len( cCaption ) + nAmpPos := 0 + ELSE + cCaption := Stuff( cCaption, nAmpPos, 1, "" ) + ENDIF ENDIF - IF ( !Empty( cStyle ) ) + IF !Empty( cStyle ) nCurCol ++ - IF ( Len( cStyle ) == 2 ) + IF Len( cStyle ) == 2 Setpos( ::Row, ::Col ) ?? Substr( cStyle, 1, 1 ) Setpos( ::Row, ::Col + Len( cCaption ) + 1 ) @@ -303,18 +307,18 @@ METHOD DISPLAY() CLASS HBPushButton ENDIF - IF ( ::Buffer ) + IF ::Buffer nBuffer := 1 ELSE nBuffer := 0 ENDIF - IF ( !Empty( cCaption ) ) + IF !Empty( cCaption ) Setpos( nCurRow, nCurCol ) ?? cCaption - IF ( nAmpPos != 0 ) + IF nAmpPos != 0 Set COLOR TO (cColor4) Setpos( nCurRow, nCurCol + nAmpPos - 1 ) ?? Substr( cCaption, nAmpPos, 1 ) @@ -326,11 +330,12 @@ METHOD DISPLAY() CLASS HBPushButton SET COLOR TO (cOldColor) Setpos( nRow, nCol ) + RETURN Self FUNCTION PushButton( nRow, nCol, cCaption ) - IF ( ( Isnumber( nRow ) ) ) .and. ( ( Isnumber( nCol ) ) ) + IF ISNUMBER( nRow ) .AND. ISNUMBER( nCol ) DEFAULT cCaption TO "" RETURN HBPushButton():New( nRow, nCol, cCaption ) ENDIF @@ -341,37 +346,37 @@ FUNCTION _PUSHBUTT_( cCaption, cMessage, cColor, bFBlock, bSBlock, cStyle ) LOCAL oPushButton DEFAULT cCaption TO "" + oPushButton := Pushbutton( Row(), Col(), cCaption ) - IF ( !( ISNIL( oPushButton ) ) ) - oPushButton:Caption := IIF( cCaption != Nil, cCaption, ) - oPushButton:ColorSpec := IIF( cColor != Nil, cColor, ) - oPushButton:Message := IIF( cMessage != Nil, cMessage, ) - oPushButton:Style := IIF( cStyle != Nil, cStyle, ) - oPushButton:fBlock := IIF( bFBlock != Nil, bFBlock, ) - oPushButton:sBlock := IIF( bSBlock != Nil, bSBlock, ) + IF ! ISNIL( oPushButton ) + oPushButton:Caption := cCaption + oPushButton:ColorSpec := cColor + oPushButton:Message := cMessage + oPushButton:Style := cStyle + oPushButton:fBlock := bFBlock + oPushButton:sBlock := bSBlock ENDIF RETURN oPushButton -FUNCTION _GETNUMCOL( Arg1 ) +FUNCTION _GETNUMCOL( cColor ) - LOCAL aColors := { { "N+", 8 }, { "B+", 9 }, { "G+", 10 }, { "BG+", 11 }, ; - { "R+", 12 }, { "RB+", 13 }, { "GR+", 14 }, { "W+", 15 }, { "BG", 3 }, { "RB", 5 }, ; - { "GR", 6 }, { "B", 1 }, { "G", 2 }, { "R", 4 }, { "W", 7 } } - LOCAL nPos := At( "/", Arg1 ) - LOCAL nReturn + STATIC s_aColors := { { "N+", 8 }, { "B+", 9 }, { "G+", 10 }, ; + { "BG+", 11 }, { "R+", 12 }, { "RB+", 13 }, ; + { "GR+", 14 }, { "W+", 15 }, { "BG", 3 }, ; + { "RB", 5 }, { "GR", 6 }, { "B", 1 }, ; + { "G", 2 }, { "R", 4 }, { "W", 7 } } + LOCAL nPos - IF ( nPos > 1 ) - Arg1 := Substr( Arg1, 1, nPos - 1 ) - ELSEIF ( nPos == 1 ) - Arg1 := "" + IF ( nPos := At( "/", cColor ) ) > 0 + cColor := LEFT( cColor, nPos - 1 ) ENDIF - nReturn := Ascan( aColors, { | a | a[ 1 ] == arg1 } ) + nPos := AScan( s_aColors, { | a | a[ 1 ] == cColor } ) - IF nReturn > 0 - RETURN aColors[ nReturn, 2 ] + IF nPos > 0 + RETURN s_aColors[ nPos, 2 ] ENDIF RETURN 0 diff --git a/harbour/source/rtl/radiobtn.prg b/harbour/source/rtl/radiobtn.prg index d0a66aa5b2..435139b1b4 100644 --- a/harbour/source/rtl/radiobtn.prg +++ b/harbour/source/rtl/radiobtn.prg @@ -51,11 +51,12 @@ */ -#include "common.ch" #include "hbclass.ch" +#include "common.ch" +#include "button.ch" #ifdef HB_COMPAT_C53 -CLASS HBRadioButton +CREATE CLASS RADIOBUTTON FUNCTION HBRadioButton EXPORT: @@ -67,7 +68,6 @@ CLASS HBRadioButton DATA Col DATA pData DATA ColorSpec - DATA Classname init "RADIOBUTTO" DATA fBlock DATA HasFocus DATA Row @@ -83,177 +83,217 @@ CLASS HBRadioButton METHOD KillFocus() MESSAGE Select(lVal) METHOD _Select(LVal) METHOD SetFocus() - METHOD New(nRow,nCol,cCaption,xData) + METHOD New( nRow, nCol, cCaption, xData ) ENDCLASS -METHOD New(nRow,nCol,cCaption,xData) CLASS HBRadioButton - Local cColor - ::Buffer:= .f. - ::CapRow:= nRow - ::CapCol:= nCol+3+1 - ::Caption:= cCaption - ::Cargo:=NIL - ::Col:= nCol - if ( isdefcolor() ) +METHOD NEW( nRow, nCol, cCaption, xData ) CLASS RadioButton + + LOCAL cColor + + ::Buffer := .f. + ::CapRow := nRow + ::CapCol := nCol+3+1 + ::Caption := cCaption + ::Cargo := NIL + ::Col := nCol + + IF IsDefColor() ::ColorSpec:="W/N,W+/N,W+/N,N/W,W/N,W/N,W+/N" - else + ELSE cColor := SetColor() - ::ColorSpec :=; - __guicolor(cColor, 5) + "," + ; - __guicolor(cColor, 5) + "," + __guicolor(cColor, 2) + ; - "," + __guicolor(cColor, 2) + "," + __guicolor(cColor, ; - 1) + "," + __guicolor(cColor, 1) + "," + ; - __guicolor(cColor, 4) - endif - - ::fBlock := NIL - + ::ColorSpec := __guicolor(cColor, 5) + "," + ; + __guicolor(cColor, 5) + "," + ; + __guicolor(cColor, 2) + "," + ; + __guicolor(cColor, 2) + "," + ; + __guicolor(cColor, 1) + "," + ; + __guicolor(cColor, 1) + "," + ; + __guicolor(cColor, 4) + ENDIF + + ::fBlock := NIL + ::HasFocus := .f. - ::Row:=nRow - ::sBlock:=nil + ::Row := nRow + ::sBlock := nil - ::Style:= "(* )" - ::Data := xData -return Self + ::Style := "(* )" + ::Data := xData -METHOD SETFOCus() CLASS HBRadioButton +RETURN Self - if ( !::hasfocus .AND. ISBLOCK( ( ::hasfocus := .T., ; - ::display(), ::fblock ) ) ) - eval(::fblock) - endif - return Self +METHOD SETFOCUS() CLASS RadioButton -METHOD _SELECT(lStatus) CLASS HBRadioButton + IF ! ::hasfocus + ::hasfocus := .T. + ::display() + IF ISBLOCK( ::fblock ) + Eval(::fblock) + ENDIF + ENDIF + +RETURN Self + +METHOD _SELECT(lStatus) CLASS RadioButton local lOldBuffer := ::Buffer - if ( ISLOGICAL( lStatus ) ) + if ISLOGICAL( lStatus ) ::Buffer := lStatus else ::Buffer := !::Buffer endif - if ( lOldBuffer == ::Buffer ) - elseif ( ISBLOCK( ::sBlock )) - eval(::sBlock) - endif - return self -METHOD kILLFOcus() CLASS HBRadioButton - - if ( ::HasFocus ) - ::HasFocus := .F. - if ( ISBLOCK( ::fBlock ) ) - eval(::fBlock) + if lOldBuffer != ::Buffer .AND. ISBLOCK( ::sBlock ) + Eval( ::sBlock ) endif + +RETURN self + +METHOD KILLFOCUS() CLASS RadioButton + + if ::HasFocus + ::HasFocus := .F. + if ISBLOCK( ::fBlock ) + eval(::fBlock) + endif ::display() endif - return Self -METHOD DISPLAY() CLASS HBRadioButton +RETURN Self + +METHOD DISPLAY() CLASS RadioButton - local cColor := SetColor(), cCurStyle, nCurRow:= Row(), nCurCol:= ; - Col(), nPos, cPairs4, cOldCaption + local cColor := SetColor(), cCurStyle, nCurRow := Row(), nCurCol := Col(),; + nPos, cPairs4, cOldCaption + + cPairs4 := __guicolor( ::colorspec, IIF( ::hasfocus, 7, 6 ) ) cCurStyle := ::Style + dispbegin() - if ( ::hasfocus ) - set color to (__guicolor(::colorspec, 2)) - else - set color to (__guicolor(::colorspec, 1)) - endif + + set color to ( __guicolor( ::colorspec, IIF( ::Buffer, 4, 2 ) ) ) + SetPos(::Row, ::Col) ?? Left(cCurStyle, 1) - if ( ::Buffer ) + + if ::Buffer ?? SubStr(cCurStyle, 2, 1) else ?? SubStr(cCurStyle, 3, 1) endif + ?? right(cCurStyle, 1) - if ( !Empty(cOldCaption := ::Caption) ) - if ( ( nPos := At("&", cOldCaption) ) == 0 ) - elseif ( nPos == Len(cOldCaption) ) - nPos := 0 - else - cOldCaption := stuff(cOldCaption, nPos, 1, "") - endif - set color to (__guicolor(::ColorSpec, 5)) - SetPos(::CapRow, ::CapCol) - ?? cOldCaption - if ( nPos != 0 ) - set color to (cPairs4) // ; FIXME: cPairs4 is not initialized - SetPos(::CapRow, ::CapCol + nPos - 1) - ?? SubStr(cOldCaption, nPos, 1) - endif + + if !Empty(cOldCaption := ::Caption) + if ( nPos := At("&", cOldCaption) ) == 0 + elseif nPos == Len(cOldCaption) + nPos := 0 + else + cOldCaption := stuff(cOldCaption, nPos, 1, "") + endif + set color to (__guicolor(::ColorSpec, 5)) + SetPos(::CapRow, ::CapCol) + ?? cOldCaption + if nPos != 0 + set color to (cPairs4) + SetPos(::CapRow, ::CapCol + nPos - 1) + ?? SubStr(cOldCaption, nPos, 1) + endif endif dispend() set color to (cColor) SetPos(nCurRow, nCurCol) - return Self -METHOD IsAccel( xValue ) CLASS HBRadioButton +RETURN Self + +METHOD ISACCEL( xValue ) CLASS RadioButton - local nPos, cCaption, xResult - if ( ISNUMBER( xValue ) ) + LOCAL nPos, cCaption, xResult + + IF ISNUMBER( xValue ) xValue := Chr(xValue) - elseif ( !( ISCHARACTER( xValue ) ) ) - return .F. - endif + ELSEIF ! ISCHARACTER( xValue ) + RETURN .F. + ENDIF + xValue := Lower(xValue) cCaption := ::Caption - if ( ( nPos := At("&", cCaption) ) == 0 ) - elseif ( ( xResult := Lower(SubStr(cCaption, nPos + 1, 1)), nPos ; - < Len(cCaption) .AND. xResult == xValue ) ) - return .T. - endif - return .F. -METHOD HITTESt( nRow, nCol ) CLASS HBRadioButton + IF ( nPos := At("&", cCaption) ) != 0 + xResult := Lower( SubStr( cCaption, nPos + 1, 1 ) ) + IF nPos < Len( cCaption ) .AND. xResult == xValue + RETURN .T. + ENDIF + ENDIF + +RETURN .F. + +METHOD HITTEST( nRow, nCol ) CLASS RadioButton + + LOCAL nPos, nLen + + IF nRow == ::Row .AND. nCol >= ::Col .AND. nCol < ::Col + 3 + RETURN HTCLIENT + ENDIF - local nPos, nLen - if ( nRow != ::Row ) - elseif ( nCol < ::Col ) - elseif ( nCol < ::Col + 3 ) - return -2049 - endif nLen := Len(::Caption) - if ( ( nPos := At("&", ::Caption) ) == 0 ) - elseif ( nPos < nLen ) + + IF ( nPos := At("&", ::Caption) ) != 0 .AND. nPos < nLen nLen-- - endif - if ( nRow != ::CapRow ) - elseif ( nCol < ::CapCol ) - elseif ( nCol < ::CapCol + nLen ) - return -2049 - endif - return 0 + ENDIF -METHOD SetData(Arg1) CLASS HBRadioButton + IF nRow == ::CapRow .AND. nCol >= ::CapCol .AND. nCol < ::CapCol + nLen + RETURN HTCLIENT + ENDIF + +RETURN HTNOWHERE + +METHOD SETDATA( xData ) CLASS RadioButton - if ( PCount() == 0 ) - elseif ( ISNIL( Arg1 ) ) - ::pData := Arg1 - else - ::pData := if(valtype(Arg1)=="C",arg1,"") - endif - if ( ISNIL( ::pData ) ) - return __caption(::Caption) - endif - return ::pData + IF PCount() != 0 + IF ISNIL( xData ) + ::pData := xData + ELSE + ::pData := iif( valtype( xData ) == "C", xData, "" ) + ENDIF + ENDIF + IF ISNIL( ::pData ) + RETURN __caption( ::Caption ) + ENDIF -function RADIOBUTTO( nRow, nCol,cCaption,xData) +RETURN ::pData - default cCaption to "" - if ( ( ISNUMBER( nRow ) ) ) .and. ( ( ISNUMBER( nCol ) ) ) - Return HBRadioButton():New(nRow, nCol,cCaption,xData) - endif -return nil +FUNCTION RADIOBUTTO( nRow, nCol, cCaption, xData ) + + DEFAULT cCaption TO "" + + IF ISNUMBER( nRow ) .and. ISNUMBER( nCol ) + RETURN HBRadioButton():New( nRow, nCol, cCaption, xData ) + ENDIF + +RETURN NIL + +#ifdef HB_EXTENSION +FUNCTION RADIOBUTTON( nRow, nCol, cCaption, xData ) + + DEFAULT cCaption TO "" + + IF ISNUMBER( nRow ) .and. ISNUMBER( nCol ) + RETURN HBRadioButton():New( nRow, nCol, cCaption, xData ) + ENDIF + +RETURN NIL +#endif /** Return the Caption Letter of an Given Caption String */ -function __CAPTION( cCaption ) +FUNCTION __CAPTION( cCaption ) local nPos - if ( ( nPos := At("&", cCaption) ) > 0 ) + + if ( nPos := At("&", cCaption) ) > 0 cCaption := stuff(cCaption, nPos, 1, "") endif - return cCaption + +RETURN cCaption + #endif diff --git a/harbour/source/rtl/radiogrp.prg b/harbour/source/rtl/radiogrp.prg index 8e099ebd41..b3691022a3 100644 --- a/harbour/source/rtl/radiogrp.prg +++ b/harbour/source/rtl/radiogrp.prg @@ -50,434 +50,457 @@ * */ -#include "common.ch" #include "hbclass.ch" +#include "common.ch" +#include "button.ch" #ifdef HB_COMPAT_C53 -CLASS HBRadioGroup +CREATE CLASS RADIOGROUP FUNCTION HBRadioGroup - export: +exported: - METHOD AddItem(xItem) - METHOD DelItem(xItem) + METHOD AddItem( xItem ) + METHOD DelItem( xItem ) METHOD Display() - METHOD GetAccel(xItem) - METHOD GetItem(Xitem) - METHOD HitTest(nRow,nCol) - METHOD InsItem(nPos, oButtom ) - METHOD KillFocus() - METHOD NextItem() - METHOD PrevItem() - MESSAGE Select(xItem) METHOD _Select(xItem) - MESSAGE SetColor(xItem) METHOD _SetColor(xItem) - METHOD SetFocus() - METHOD SetStyle(xItem) - METHOD New(nTop, nLeft, nBottom, nRight ) -// METHOD GetColor(xColor) + METHOD GetAccel( xItem ) + METHOD GetItem( Xitem ) + METHOD HitTest( nRow, nCol ) + METHOD InsItem( nPos, oButtom ) + METHOD KillFocus( ) + METHOD NextItem( ) + METHOD PrevItem( ) + MESSAGE Select( xItem ) METHOD _Select( xItem ) + MESSAGE SetColor( xItem ) METHOD _SetColor( xItem ) + METHOD SetFocus( ) + METHOD SetStyle( xItem ) + METHOD New( nTop, nLeft, nBottom, nRight ) +// METHOD GetColor( xColor ) DATA Bottom - DATA Buffer init NIL - + DATA Buffer INIT NIL DATA CapCol - DATA CapRow - DATA Caption - - DATA Cargo init Nil - - DATA ColdBox init "ÚÄ¿³ÙÄÀ³" - - DATA fBlock init NIL - - DATA HasFocus init .f. - - DATA HotBox init "ÉÍ»º¼ÍȺ" - - DATA ItemCount init 0 - + DATA Cargo INIT NIL + DATA ColdBox INIT "ÚÄ¿³ÙÄÀ³" + DATA fBlock INIT NIL + DATA HasFocus INIT .F. + DATA HotBox INIT "ÉÍ»º¼ÍȺ" + DATA ItemCount INIT 0 DATA Left - - DATA Message init "" + DATA Message INIT "" DATA Right - DATA aItems init {} - DATA lCursor init 0 + DATA aItems INIT {} + DATA lCursor INIT 0 - DATA TextValue init "" + DATA TextValue INIT "" DATA Top - DATA CLASSName init "RADIOGROUP" - DATA TypeOut init .f. + DATA TypeOut INIT .F. - DATA Value init 0 + DATA Value INIT 0 DATA Color - Data colorspec init "" -// ASSIGN Colorspec(xColor) inline if(xColor!=Nil,::GetColor(xColor),) + Data colorspec INIT "" +// ASSIGN Colorspec( xColor ) inline IIF( xColor != NIL, ::GetColor( xColor ), ) ENDCLASS -METHOD New(nTop, nLeft, nBottom, nRight ) CLASS HBRadioGroup +METHOD New( nTop, nLeft, nBottom, nRight ) CLASS RadioGroup -Local cColor - if ( isdefcolor() ) - ::ColorSpec:= "W/N,W/N,W+/N" - else - cColor := SetColor() - ::ColorSpec:= __guicolor(cColor, 3) + "," + ; - __guicolor(cColor, 1) + "," + __guicolor(cColor, 4) - endif - ::Bottom:=nBottom - ::CapCol:= nLeft+2 - ::CapRow:= nTop - ::Left:=nLeft - ::right:=nRight - ::top:=nTop -return Self + LOCAL cColor -METHOD ADDITEM( xItem ) CLASS HBRadioGroup + IF IsDefColor() + ::ColorSpec := "W/N,W/N,W+/N" + ELSE + cColor := SetColor() + ::ColorSpec := __guicolor(cColor, 3) + "," + ; + __guicolor(cColor, 1) + "," + ; + __guicolor(cColor, 4) + ENDIF + ::Bottom := nBottom + ::CapCol := nLeft+2 + ::CapRow := nTop + ::Left := nLeft + ::right := nRight + ::top := nTop - if ( !( ISOBJECT( xItem ) ) ) - elseif ( xItem:classname() == "RADIOBUTTO" ) - AAdd(::aItems, xItem) +RETURN Self + +METHOD ADDITEM( xItem ) CLASS RadioGroup + + IF ISOBJECT( xItem ) .AND. xItem:classname() == "RADIOBUTTON" + AAdd( ::aItems, xItem ) ::ItemCount++ - endif - return Self + ENDIF -METHOD SETSTYLE( xStyle ) CLASS HBRadioGroup +RETURN Self + +METHOD SETSTYLE( xStyle ) CLASS RadioGroup - local nPos, nLen, aItems := ::aItems - nLen := ::ItemCount - for nPos := 1 to nLen - aItems[ nPos ]:style(xStyle) - next - return Self -METHOD SETFOCus() CLASS HBRadioGroup + LOCAL oItems + FOR EACH oItems IN ::aItems + oItems:style( xStyle ) + NEXT - local nPos, nLen, aItems - if ( !::HasFocus ) +RETURN Self + +METHOD SETFOCUS() CLASS RadioGroup + + LOCAL oItem + + IF ! ::HasFocus ::lCursor := setcursor(0) ::HasFocus := .T. - aItems := ::aItems - nLen := ::ItemCount + dispbegin() - for nPos := 1 to nLen - aItems[ nPos ]:setfocus() - next + + FOR EACH oItem IN ::aItems + oItem:SetFocus() + NEXT + ::display() dispend() - if ( ISBLOCK( ::fBlock ) ) - eval(::fBlock) - endif - endif - return self + IF ISBLOCK( ::fBlock ) + Eval( ::fBlock ) + ENDIF -METHOD _SETCOLor( Arg1 ) CLASS HBRadioGroup + ENDIF +RETURN Self - local nPos, nLen, aItems := ::aItems - nLen := ::ItemCount - for nPos := 1 to nLen - aItems[ nPos ]:colorspec :=Arg1 - next - return Self -METHOD _SELECT( xValue ) CLASS HBRadioGroup +METHOD _SETCOLOR( cColor ) CLASS RadioGroup - local nPos, nLen, cType := ValType(xValue) - if ( cType == "C" ) + LOCAL oItem + + FOR EACH oItem IN ::aItems + oItem:ColorSpec := cColor + NEXT + +RETURN Self + +METHOD _SELECT( xValue ) CLASS RadioGroup + + LOCAL nPos, nLen, cType := ValType( xValue ) + + IF cType == "C" nLen := ::ItemCount - for nPos := 1 to nLen - if ( ::aItems[ nPos ]:data == xValue ) + FOR nPos := 1 to nLen + IF ::aItems[ nPos ]:data == xValue default ::Buffer to "" - changebutt(self, ::Value, nPos) - exit - endif - next - if ( nPos > nLen ) + changebutt( self, ::Value, nPos ) + EXIT + ENDIF + NEXT + + IF nPos > nLen ::Buffer := xValue - endif - elseif ( cType != "U" .AND. xValue < 1 ) - elseif ( cType != "U" .AND. xValue <= ::ItemCount ) + ENDIF + + ELSEIF cType != "U" .AND. xValue >= 1 .AND. xValue <= ::ItemCount + default ::Buffer to 0 - changebutt(self, ::Value, xValue) - endif - return qself() -METHOD PREVITem() CLASS HBRadioGroup + changebutt( self, ::Value, xValue ) + ENDIF - local xValue, nPos - if ( !::HasFocus ) - elseif ( ::ItemCount > 0 ) - if ( ( xValue := ::Value ) == 0 ) +RETURN Self + +METHOD PREVITEM() CLASS RadioGroup + + LOCAL nPos, xValue + + IF ::HasFocus .AND. ::ItemCount > 0 + SWITCH ( xValue := ::Value ) + CASE 0 + nPos := 1 + CASE 1 + nPos := ::ItemCount + OTHERWISE + nPos := xValue - 1 + END + changebutt( self, xValue, nPos ) + ENDIF + +RETURN self + +METHOD NEXTITEM() CLASS RadioGroup + + LOCAL xValue, nPos + + IF ::HasFocus .AND. ::ItemCount > 0 + IF ( xValue := ::Value ) == ::ItemCount nPos := 1 - elseif ( xValue == 1 ) - nPos := ::ItemCount - else - nPos := xValue - 1 - endif - changebutt(self, xValue, nPos) - endif - return self -METHOD NEXTITem() CLASS HBRadioGroup - - - local xValue, nPos - if ( !::HasFocus ) - elseif ( ::ItemCount > 0 ) - if ( ( xValue := ::Value ) == ::ItemCount ) - nPos := 1 - else + ELSE nPos := xValue + 1 - endif - changebutt(self, xValue, nPos) - endif - return Self -METHOD KILLFOcus() CLASS HBRadioGroup + ENDIF + changebutt( self, xValue, nPos ) + ENDIF + +RETURN Self + +METHOD KILLFOCUS() CLASS RadioGroup + + LOCAL oItem + + IF ::HasFocus - local nPos, nCount, aItems - if ( ::HasFocus ) ::HasFocus := .F. - if ( ISBLOCK( ::fBlock ) ) - eval(::fBlock) - endif - aItems := ::aItems - nCount := ::ItemCount + IF ISBLOCK( ::fBlock ) + Eval( ::fBlock ) + ENDIF dispbegin() - for nPos := 1 to nCount - aItems[ nPos ]:killfocus() - next + FOR EACH oItem IN ::aItems + oItem:killfocus() + NEXT ::display() dispend() - setcursor(::lCursor) - endif - return self -METHOD INSITEM( nPos, oButtom ) CLASS HBRadioGroup + setcursor( ::lCursor ) + ENDIF +RETURN self - if ( !( ISOBJECT( oButtom ) ) ) - elseif ( !( oButtom:classname() == "RADIOBUTTN" ) ) - elseif ( nPos < ::ItemCount ) - asize(::aItems, ++::ItemCount) - ains(::aItems, nPos) +METHOD INSITEM( nPos, oButtom ) CLASS RadioGroup + + IF ISOBJECT( oButtom ) .AND. oButtom:classname() == "RADIOBUTTON" .AND. ; + nPos < ::ItemCount + + ASize( ::aItems, ++::ItemCount ) + AIns( ::aItems, nPos ) ::aItems[ nPos ] := oButtom - endif - return ::aItems[ nPos ] -METHOD HITTEST( nRow, nCol ) CLASS HBRadioGroup - local nPos, nCount, aItem := ::aItems, nLen, nPosition + ENDIF + +RETURN ::aItems[ nPos ] + +METHOD HITTEST( nRow, nCol ) CLASS RadioGroup + + LOCAL nPos, nCount, aItem := ::aItems, nLen, nPosition + nCount := ::ItemCount - do case - case Empty(::Coldbox + ::HotBox) - case nRow == ::Top - if ( nCol == ::Left ) - return -1 - elseif ( nCol == ::Right ) - return -3 - elseif ( nCol >= ::Left .AND. nCol <= ::Right ) - return -2 - endif - case nRow == ::Bottom - if ( nCol == ::Left ) - return -7 - elseif ( nCol == ::Right ) - return -5 - elseif ( nCol >= ::Left .AND. nCol <= ::Right ) - return -6 - endif - case nCol == ::Left - if ( nRow >= ::Top .AND. nRow <= ::Bottom ) - return -8 - else - return 0 - endif - case nCol == ::Right - if ( nRow >= ::Top .AND. nRow <= ::Bottom ) - return -4 - else - return 0 - endif - endcase - nLen := Len(::Caption) - if ( ( nPosition := At("&", ::Caption) ) == 0 ) - elseif ( nPosition < nLen ) + DO CASE + CASE Empty( ::Coldbox + ::HotBox ) + CASE nRow == ::Top + IF nCol == ::Left + RETURN HTTOPLEFT + ELSEIF nCol == ::Right + RETURN HTTOPRIGHT + ELSEIF nCol >= ::Left .AND. nCol <= ::Right + RETURN HTTOP + ENDIF + CASE nRow == ::Bottom + IF nCol == ::Left + RETURN HTBOTTOMLEFT + ELSEIF nCol == ::Right + RETURN HTBOTTOMRIGHT + ELSEIF nCol >= ::Left .AND. nCol <= ::Right + RETURN HTBOTTOM + ENDIF + CASE nCol == ::Left + IF nRow >= ::Top .AND. nRow <= ::Bottom + RETURN HTLEFT + ELSE + RETURN HTNOWHERE + ENDIF + CASE nCol == ::Right + IF nRow >= ::Top .AND. nRow <= ::Bottom + RETURN HTRIGHT + ELSE + RETURN HTNOWHERE + ENDIF + ENDCASE + + nLen := Len( ::Caption ) + IF ( nPosition := AT( "&", ::Caption ) ) != 0 .AND. nPosition < nLen nLen-- - endif - do case - case Empty(::Caption) - case nRow != ::CapRow - case nCol < ::CapCol - case nCol < ::CapCol + nLen - return -1025 - endcase - do case - case nRow < ::Top - case nRow > ::Bottom - case nCol < ::Left - case nCol <= ::Right - for nPos := 1 to nCount - if ( aItem[ nPos ]:hittest(nRow, nCol) != 0 ) - return nPos - endif - next - return -2049 - endcase - return 0 -METHOD GETITEm( xValue ) CLASS HBRadioGroup - local xReturn := Nil - if ( xValue < 1 ) - elseif ( xValue <= ::ItemCount ) - xReturn := ::aItems[ xValue ] - endif - return xReturn -METHOD GetAccel( xValue ) CLASS HBRadioGroup + ENDIF - local nPos, nLen, aItem - if ( ISNUMBER( xValue ) ) - xValue := Chr(xValue) - elseif ( !ValType(xValue == "C") ) - return 0 - endif - aItem := ::aItems - nLen := Len(aItem) - xValue := Lower(xValue) - for nPos := 1 to nLen - if ( aItem[ nPos ]:isaccel(xValue) ) - return nPos - endif - next - return 0 + IF !Empty( ::Caption ) .AND. nRow == ::CapRow .AND. ; + nCol >= ::CapCol .AND. nCol < ::CapCol + nLen -METHOD DISPLAY() CLASS HBRadioGroup + RETURN HTCAPTION + ENDIF + IF nRow >= ::Top .AND. nRow <= ::Bottom .AND. ; + nCol >= ::Left .AND. nCol <= ::Right - local nPos, nCount, aItem, cColor := SetColor(), nCurRow:= ; - Row(), nCurCol := Col(), cSelBox, cUnSelBox, cCaption, nPosition - aItem := ::aItems - nCount := ::ItemCount + FOR nPos := 1 to nCount + IF aItem[ nPos ]:hittest( nRow, nCol ) != 0 + RETURN nPos + ENDIF + NEXT + RETURN HTCLIENT + ENDIF + +RETURN HTNOWHERE + +METHOD GETITEM( nPos ) CLASS RadioGroup + + IF nPos >= 1 .AND. nPos <= ::ItemCount + RETURN ::aItems[ nPos ] + ENDIF + +RETURN NIL + +METHOD GETACCEL( xValue ) CLASS RadioGroup + + LOCAL oItem + + IF ISNUMBER( xValue ) + xValue := Chr( xValue ) + ELSEIF !ISCHARACTER( xValue ) + RETURN 0 + ENDIF + + xValue := Lower( xValue ) + + FOR EACH oItem IN ::aItems + IF oItem:isaccel( xValue ) + RETURN oItem:__enumIndex() + ENDIF + NEXT + +RETURN 0 + +METHOD DISPLAY() CLASS RadioGroup + + LOCAL cColor := SetColor(), nCurRow := Row(), nCurCol := Col(), ; + cSelBox, cUnSelBox, cCaption, nPosition, oItem dispbegin() - if ( ::HasFocus ) + + IF ::HasFocus cSelBox := ::HotBox cUnSelBox := ::Coldbox - else + ELSE cSelBox := ::Coldbox cUnSelBox := ::HotBox - endif - set color to (__guicolor(::ColorSpec, 1)) - if ( !Empty(cSelBox) ) - @ ::Top, ::Left, ::Bottom, ::Right ; - box cSelBox - elseif ( !Empty(cUnSelBox) ) - @ ::Top, ::Left, ::Bottom, ::Right ; - box cUnSelBox - endif - if ( !Empty(cCaption := ::Caption) ) - if ( ( nPosition := At("&", cCaption) ) == 0 ) - elseif ( nPosition == Len(cCaption) ) - nPosition := 0 - else - cCaption := stuff(cCaption, nPosition, 1, "") - endif - set color to (__guicolor(::ColorSpec, 2)) - SetPos(::CapRow, ::CapCol) + ENDIF + + set color to ( __guicolor( ::ColorSpec, 1 ) ) + + IF !Empty( cSelBox ) + @ ::Top, ::Left, ::Bottom, ::Right box cSelBox + ELSEIF !Empty( cUnSelBox ) + @ ::Top, ::Left, ::Bottom, ::Right box cUnSelBox + ENDIF + + IF !Empty( cCaption := ::Caption ) + + IF ( nPosition := At("&", cCaption) ) != 0 + IF nPosition == Len( cCaption ) + nPosition := 0 + ELSE + cCaption := stuff( cCaption, nPosition, 1, "" ) + ENDIF + ENDIF + + set color to ( __guicolor( ::ColorSpec, 2 ) ) + SetPos( ::CapRow, ::CapCol ) ?? cCaption - if ( nPosition != 0 ) - set color to (__guicolor(::ColorSpec, 3)) - SetPos(::CapRow, ::CapCol + nPosition - 1) - ?? SubStr(cCaption, nPosition, 1) - endif - endif - for nPos := 1 to nCount - aItem[ nPos ]:display() - next + + IF nPosition != 0 + set color to ( __guicolor( ::ColorSpec, 3 ) ) + SetPos( ::CapRow, ::CapCol + nPosition - 1 ) + ?? SubStr( cCaption, nPosition, 1 ) + ENDIF + ENDIF + + FOR EACH oItem IN ::aItems + oItem:Display() + NEXT + dispend() - set color to (cColor) - SetPos(nCurRow, nCurCol) - return self + set color to ( cColor ) + SetPos( nCurRow, nCurCol ) -METHOD DELITEm( xItem ) CLASS HBRadioGroup +RETURN self - if ( xItem < 1 ) - elseif ( xItem <= ::ItemCount ) - adel(::aItems[ xItem ]) - asize(::aItems, --::ItemCount) - endif - if ( !::HasFocus ) - elseif ( ::ItemCount < ::Value ) +METHOD DELITEM( xItem ) CLASS RadioGroup + + IF xItem >= 1 .AND. xItem <= ::ItemCount + ADel( ::aItems[ xItem ] ) + ASize( ::aItems, --::ItemCount ) + ENDIF + + IF ::HasFocus .AND. ::ItemCount < ::Value ::Value := ::ItemCount ::TextValue := ::aItems[ ::Value ]:data - if ( ISNUMBER( ::Buffer ) ) - ::Buffer := ::Value - else - ::Buffer := ::TextValue - endif - endif - return self + ::Buffer := IIF( ISNUMBER( ::Buffer ), ::Value, ::TextValue ) + ENDIF -/*METHOD GetColor(xColor) CLASS HBRadioGroup - if ( !( ISNIL( xColor ) ) ) - ::Color := iif( Valtype(xColor)=="C" .and. !Empty(__guicolor(xColor, 3)) .AND. ; - Empty(__guicolor(xColor, 4)),xColor,) +RETURN Self - endif - return ::Color +/* +METHOD GetColor(xColor) CLASS RadioGroup + IF ! ISNIL( xColor ) + ::Color := iif( Valtype( xColor ) == "C" .and. ; + !Empty( __guicolor( xColor, 3 ) ) .AND. ; + Empty( __guicolor( xColor, 4 ) ), xColor, ) + ENDIF +RETURN ::Color */ -static function CHANGEBUTT( oItems, xVal, nPos ) +STATIC FUNCTION CHANGEBUTT( oItems, xVal, nPos ) - if ( xVal != nPos ) + IF xVal != nPos dispbegin() - if ( xVal > 0 ) - oItems:aItems[ xVal ]:select(.F.) + IF xVal > 0 + oItems:aItems[ xVal ]:select( .F. ) oItems:aItems[ xVal ]:display() - endif - if ( nPos > 0 ) - oItems:aItems[ nPos ]:select(.T.) + ENDIF + IF nPos > 0 + oItems:aItems[ nPos ]:select( .T. ) oItems:aItems[ nPos ]:display() - endif + ENDIF dispend() oItems:Value := nPos oItems:TextValue := oItems:aItems[ nPos ]:data - if ( ISNUMBER( oItems:Buffer ) ) - oItems:Buffer := nPos - else - oItems:Buffer := oItems:TextValue - endif - endif - return .T. + oItems:Buffer := IIF( ISNUMBER( oItems:Buffer ), nPos, oItems:TextValue ) + ENDIF + +RETURN .T. + // Radio Group Class Constructor Function -function RADIOGROUP( nTop, nLeft, nBottom, nRight ) - if ( ( ISNUMBER( nTop ) ) ) .and. ( ( ISNUMBER( nLeft ) ) ) .and. ( ( ISNUMBER( nBottom ) ) ) .and. ( ( ISNUMBER( nright ) ) ) - Return HBRadioGroup():New(nTop, nLeft, nBottom, nRight ) - endif - Return Nil +FUNCTION RADIOGROUP( nTop, nLeft, nBottom, nRight ) + + IF ISNUMBER( nTop ) .and. ; + ISNUMBER( nLeft ) .and. ; + ISNUMBER( nBottom ) .and. ; + ISNUMBER( nRight ) + RETURN HBRadioGroup():New( nTop, nLeft, nBottom, nRight ) + ENDIF + +RETURN NIL -function _RADIOGRP_( nTop, nLeft, nBottom, nRight, xValue, aItems, cCaption, cMessage, ; - cColor, bFblock ) +FUNCTION _RADIOGRP_( nTop, nLeft, nBottom, nRight, xValue, aItems, cCaption, ; + cMessage, cColor, bFblock ) - local oRadioGroup, nPos, nLen - default ccaption to "" - oRadioGroup := radiogroup(nTop, nLeft, nBottom, nRight) - if ( !( ISNIL( oRadioGroup ) ) ) - oRadioGroup:caption:= if(cCaption!=NIL,cCaption,) - oRadioGroup:colorspec:=if(cColor!=Nil,cColor,) - oRadioGroup:message:=if(cMessage!=nil,cMessage,) - oRadioGroup:fblock:=if(bFblock!=nil,bFblock,) - nLen := Len(aItems) - for nPos := 1 to nLen - oRadioGroup:additem(aItems[ nPos ]) - next - oRadioGroup:select(xValue) - endif - return oRadioGroup + LOCAL oRadioGroup, xItem + + IF ! ISNIL( oRadioGroup := radiogroup( nTop, nLeft, nBottom, nRight ) ) + + oRadioGroup:caption := IIF( ISNIL( cCaption ), "", cCaption ) + oRadioGroup:colorspec := cColor + oRadioGroup:message := cMessage + oRadioGroup:fblock := bFblock + + FOR EACH xItem IN aItems + oRadioGroup:additem( xItem ) + NEXT + + oRadioGroup:select( xValue ) + ENDIF + +RETURN oRadioGroup #endif diff --git a/harbour/source/rtl/readkey.prg b/harbour/source/rtl/readkey.prg index 102b049901..9657c21e5a 100644 --- a/harbour/source/rtl/readkey.prg +++ b/harbour/source/rtl/readkey.prg @@ -55,23 +55,24 @@ FUNCTION ReadKey() LOCAL nKey := LastKey() - DO CASE - CASE nKey == K_UP ; nKey := 4 /* NOTE: NG says 5 incorrectly */ - CASE nKey == K_DOWN ; nKey := 5 /* NOTE: NG says 2 incorrectly */ - CASE nKey == K_PGUP ; nKey := 6 - CASE nKey == K_PGDN ; nKey := 7 - CASE nKey == K_CTRL_PGUP ; nKey := 34 /* NOTE: NG says 31 incorrectly */ - CASE nKey == K_CTRL_PGDN ; nKey := 35 /* NOTE: NG says 30 incorrectly */ - CASE nKey == K_ESC ; nKey := 12 - CASE nKey == K_CTRL_W ; nKey := 14 - CASE nKey == K_ENTER ; nKey := 15 - CASE nKey >= K_SPACE ; nKey := 15 - OTHERWISE ; RETURN 0 - ENDCASE + SWITCH nKey + CASE K_UP ; nKey := 4 ; EXIT /* NOTE: NG says 5 incorrectly */ + CASE K_DOWN ; nKey := 5 ; EXIT /* NOTE: NG says 2 incorrectly */ + CASE K_PGUP ; nKey := 6 ; EXIT + CASE K_PGDN ; nKey := 7 ; EXIT + CASE K_CTRL_PGUP ; nKey := 34 ; EXIT /* NOTE: NG says 31 incorrectly */ + CASE K_CTRL_PGDN ; nKey := 35 ; EXIT /* NOTE: NG says 30 incorrectly */ + CASE K_ESC ; nKey := 12 ; EXIT + CASE K_CTRL_W ; nKey := 14 ; EXIT + CASE K_ENTER ; nKey := 15 ; EXIT + OTHERWISE + IF nKey >= K_SPACE ; nKey := 15 + ELSE ; RETURN 0 + ENDIF + END IF Updated() nKey += 256 ENDIF - RETURN nKey - +RETURN nKey diff --git a/harbour/source/rtl/readvar.prg b/harbour/source/rtl/readvar.prg index 58c5f0ecb5..13e917022f 100644 --- a/harbour/source/rtl/readvar.prg +++ b/harbour/source/rtl/readvar.prg @@ -58,8 +58,7 @@ FUNCTION ReadVar( cVarName ) LOCAL cOldVarName LOCAL oGetList - oGetList := __GetListActive() - IF oGetList != NIL + IF ( oGetList := __GetListActive() ) != NIL RETURN oGetList:ReadVar( cVarName ) ENDIF @@ -69,5 +68,4 @@ FUNCTION ReadVar( cVarName ) s_cVarName := cVarName ENDIF - RETURN cOldVarName - +RETURN cOldVarName diff --git a/harbour/source/rtl/run.c b/harbour/source/rtl/run.c index 3e938cc74e..4cf0809cfe 100644 --- a/harbour/source/rtl/run.c +++ b/harbour/source/rtl/run.c @@ -59,8 +59,6 @@ HB_FUNC( __RUN ) { -#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(_MSC_VER) || \ - defined(__WATCOMC__) || defined(__IBMCPP__) || defined(__GNUC__) if( ISCHAR( 1 ) && hb_gtSuspend() == 0 ) { system( hb_parc( 1 ) ); @@ -71,7 +69,4 @@ HB_FUNC( __RUN ) /* hb_errRT_BASE_Ext1( EG_GTRESUME, 9999, NULL, "__RUN", 0, EF_CANDEFAULT ); */ } } -#else - hb_errRT_BASE_Ext1( EG_UNSUPPORTED, 9999, NULL, "__RUN", 0, EF_CANDEFAULT, 0 ); -#endif } diff --git a/harbour/source/rtl/set.c b/harbour/source/rtl/set.c index b38dc69f8e..9e6bb74446 100644 --- a/harbour/source/rtl/set.c +++ b/harbour/source/rtl/set.c @@ -294,7 +294,7 @@ static FHANDLE open_handle( char * file_name, BOOL bAppend, char * def_ext, HB_s else uiAction = E_DEFAULT; - if( uiAction == E_DEFAULT || uiAction == E_BREAK ) + if( uiAction != E_RETRY ) break; } } @@ -876,6 +876,11 @@ HB_FUNC( SET ) else hb_retc( NULL ); if( args > 1 ) hb_set.HB_SET_EOL = set_string( pArg2, hb_set.HB_SET_EOL ); break; + case HB_SET_TRIMFILENAME: + hb_retl( hb_set.HB_SET_TRIMFILENAME ); + if( args > 1 ) hb_set.HB_SET_TRIMFILENAME = set_logical( pArg2, hb_set.HB_SET_TRIMFILENAME ); + break; + case HB_SET_INVALID_: /* Return NIL if called with invalid SET specifier */ break; @@ -995,6 +1000,7 @@ void hb_setInitialize( void ) hb_set.HB_SET_DBFLOCKSCHEME = 0; hb_set.HB_SET_DEFEXTENSIONS = TRUE; hb_set.HB_SET_EOL = hb_strdup( hb_conNewLine() ); + hb_set.HB_SET_TRIMFILENAME = FALSE; sp_sl_first = sp_sl_last = NULL; s_next_listener = 1; diff --git a/harbour/source/rtl/transfrm.c b/harbour/source/rtl/transfrm.c index 29146763c7..5ad035f257 100644 --- a/harbour/source/rtl/transfrm.c +++ b/harbour/source/rtl/transfrm.c @@ -823,14 +823,35 @@ HB_FUNC( TRANSFORM ) } else if( HB_IS_NUMERIC( pValue ) ) { - ULONG ulLen; - BOOL bFreeReq; - char * szStr = hb_itemString( pValue, &ulLen, &bFreeReq ); + int iWidth = 10, iDec; + char * szStr; - if( bFreeReq ) - hb_retclen_buffer( szStr, ulLen ); - else - hb_retclen( szStr, ulLen ); + if( !HB_IS_DOUBLE( pValue ) && hb_set.HB_SET_FIXED ) + { + hb_itemGetNLen( pValue, &iWidth, &iDec ); + if( iWidth < 10 ) + { + PHB_ITEM pWidth = hb_itemPutNI( NULL, 2 + iWidth + + ( hb_set.HB_SET_DECIMALS << 1 ) ); + szStr = hb_itemStr( pValue, pWidth, NULL ); + hb_itemRelease( pWidth ); + if( szStr ) + hb_retc_buffer( szStr ); + else + hb_retc( NULL ); + } + } + if( iWidth >= 10 ) + { + ULONG ulLen; + BOOL bFreeReq; + + szStr = hb_itemString( pValue, &ulLen, &bFreeReq ); + if( bFreeReq ) + hb_retclen_buffer( szStr, ulLen ); + else + hb_retclen( szStr, ulLen ); + } } else if( HB_IS_DATE( pValue ) ) { diff --git a/harbour/source/rtl/version.c b/harbour/source/rtl/version.c index 1fcfbea58c..e1017d9014 100644 --- a/harbour/source/rtl/version.c +++ b/harbour/source/rtl/version.c @@ -65,22 +65,25 @@ HB_FUNC( OS ) { - char * ptr = hb_verPlatform(); - hb_retc( ptr ); - hb_xfree( ptr ); + hb_retc_buffer( hb_verPlatform() ); } HB_FUNC( HB_COMPILER ) { - char * ptr = hb_verCompiler(); - hb_retc( ptr ); - hb_xfree( ptr ); + hb_retc_buffer( hb_verCompiler() ); } HB_FUNC( VERSION ) { - char * ptr = hb_verHarbour(); - hb_retc( ptr ); - hb_xfree( ptr ); + hb_retc_buffer( hb_verHarbour() ); } +HB_FUNC( HB_PCODEVER ) +{ + hb_retc_buffer( hb_verPCode() ); +} + +HB_FUNC( HB_BUILDDATE ) +{ + hb_retc_buffer( hb_verBuildDate() ); +} diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index 8ea495f585..3c5fa377bc 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -2352,9 +2352,9 @@ HB_EXPORT char * hb_itemString( PHB_ITEM pItem, ULONG * ulLen, BOOL * bFreeReq ) if( hb_set.HB_SET_FIXED ) { /* If fixed mode is enabled, use the default number of decimal places. */ - PHB_ITEM pDec = hb_itemPutNI( NULL, hb_set.HB_SET_DECIMALS ); - buffer = hb_itemStr( pItem, NULL, pDec ); - hb_itemRelease( pDec ); + hb_itemPutNI( hb_stackAllocItem(), hb_set.HB_SET_DECIMALS ); + buffer = hb_itemStr( pItem, NULL, hb_stackItemFromTop( -1 ) ); + hb_stackPop(); } else buffer = hb_itemStr( pItem, NULL, NULL ); @@ -2478,9 +2478,10 @@ HB_EXPORT PHB_ITEM hb_itemValToStr( PHB_ITEM pItem ) HB_TRACE(HB_TR_DEBUG, ("hb_itemValToStr(%p)", pItem)); buffer = hb_itemString( pItem, &ulLen, &bFreeReq ); - pResult = hb_itemPutCL( NULL, buffer, ulLen ); if( bFreeReq ) - hb_xfree( buffer ); + pResult = hb_itemPutCPtr( NULL, buffer, ulLen ); + else + pResult = hb_itemPutCL( NULL, buffer, ulLen ); return pResult; }