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

2007-08-30 03:55 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* 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
This commit is contained in:
Przemyslaw Czerpak
2007-08-30 01:56:03 +00:00
parent 4fdb3beb46
commit feda39d689
41 changed files with 1388 additions and 1106 deletions
Download Patch File Download Diff File Expand all files Collapse all files

90
harbour/ChangeLog
View File

@@ -8,6 +8,96 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
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

10
harbour/contrib/libct/ctwin.c
View File

@@ -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:

2
harbour/include/hbapi.h
View File

@@ -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 */

4
harbour/include/hbset.h
View File

@@ -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;

3
harbour/include/set.ch
View File

@@ -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 */

12
harbour/source/common/hbver.c
View File

@@ -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;
}

12
harbour/source/rtl/accept.c
View File

@@ -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 */
}
}

2
harbour/source/rtl/ampm.c
View File

@@ -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 );
}

7
harbour/source/rtl/box.c
View File

@@ -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 ),

296
harbour/source/rtl/checkbox.prg
View File

@@ -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

2
harbour/source/rtl/colorind.c
View File

@@ -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 );

75
harbour/source/rtl/console.c
View File

@@ -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 );

10
harbour/source/rtl/copyfile.c
View File

@@ -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;

2
harbour/source/rtl/dateshb.c
View File

@@ -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 );

30
harbour/source/rtl/defpath.c
View File

@@ -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 )

9
harbour/source/rtl/devoutp.prg
View File

@@ -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

12
harbour/source/rtl/dircmd.prg
View File

@@ -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

5
harbour/source/rtl/filehb.c
View File

@@ -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 )
{

10
harbour/source/rtl/filesys.c
View File

@@ -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 != '\\' )
{

7
harbour/source/rtl/fkmax.c
View File

@@ -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 );
}

2
harbour/source/rtl/gete.c
View File

@@ -107,7 +107,7 @@ HB_FUNC( GETENV )
{
if( szValue )
hb_xfree( szValue );
hb_retc( hb_parcx( 2 ) );
hb_retc( hb_parc( 2 ) );
}
}
else

10
harbour/source/rtl/hbgtcore.c
View File

@@ -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:

8
harbour/source/rtl/inkey.c
View File

@@ -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 ) ) );
}

46
harbour/source/rtl/isprint.c
View File

@@ -66,10 +66,13 @@
#include "hbapi.h"
#include "hbapifs.h"
#if defined(HB_OS_WIN_32) && !defined(__RSXNT__)
#include <stdio.h>
#include <winspool.h>
#undef HB_WIN_32_PRINTERS
#if defined(HB_OS_WIN_32) && !defined(__RSXNT__) && !defined(__CYGWIN__)
# define HB_WIN_32_PRINTERS
# include <stdio.h>
# include <winspool.h>
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;

6
harbour/source/rtl/langapi.c
View File

@@ -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 )

69
harbour/source/rtl/listbox.prg
View File

@@ -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

311
harbour/source/rtl/math.c
View File

@@ -56,10 +56,10 @@
*/
#if defined(__DJGPP__)
#include <libm/math.h>
# include <libm/math.h>
_LIB_VERSION_TYPE _LIB_VERSION = _XOPEN_;
#else
#include <math.h>
# include <math.h>
#endif
#include "hbapi.h"
@@ -69,10 +69,10 @@ _LIB_VERSION_TYPE _LIB_VERSION = _XOPEN_;
#include "hbmath.h"
#if defined(HB_MATH_ERRNO)
# include <errno.h>
# include <errno.h>
#endif
#if defined(HB_OS_SUNOS)
# include <ieeefp.h>
# include <ieeefp.h>
#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 ) /* ([<nNewMode>]) -> <nOldMode> */
HB_FUNC( HB_MATHERMODE ) /* ([<nNewMode>]) -> <nOldMode> */
{
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 <exception handled flag> and it
the <exception handled flag> 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 ) /* ([<nNewErrorBlock>]) -> <nOldErrorBlock> */
HB_FUNC( HB_MATHERBLOCK ) /* ([<nNewErrorBlock>]) -> <nOldErrorBlock> */
{
/* 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;
}

140
harbour/source/rtl/menuto.prg
View File

@@ -20,10 +20,10 @@
#include "setcurs.ch"
#xtranslate COLORARRAY(<x>) => &( '{"' + strtran(<x>, ',', '","') + '"}' )
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

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

@@ -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;

17
harbour/source/rtl/oldbox.c
View File

@@ -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 ) );
}

30
harbour/source/rtl/philes.c
View File

@@ -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

161
harbour/source/rtl/pushbtn.prg
View File

@@ -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

284
harbour/source/rtl/radiobtn.prg
View File

@@ -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

689
harbour/source/rtl/radiogrp.prg
View File

@@ -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

31
harbour/source/rtl/readkey.prg
View File

@@ -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

6
harbour/source/rtl/readvar.prg
View File

@@ -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

5
harbour/source/rtl/run.c
View File

@@ -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
}

8
harbour/source/rtl/set.c
View File

@@ -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;

35
harbour/source/rtl/transfrm.c
View File

@@ -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 ) )
{

21
harbour/source/rtl/version.c
View File

@@ -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() );
}

11
harbour/source/vm/itemapi.c
View File

@@ -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;
}