fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2007-11-11 22:26 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* common.mak
   * source/rtl/Makefile
   + source/rtl/getsys53.prg
   * source/rtl/getsys.prg
   + source/rtl/secondfs.c
   * source/rtl/seconds.c
   + source/rtl/mouse53.c
   * source/rtl/mouseapi.c
     + Some C53 and FlagShip functions moved to separate source file.

   * include/hbextern.ch
   * common.mak
   * source/rtl/Makefile
   + source/rtl/hbstrsh.c
   * utils/hbtest/rt_stra.prg
     + Added hb_StrShrink(<cString>[,<nShrinkBy>]) -> cStringShrinked
       <nShrinkBy> has a default value of 1. Returns empty string 
       on error, returns full string if <nShrinkBy> is zero or negative.
       This function call is meant to be use instead of code like this:
       cString := Left( cString, Len( cString ) - 1 ) ->
       cString := hb_StrShrink( cString, 1 )
       TODO: Maybe to support passing it by reference and make it even 
             faster.
     + Added regression tests for this function.
This commit is contained in:
Viktor Szakats
2007-11-11 21:55:39 +00:00
parent 6594d95506
commit f7de654b8b
12 changed files with 539 additions and 224 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
harbour/ChangeLog
View File

@@ -8,6 +8,32 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-11-11 22:26 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* common.mak
* source/rtl/Makefile
+ source/rtl/getsys53.prg
* source/rtl/getsys.prg
+ source/rtl/secondfs.c
* source/rtl/seconds.c
+ source/rtl/mouse53.c
* source/rtl/mouseapi.c
+ Some C53 and FlagShip functions moved to separate source file.
* include/hbextern.ch
* common.mak
* source/rtl/Makefile
+ source/rtl/hbstrsh.c
* utils/hbtest/rt_stra.prg
+ Added hb_StrShrink(<cString>[,<nShrinkBy>]) -> cStringShrinked
<nShrinkBy> has a default value of 1. Returns empty string
on error, returns full string if <nShrinkBy> is zero or negative.
This function call is meant to be use instead of code like this:
cString := Left( cString, Len( cString ) - 1 ) ->
cString := hb_StrShrink( cString, 1 )
TODO: Maybe to support passing it by reference and make it even
faster.
+ Added regression tests for this function.
2007-11-11 18:55 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
+ contrib/telepath
+ contrib/telepath/ChangeLog

6
harbour/common.mak
View File

@@ -468,6 +468,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\hbfile$(OBJEXT) \
$(OBJ_DIR)\hbgtcore$(OBJEXT) \
$(OBJ_DIR)\hbinet$(OBJEXT) \
$(OBJ_DIR)\hbstrsh$(OBJEXT) \
$(OBJ_DIR)\hbrandom$(OBJEXT) \
$(OBJ_DIR)\hbregex$(OBJEXT) \
$(OBJ_DIR)\hbregexc$(OBJEXT) \
@@ -487,6 +488,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\minmax$(OBJEXT) \
$(OBJ_DIR)\mlcfunc$(OBJEXT) \
$(OBJ_DIR)\mod$(OBJEXT) \
$(OBJ_DIR)\mouse53$(OBJEXT) \
$(OBJ_DIR)\mouseapi$(OBJEXT) \
$(OBJ_DIR)\mousex$(OBJEXT) \
$(OBJ_DIR)\mtran$(OBJEXT) \
@@ -511,6 +513,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\samples$(OBJEXT) \
$(OBJ_DIR)\saverest$(OBJEXT) \
$(OBJ_DIR)\scroll$(OBJEXT) \
$(OBJ_DIR)\secondfs$(OBJEXT) \
$(OBJ_DIR)\seconds$(OBJEXT) \
$(OBJ_DIR)\set$(OBJEXT) \
$(OBJ_DIR)\setcolor$(OBJEXT) \
@@ -571,6 +574,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\fieldbl$(OBJEXT) \
$(OBJ_DIR)\getlist$(OBJEXT) \
$(OBJ_DIR)\getsys$(OBJEXT) \
$(OBJ_DIR)\getsys53$(OBJEXT) \
$(OBJ_DIR)\gui$(OBJEXT) \
$(OBJ_DIR)\hbini$(OBJEXT) \
$(OBJ_DIR)\input$(OBJEXT) \
@@ -578,7 +582,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\memoedit$(OBJEXT) \
$(OBJ_DIR)\memvarbl$(OBJEXT) \
$(OBJ_DIR)\menuto$(OBJEXT) \
$(OBJ_DIR)\menusys$(OBJEXT) \
$(OBJ_DIR)\menusys$(OBJEXT) \
$(OBJ_DIR)\objfunc$(OBJEXT) \
$(OBJ_DIR)\perfuncs$(OBJEXT) \
$(OBJ_DIR)\persist$(OBJEXT) \

1
harbour/include/hbextern.ch
View File

@@ -1042,6 +1042,7 @@ EXTERNAL HB_TOKENCOUNT
EXTERNAL HB_TOKENGET
EXTERNAL HB_TOKENPTR
EXTERNAL HB_ATOKENS
EXTERNAL HB_STRSHRINK
EXTERNAL HB_HASH
EXTERNAL HB_HHASKEY

4
harbour/source/rtl/Makefile
View File

@@ -59,6 +59,7 @@ C_SOURCES=\
hbfile.c \
hbgtcore.c \
hbinet.c \
hbstrsh.c \
hbrandom.c \
hbregex.c \
hbregexc.c \
@@ -78,6 +79,7 @@ C_SOURCES=\
minmax.c \
mlcfunc.c \
mod.c \
mouse53.c \
mouseapi.c \
mousex.c \
mtran.c \
@@ -102,6 +104,7 @@ C_SOURCES=\
samples.c \
saverest.c \
scroll.c \
secondfs.c \
seconds.c \
set.c \
setcolor.c \
@@ -164,6 +167,7 @@ PRG_SOURCES=\
fieldbl.prg \
getlist.prg \
getsys.prg \
getsys53.prg \
gui.prg \
hbini.prg \
input.prg \

98
harbour/source/rtl/getsys.prg
View File

@@ -332,101 +332,3 @@ FUNCTION RangeCheck( oGet, xDummy, xLow, xHigh )
ENDIF
RETURN .F.
#ifdef HB_COMPAT_C53
PROCEDURE GUIReader( oGet, oGetlist, oMenu, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
IF oGetList != NIL
oGetlist:GUIReader( oGet, oMenu, aMsg )
ENDIF
RETURN
PROCEDURE GUIApplyKey( oGet, oGUI, oGetList, nKey, oMenu, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
IF oGetList != NIL
oGetList:GUIApplyKey( oGet, oGUI, nKey, oMenu, aMsg )
ENDIF
RETURN
FUNCTION GUIPreValidate( oGet, oGUI, aMsg )
LOCAL oGetList := __GetListActive()
RETURN iif( oGetList != NIL, oGetList:GUIPreValidate( oGet, oGUI, aMsg ), .F. )
FUNCTION GUIPostValidate( oGet, oGUI, aMsg )
LOCAL oGetList := __GetListActive()
RETURN iif( oGetList != NIL, oGetList:GUIPostValidate( oGet, oGUI, aMsg ), .F. )
PROCEDURE TBReader( oGet, oGetList, oMenu, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
IF oGetList != NIL
oGetlist:TBReader( oGet, oMenu, aMsg )
ENDIF
RETURN
PROCEDURE TBApplyKey( oGet, oTB, oGetList, nKey, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
IF oGetList != NIL
oGetList:TBApplyKey( oGet, oTB, nKey, aMsg )
ENDIF
RETURN
FUNCTION Accelerator( oGetList, nKey, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
RETURN iif( oGetList != NIL, oGetlist:Accelerator( nKey, aMsg ), 0 )
FUNCTION HitTest( oGetList, nMRow, nMCol, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
RETURN iif( oGetList != NIL, oGetlist:hitTest( nMRow, nMCol, aMsg ), 0 )
FUNCTION ShowGetMsg( oGet, aMsg )
LOCAL oGetList := __GetListActive()
IF oGetList != NIL
oGetList:ShowGetMsg( oGet, aMsg )
ENDIF
RETURN NIL
FUNCTION EraseGetMsg( oGet, aMsg )
LOCAL oGetList := __GetListActive()
HB_SYMBOL_UNUSED( oGet )
IF oGetList != NIL
oGetList:EraseGetMsg( aMsg )
ENDIF
RETURN NIL
#endif

162
harbour/source/rtl/getsys53.prg Normal file
View File

@@ -0,0 +1,162 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* GET system module (default)
*
* Copyright 1999-2001 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 2001 Luiz Rafael Culik
* Support for CA-Clipper 5.3 Getsystem
*
* See doc/license.txt for licensing terms.
*
*/
#include "common.ch"
#ifdef HB_COMPAT_C53
PROCEDURE GUIReader( oGet, oGetlist, oMenu, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
IF oGetList != NIL
oGetlist:GUIReader( oGet, oMenu, aMsg )
ENDIF
RETURN
PROCEDURE GUIApplyKey( oGet, oGUI, oGetList, nKey, oMenu, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
IF oGetList != NIL
oGetList:GUIApplyKey( oGet, oGUI, nKey, oMenu, aMsg )
ENDIF
RETURN
FUNCTION GUIPreValidate( oGet, oGUI, aMsg )
LOCAL oGetList := __GetListActive()
RETURN iif( oGetList != NIL, oGetList:GUIPreValidate( oGet, oGUI, aMsg ), .F. )
FUNCTION GUIPostValidate( oGet, oGUI, aMsg )
LOCAL oGetList := __GetListActive()
RETURN iif( oGetList != NIL, oGetList:GUIPostValidate( oGet, oGUI, aMsg ), .F. )
PROCEDURE TBReader( oGet, oGetList, oMenu, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
IF oGetList != NIL
oGetlist:TBReader( oGet, oMenu, aMsg )
ENDIF
RETURN
PROCEDURE TBApplyKey( oGet, oTB, oGetList, nKey, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
IF oGetList != NIL
oGetList:TBApplyKey( oGet, oTB, nKey, aMsg )
ENDIF
RETURN
FUNCTION Accelerator( oGetList, nKey, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
RETURN iif( oGetList != NIL, oGetlist:Accelerator( nKey, aMsg ), 0 )
FUNCTION HitTest( oGetList, nMRow, nMCol, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
RETURN iif( oGetList != NIL, oGetlist:hitTest( nMRow, nMCol, aMsg ), 0 )
FUNCTION ShowGetMsg( oGet, aMsg )
LOCAL oGetList := __GetListActive()
IF oGetList != NIL
oGetList:ShowGetMsg( oGet, aMsg )
ENDIF
RETURN NIL
FUNCTION EraseGetMsg( oGet, aMsg )
LOCAL oGetList := __GetListActive()
HB_SYMBOL_UNUSED( oGet )
IF oGetList != NIL
oGetList:EraseGetMsg( aMsg )
ENDIF
RETURN NIL
#endif

77
harbour/source/rtl/hbstrsh.c Normal file
View File

@@ -0,0 +1,77 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* HB_STRSHRINK() function
*
* Copyright 2007 Viktor Szakats <viktor.szakats@syenar.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
HB_FUNC( HB_STRSHRINK )
{
PHB_ITEM pText = hb_param( 1, HB_IT_STRING );
if( pText )
{
long lLen = hb_itemGetCLen( pText );
long lShrinkBy = ISNUM( 2 ) ? hb_parnl( 2 ) : 1;
if( lShrinkBy > 0 )
{
if( lShrinkBy < lLen )
lLen -= lShrinkBy;
else
lLen = 0;
}
hb_retclen( hb_itemGetCPtr( pText ), lLen );
}
else
hb_retc( NULL );
}

170
harbour/source/rtl/mouse53.c Normal file
View File

@@ -0,0 +1,170 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Mouse API
*
* Copyright 1999-2001 Viktor Szakats <viktor.szakats@syenar.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbgtcore.h"
/* HARBOUR callable interface */
#ifdef HB_COMPAT_C53
static int s_iLeftButton = 0;
static int s_iRightButton = 1;
HB_FUNC( MPRESENT )
{
hb_retl( hb_mouseIsPresent() );
}
HB_FUNC( MHIDE )
{
hb_mouseSetCursor( FALSE );
}
HB_FUNC( MSHOW )
{
hb_mouseSetCursor( TRUE );
}
HB_FUNC( MSETCURSOR )
{
hb_retl( hb_mouseGetCursor() );
if( ISLOG( 1 ) )
hb_mouseSetCursor( hb_parl( 1 ) );
}
HB_FUNC( MROW )
{
if( ISLOG( 1 ) && hb_parl( 1 ) )
{
int iRow, iCol;
hb_mouseGetPos( &iRow, &iCol );
hb_retni( iRow );
}
else
hb_retni( hb_mouseRow() );
}
HB_FUNC( MCOL )
{
if( ISLOG( 1 ) && hb_parl( 1 ) )
{
int iRow, iCol;
hb_mouseGetPos( &iRow, &iCol );
hb_retni( iCol );
}
else
hb_retni( hb_mouseCol() );
}
HB_FUNC( MSETPOS )
{
if( ISNUM( 1 ) && ISNUM( 2 ) )
hb_mouseSetPos( hb_parni( 1 ), hb_parni( 2 ) );
}
HB_FUNC( MRIGHTDOWN )
{
hb_retl( hb_mouseButtonState( s_iRightButton ) );
}
HB_FUNC( MLEFTDOWN )
{
hb_retl( hb_mouseButtonState( s_iLeftButton ) );
}
HB_FUNC( MDBLCLK )
{
hb_retni( hb_mouseGetDoubleClickSpeed() );
if( ISNUM( 1 ) )
{
hb_mouseSetDoubleClickSpeed( hb_parni( 1 ) );
}
}
HB_FUNC( MSAVESTATE )
{
int iLen = hb_mouseStorageSize();
if( iLen > 0 )
{
BYTE * pBuffer = ( BYTE * ) hb_xgrab( iLen + 1 );
hb_mouseSaveState( pBuffer );
hb_retclen_buffer( ( char * ) pBuffer, iLen );
}
else
hb_retc( NULL );
}
HB_FUNC( MRESTSTATE )
{
if( ISCHAR( 1 ) && hb_parclen( 1 ) == ( ULONG ) hb_mouseStorageSize() )
{
hb_mouseRestoreState( ( BYTE * ) hb_parc( 1 ) );
}
}
HB_FUNC( MSETBOUNDS )
{
hb_mouseSetBounds( hb_parni( 1 ), /* Defaults to zero on bad type */
hb_parni( 2 ), /* Defaults to zero on bad type */
ISNUM( 3 ) ? hb_parni( 3 ) : hb_gtMaxRow(),
ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol() );
}
#endif

116
harbour/source/rtl/mouseapi.c
View File

@@ -65,9 +65,6 @@
#include "hbapiitm.h"
#include "hbgtcore.h"
static int s_iLeftButton = 0;
static int s_iRightButton = 1;
/* NOTE: Mouse initialization is called directly from low level GT driver
* because it possible that mouse subsystem can depend on the terminal
* (for example, mouse subsystem cannot be initialized before ncurses
@@ -207,116 +204,3 @@ HB_EXPORT int hb_mouseReadKey( int iEventMask )
return hb_mouse_ReadKey( iEventMask );
}
/* HARBOUR callable interface */
#ifdef HB_COMPAT_C53
HB_FUNC( MPRESENT )
{
hb_retl( hb_mouseIsPresent() );
}
HB_FUNC( MHIDE )
{
hb_mouseSetCursor( FALSE );
}
HB_FUNC( MSHOW )
{
hb_mouseSetCursor( TRUE );
}
HB_FUNC( MSETCURSOR )
{
hb_retl( hb_mouseGetCursor() );
if( ISLOG( 1 ) )
hb_mouseSetCursor( hb_parl( 1 ) );
}
HB_FUNC( MROW )
{
if( ISLOG( 1 ) && hb_parl( 1 ) )
{
int iRow, iCol;
hb_mouseGetPos( &iRow, &iCol );
hb_retni( iRow );
}
else
hb_retni( hb_mouseRow() );
}
HB_FUNC( MCOL )
{
if( ISLOG( 1 ) && hb_parl( 1 ) )
{
int iRow, iCol;
hb_mouseGetPos( &iRow, &iCol );
hb_retni( iCol );
}
else
hb_retni( hb_mouseCol() );
}
HB_FUNC( MSETPOS )
{
if( ISNUM( 1 ) && ISNUM( 2 ) )
hb_mouseSetPos( hb_parni( 1 ), hb_parni( 2 ) );
}
HB_FUNC( MRIGHTDOWN )
{
hb_retl( hb_mouseButtonState( s_iRightButton ) );
}
HB_FUNC( MLEFTDOWN )
{
hb_retl( hb_mouseButtonState( s_iLeftButton ) );
}
HB_FUNC( MDBLCLK )
{
hb_retni( hb_mouseGetDoubleClickSpeed() );
if( ISNUM( 1 ) )
{
hb_mouseSetDoubleClickSpeed( hb_parni( 1 ) );
}
}
HB_FUNC( MSAVESTATE )
{
int iLen = hb_mouseStorageSize();
if( iLen > 0 )
{
BYTE * pBuffer = ( BYTE * ) hb_xgrab( iLen + 1 );
hb_mouseSaveState( pBuffer );
hb_retclen_buffer( ( char * ) pBuffer, iLen );
}
else
hb_retc( NULL );
}
HB_FUNC( MRESTSTATE )
{
if( ISCHAR( 1 ) && hb_parclen( 1 ) == ( ULONG ) hb_mouseStorageSize() )
{
hb_mouseRestoreState( ( BYTE * ) hb_parc( 1 ) );
}
}
HB_FUNC( MSETBOUNDS )
{
hb_mouseSetBounds( hb_parni( 1 ), /* Defaults to zero on bad type */
hb_parni( 2 ), /* Defaults to zero on bad type */
ISNUM( 3 ) ? hb_parni( 3 ) : hb_gtMaxRow(),
ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol() );
}
#endif

63
harbour/source/rtl/secondfs.c Normal file
View File

@@ -0,0 +1,63 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* SECONDSCPU() FlagShip compatible function
*
* Copyright 2003 Przemyslaw Czerpak <druzus@acn.waw.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
#include "hbdate.h"
#ifdef HB_COMPAT_FLAGSHIP
HB_FUNC( SECONDSCPU )
{
hb_retnd( hb_secondsCPU( hb_parni( 1 ) ) );
}
#endif

9
harbour/source/rtl/seconds.c
View File

@@ -197,8 +197,6 @@ HB_FUNC( HB_CLOCKS2SECS )
hb_retnd((double) hb_parnl( 1 ) / CLOCKS_PER_SEC );
}
#ifdef HB_COMPAT_FLAGSHIP
/*
secondsCPU(n) -> nTime
FlagShip/CLIP compatible function, which reports how many CPU and/or
@@ -273,10 +271,3 @@ HB_EXPORT double hb_secondsCPU( int n )
#endif
return d;
}
HB_FUNC( SECONDSCPU )
{
hb_retnd( hb_secondsCPU( hb_parni( 1 ) ) );
}
#endif

31
harbour/utils/hbtest/rt_stra.prg
View File

@@ -488,6 +488,37 @@ FUNCTION New_STRINGS()
TEST_LINE( hb_ValToStr( .F. ) , ".F." )
TEST_LINE( hb_ValToStr( .T. ) , ".T." )
TEST_LINE( hb_StrShrink() , "" )
TEST_LINE( hb_StrShrink( NIL ) , "" )
TEST_LINE( hb_StrShrink( "" ) , "" )
TEST_LINE( hb_StrShrink( "", -1 ) , "" )
TEST_LINE( hb_StrShrink( "", 0 ) , "" )
TEST_LINE( hb_StrShrink( "", 1 ) , "" )
TEST_LINE( hb_StrShrink( "", 10 ) , "" )
TEST_LINE( hb_StrShrink( "a" ) , "" )
TEST_LINE( hb_StrShrink( "a", -1 ) , "a" )
TEST_LINE( hb_StrShrink( "a", 0 ) , "a" )
TEST_LINE( hb_StrShrink( "a", 1 ) , "" )
TEST_LINE( hb_StrShrink( "a", 10 ) , "" )
TEST_LINE( hb_StrShrink( "ab" ) , "a" )
TEST_LINE( hb_StrShrink( "ab", -1 ) , "ab" )
TEST_LINE( hb_StrShrink( "ab", 0 ) , "ab" )
TEST_LINE( hb_StrShrink( "ab", 1 ) , "a" )
TEST_LINE( hb_StrShrink( "ab", 10 ) , "" )
TEST_LINE( hb_StrShrink( "ab" ) , "a" )
TEST_LINE( hb_StrShrink( "ab", -2 ) , "ab" )
TEST_LINE( hb_StrShrink( "ab", 2 ) , "" )
TEST_LINE( hb_StrShrink( "hello" ) , "hell" )
TEST_LINE( hb_StrShrink( "hello", -1 ) , "hello" )
TEST_LINE( hb_StrShrink( "hello", 0 ) , "hello" )
TEST_LINE( hb_StrShrink( "hello", 1 ) , "hell" )
TEST_LINE( hb_StrShrink( "hello", 2 ) , "hel" )
TEST_LINE( hb_StrShrink( "hello", 3 ) , "he" )
TEST_LINE( hb_StrShrink( "hello", 4 ) , "h" )
TEST_LINE( hb_StrShrink( "hello", 5 ) , "" )
TEST_LINE( hb_StrShrink( "hello", 6 ) , "" )
TEST_LINE( hb_StrShrink( "hello", 7 ) , "" )
#endif
RETURN NIL