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

2007-04-23 23:28 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* harbour/source/rtl/diskspac.c
     ! Fixed to return free space instead of disk size under Unix OSes.

   * harbour/source/rtl/tget.prg
     ! Fixed checking for invalid GET var types.
     ! More C5x compatible behaviour for invalid types.
     ! ::UnTransform() fixed when not in focus.
     - ::UnTransform() cBuffer incompatible parameter removed.
     ! ::Reform() probably made more compatible.
     + ::PosInBuffer() XBase++ compatible method implemented.
       (but not tested or compared with XBase++)
     ! ::Minus assignment fixed.
     ! ::Clear assignment fixed.
     ! ::Changed assignment fixed.
     ! ::Buffer assignment fixed.
     ! ::Block assignment fixed.
     ! ::Name assignment fixed.
     ! ::UnTransform() extra parameter removed.
     ! ::UpdateBuffer() minor fix when not in focus.
     ! ::Reform() made more compatible.
     % ::SetFocus() some superfluous stuff removed.
     % ::SetFocus() some fixes, cleanups.
     ! ::KillFocus() now sets ::TypeOut properly.
     ! ::VarPut(), ::VarGet() fixed for invalid ::Subscript contents.
     ! ::VarPut(), ::VarGet() fixed for invalid ::Block content.
     ! ::Pos rewritten to be fully compatible.
     ! ::ColorSpec made fully compatible.
     ! ::UnTransform() fixed when not in focus.
     ! ::UnTransform() fixed handling "YL" in string pictures.
     % ::UnTransform() minor optimization.
     % ::PutMask() some hacks removed.
     ! ::PutMask() invalid types handling.
     ! ::BackSpace() fixed when not in focus.
     ! ::Delete() fixed when not in focus.
     ! ::DeleteAll() fixed when not in focus.
     ! ::IsEditable() fixes.
     ! ::Picture fixes for invalid types, assignment behaviour.
     ! ::Picture hacks removed.
     ! Non-assignable vars made READONLY. (will generate
       different RTEs than in CA-Cl*pper due to the more
       refined oo engine in Harbour.)
     ! ::BadDate changed to be a METHOD.
     ! ::ToDecPos fixes.
     ! ::Row assigment and behaviour fixes.
     ! ::Col assigment and behaviour fixes.
     + Several comments and NOTEs added.

   * harbour/include/hbapigt.h
   * harbour/source/rtl/gtapi.c
   * harbour/source/rtl/setcolor.c
     + hb_gtColorsToString() public API added.
     + hb_NToColor() function added to convert a single color
       value (returned by hb_ColorToN()) back to a string.
       Used in TGet():ColorSpec implementation.

   * harbour/source/vm/fm.c
     * "Blocks" -> "Block(s)"

   * harbour/tests/rto_get.prg
     + Added many test cases.

   * harbour/source/vm/cmdarg.c
     + Added support to use "--" instead of "//" for internal
       command line options.

   * harbour/source/rtl/tbcolumn.prg
     + Formatting.

   * harbour/source/rtl/tbrowse.prg
     + Added Harbour (undocumented) extension NOTE.

   * harbour/include/Makefile
   - harbour/include/usrrdd.ch
   + harbour/include/hbusrrdd.ch
   * harbour/source/rdd/usrrdd/usrrdd.c
   * harbour/source/rdd/usrrdd/rdds/dbtcdx.prg
   * harbour/source/rdd/usrrdd/rdds/fcomma.prg
   * harbour/source/rdd/usrrdd/rdds/fptcdx.prg
   * harbour/source/rdd/usrrdd/rdds/hscdx.prg
   * harbour/source/rdd/usrrdd/rdds/rlcdx.prg
   * harbour/source/rdd/usrrdd/rdds/smtcdx.prg
   * harbour/contrib/pgsql/pgrdd.prg
     ! Changed public header filename to comply with the "hb*.ch" rule.
       (namespace protection)
This commit is contained in:
Viktor Szakats
2007-04-23 21:41:40 +00:00
parent 74adc6f86c
commit 1c11bc25db
21 changed files with 1503 additions and 493 deletions
Download Patch File Download Diff File Expand all files Collapse all files

86
harbour/ChangeLog
View File

@@ -8,6 +8,92 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-04-23 23:28 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* harbour/source/rtl/diskspac.c
! Fixed to return free space instead of disk size under Unix OSes.
* harbour/source/rtl/tget.prg
! Fixed checking for invalid GET var types.
! More C5x compatible behaviour for invalid types.
! ::UnTransform() fixed when not in focus.
- ::UnTransform() cBuffer incompatible parameter removed.
! ::Reform() probably made more compatible.
+ ::PosInBuffer() XBase++ compatible method implemented.
(but not tested or compared with XBase++)
! ::Minus assignment fixed.
! ::Clear assignment fixed.
! ::Changed assignment fixed.
! ::Buffer assignment fixed.
! ::Block assignment fixed.
! ::Name assignment fixed.
! ::UnTransform() extra parameter removed.
! ::UpdateBuffer() minor fix when not in focus.
! ::Reform() made more compatible.
% ::SetFocus() some superfluous stuff removed.
% ::SetFocus() some fixes, cleanups.
! ::KillFocus() now sets ::TypeOut properly.
! ::VarPut(), ::VarGet() fixed for invalid ::Subscript contents.
! ::VarPut(), ::VarGet() fixed for invalid ::Block content.
! ::Pos rewritten to be fully compatible.
! ::ColorSpec made fully compatible.
! ::UnTransform() fixed when not in focus.
! ::UnTransform() fixed handling "YL" in string pictures.
% ::UnTransform() minor optimization.
% ::PutMask() some hacks removed.
! ::PutMask() invalid types handling.
! ::BackSpace() fixed when not in focus.
! ::Delete() fixed when not in focus.
! ::DeleteAll() fixed when not in focus.
! ::IsEditable() fixes.
! ::Picture fixes for invalid types, assignment behaviour.
! ::Picture hacks removed.
! Non-assignable vars made READONLY. (will generate
different RTEs than in CA-Cl*pper due to the more
refined oo engine in Harbour.)
! ::BadDate changed to be a METHOD.
! ::ToDecPos fixes.
! ::Row assigment and behaviour fixes.
! ::Col assigment and behaviour fixes.
+ Several comments and NOTEs added.
* harbour/include/hbapigt.h
* harbour/source/rtl/gtapi.c
* harbour/source/rtl/setcolor.c
+ hb_gtColorsToString() public API added.
+ hb_NToColor() function added to convert a single color
value (returned by hb_ColorToN()) back to a string.
Used in TGet():ColorSpec implementation.
* harbour/source/vm/fm.c
* "Blocks" -> "Block(s)"
* harbour/tests/rto_get.prg
+ Added many test cases.
* harbour/source/vm/cmdarg.c
+ Added support to use "--" instead of "//" for internal
command line options.
* harbour/source/rtl/tbcolumn.prg
+ Formatting.
* harbour/source/rtl/tbrowse.prg
+ Added Harbour (undocumented) extension NOTE.
* harbour/include/Makefile
- harbour/include/usrrdd.ch
+ harbour/include/hbusrrdd.ch
* harbour/source/rdd/usrrdd/usrrdd.c
* harbour/source/rdd/usrrdd/rdds/dbtcdx.prg
* harbour/source/rdd/usrrdd/rdds/fcomma.prg
* harbour/source/rdd/usrrdd/rdds/fptcdx.prg
* harbour/source/rdd/usrrdd/rdds/hscdx.prg
* harbour/source/rdd/usrrdd/rdds/rlcdx.prg
* harbour/source/rdd/usrrdd/rdds/smtcdx.prg
* harbour/contrib/pgsql/pgrdd.prg
! Changed public header filename to comply with the "hb*.ch" rule.
(namespace protection)
2007-04-23 18:25 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbcomp.h
* harbour/include/hbcompdf.h

4
harbour/contrib/pgsql/pgrdd.prg
View File

@@ -58,7 +58,7 @@
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "hbusrrdd.ch"
#include "fileio.ch"
#include "error.ch"
#include "dbstruct.ch"
@@ -391,5 +391,3 @@ RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ;
INIT PROC PG_INIT()
rddRegister( "PGRDD", RDT_FULL )
RETURN

6
harbour/include/Makefile
View File

@@ -73,6 +73,7 @@ PRG_HEADERS=\
getexit.ch \
hbclass.ch \
hbcommon.ch \
hbcompat.ch \
hbdebug.ch \
hbextern.ch \
hbgetcmt.ch \
@@ -89,6 +90,7 @@ PRG_HEADERS=\
hbpers.ch \
hbsetup.ch \
hbstdgen.ch \
hbusrrdd.ch \
inkey.ch \
memoedit.ch \
ord.ch \
@@ -98,9 +100,7 @@ PRG_HEADERS=\
setcurs.ch \
simpleio.ch \
std.ch \
tbrowse.ch \
usrrdd.ch \
hbcompat.ch
tbrowse.ch
API_HEADERS=\
error.api \

1
harbour/include/hbapigt.h
View File

@@ -149,6 +149,7 @@ extern HB_EXPORT ERRCODE hb_gtBoxD( SHORT uiTop, SHORT uiLeft, SHORT uiBottom, S
extern HB_EXPORT ERRCODE hb_gtBoxS( SHORT uiTop, SHORT uiLeft, SHORT uiBottom, SHORT uiRight );
extern HB_EXPORT ERRCODE hb_gtColorSelect( USHORT uiColorIndex );
extern HB_EXPORT USHORT hb_gtColorToN( char * szColorString );
extern HB_EXPORT USHORT hb_gtColorsToString( int * pColors, int iColorCount, char * pszColorString, int iBufSize );
extern HB_EXPORT ERRCODE hb_gtDispBegin( void );
extern HB_EXPORT USHORT hb_gtDispCount( void );
extern HB_EXPORT ERRCODE hb_gtDispEnd( void );

0
harbour/include/usrrdd.ch → harbour/include/hbusrrdd.ch
View File

2
harbour/source/rdd/usrrdd/rdds/dbtcdx.prg
View File

@@ -51,7 +51,7 @@
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "hbusrrdd.ch"
#include "dbinfo.ch"
/*

2
harbour/source/rdd/usrrdd/rdds/fcomma.prg
View File

@@ -64,7 +64,7 @@
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "hbusrrdd.ch"
#include "fileio.ch"
#include "error.ch"

2
harbour/source/rdd/usrrdd/rdds/fptcdx.prg
View File

@@ -51,7 +51,7 @@
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "hbusrrdd.ch"
#include "dbinfo.ch"
/*

2
harbour/source/rdd/usrrdd/rdds/hscdx.prg
View File

@@ -60,7 +60,7 @@
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "hbusrrdd.ch"
#include "fileio.ch"
#include "dbinfo.ch"

2
harbour/source/rdd/usrrdd/rdds/rlcdx.prg
View File

@@ -59,7 +59,7 @@
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "hbusrrdd.ch"
ANNOUNCE RLCDX

2
harbour/source/rdd/usrrdd/rdds/smtcdx.prg
View File

@@ -57,7 +57,7 @@
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "hbusrrdd.ch"
#include "dbinfo.ch"
/* Force linking DBFCDX and DBFFPT from which our RDD inherits */

2
harbour/source/rdd/usrrdd/usrrdd.c
View File

@@ -61,7 +61,7 @@
#include "hbstack.h"
#include "hbinit.h"
#include "rddsys.ch"
#include "usrrdd.ch"
#include "hbusrrdd.ch"
#define SELF_USRNODE( w ) ( s_pUsrRddNodes[ (w)->rddID ] )
#define SELF_USRDATA( w ) ( ( LPUSRRDDDATA ) ( ( BYTE * )( w ) + \

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

@@ -209,12 +209,12 @@ HB_FUNC( DISKSPACE )
char *szName = ISCHAR( 1 ) ? hb_parc( 1 ) : ( char * ) "/";
#if defined(HB_OS_SUNOS)
struct statvfs st;
if ( statvfs( szName, &st) == 0 )
if ( statvfs( szName, &st ) == 0 )
#else
struct statfs st;
if ( statfs( szName, &st) == 0 )
if ( statfs( szName, &st ) == 0 )
#endif
dSpace = ( double ) st.f_blocks * ( double ) st.f_bsize;
dSpace = ( double ) st.f_bfree * ( double ) st.f_bsize;
else
bError = TRUE;

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

@@ -240,6 +240,15 @@ HB_EXPORT USHORT hb_gtColorToN( char * szColorString )
return hb_gt_ColorNum( szColorString );
}
HB_EXPORT USHORT hb_gtColorsToString( int * pColors, int iColorCount, char * pszColorString, int iBufSize )
{
HB_TRACE(HB_TR_DEBUG, ("hb_gtColorsToString(%p, %d, %p, %d)", pColors, iColorCount, pszColorString, iBufSize));
hb_gt_ColorsToString( pColors, iColorCount, pszColorString, iBufSize );
return SUCCESS;
}
HB_EXPORT ERRCODE hb_gtSetColorStr( const char * szColorString )
{
HB_TRACE(HB_TR_DEBUG, ("hb_gtSetColorStr(%s)", szColorString));

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

@@ -99,4 +99,21 @@ HB_FUNC( HB_COLORTON )
hb_retni( 0 );
}
HB_FUNC( HB_NTOCOLOR )
{
if( ISNUM( 1 ) )
{
char szColorString[ 10 ];
int colors[ 1 ];
colors[ 0 ] = hb_parni( 1 );
hb_gtColorsToString( colors, 1, szColorString, 10 );
hb_retc( szColorString );
}
else
hb_retc( "N/N" );
}
#endif

38
harbour/source/rtl/tbcolumn.prg
View File

@@ -74,7 +74,7 @@ CLASS TBColumn
#endif
ACCESS Width INLINE ::nWidth // Column display width
ASSIGN Width( n ) INLINE ::SetWidth( n )
ASSIGN Width( nWidth ) INLINE ::SetWidth( nWidth )
// NOTE: 17/08/01 - <maurilio.longo@libero.it>
// It is not correct in my opinion that this instance variable be exported
@@ -117,34 +117,34 @@ METHOD New( cHeading, bBlock ) CLASS TBColumn
return Self
METHOD SetWidth(n) CLASS TBColumn
METHOD SetWidth( nWidth ) CLASS TBColumn
// From a TOFIX inside TBrowse.prg:
// "Also Clipper will not allow the user to assign a NIL to the :width variable."
if n <> nil
::nWidth := n
/* NOTE: CA-Cl*pper won't allow the user to assign NIL to the :width variable. */
if nWidth != NIL
::nWidth := nWidth
endif
return n
return nWidth
#ifdef HB_COMPAT_C53
METHOD SetStyle( nMode, lSetting ) CLASS TBColumn
LOCAL lRet := .F.
IF nMode > LEN( ::aSetStyle )
ASize( ::aSetStyle, nMode )
::aSetStyle[ nMode ] := .F.
ENDIF
local lRet := .F.
if nMode > Len( ::aSetStyle )
ASize( ::aSetStyle, nMode )
::aSetStyle[ nMode ] := .F.
endif
lRet := ::aSetStyle[ nMode ]
if ISLOGICAL( lSetting )
::aSetStyle[ nMode ] := lSetting
endif
lRet := ::aSetStyle[ nMode ]
IF ISLOGICAL( lSetting )
::aSetStyle[ nMode ] := lSetting
ENDIF
RETURN lRet
return lRet
#endif

1
harbour/source/rtl/tbrowse.prg
View File

@@ -154,6 +154,7 @@ CLASS TBrowse
METHOD ColWidth( nColumn ) // Returns the display width of a particular column
METHOD ColCount()
METHOD ColorRect() // Alters the color of a rectangular group of cells
/* NOTE: nMode is an undocumented Harbour parameter. Should not be used by app code. */
METHOD Configure( nMode ) // Reconfigures the internal settings of the TBrowse object
// nMode is an undocumented parameter in CA-Cl*pper
METHOD DeHilite() // Dehighlights the current cell

985
harbour/source/rtl/tget.prg
View File

File diff suppressed because it is too large Load Diff

4
harbour/source/vm/cmdarg.c
View File

@@ -119,8 +119,8 @@ BOOL hb_cmdargIsInternal( const char * szArg )
HB_TRACE(HB_TR_DEBUG, ("hb_cmdargIsInternal(%s)", szArg));
return strlen( szArg ) >= 2 &&
szArg[ 0 ] == '/' &&
szArg[ 1 ] == '/';
( ( szArg[ 0 ] == '/' && szArg[ 1 ] == '/' ) ||
( szArg[ 0 ] == '-' && szArg[ 1 ] == '-' ) ) ;
}
static char * hb_cmdargGet( const char * pszName, BOOL bRetValue )

4
harbour/source/vm/fm.c
View File

@@ -587,7 +587,7 @@ HB_EXPORT void hb_xexit( void ) /* Deinitialize fixed memory subsystem */
hb_conOutErr( hb_conNewLine(), 0 );
hb_conOutErr( "----------------------------------------", 0 );
hb_conOutErr( hb_conNewLine(), 0 );
snprintf( buffer, sizeof( buffer ), "Total memory allocated: %li bytes (%li blocks)", s_lMemoryMaxConsumed, s_lMemoryMaxBlocks );
snprintf( buffer, sizeof( buffer ), "Total memory allocated: %li bytes (%li block(s))", s_lMemoryMaxConsumed, s_lMemoryMaxBlocks );
hb_conOutErr( buffer, 0 );
if ( hLog )
@@ -606,7 +606,7 @@ HB_EXPORT void hb_xexit( void ) /* Deinitialize fixed memory subsystem */
if( s_lMemoryBlocks )
{
hb_conOutErr( hb_conNewLine(), 0 );
snprintf( buffer, sizeof( buffer ), "WARNING! Memory allocated but not released: %li bytes (%li blocks)", s_lMemoryConsumed, s_lMemoryBlocks );
snprintf( buffer, sizeof( buffer ), "WARNING! Memory allocated but not released: %li bytes (%li block(s))", s_lMemoryConsumed, s_lMemoryBlocks );
hb_conOutErr( buffer, 0 );
if ( hLog ) fprintf( hLog, "%s\n", buffer );

821
harbour/tests/rto_get.prg
View File

@@ -52,10 +52,12 @@
/* NOTE: This source can be compiled with both Harbour and CA-Cl*pper. */
#include "common.ch"
#include "error.ch"
#include "fileio.ch"
#ifndef __HARBOUR__
#define HB_OSNewLine() ( Chr( 13 ) + Chr( 10 ) )
#define hb_OSNewLine() ( Chr( 13 ) + Chr( 10 ) )
#endif
#translate TEST_LINE( <x> ) => TEST_CALL( o, #<x>, {|| <x> } )
@@ -63,14 +65,38 @@
STATIC s_cTest := ""
STATIC s_xVar := NIL
STATIC s_fhnd
STATIC s_lCallBackStack
STATIC s_lRTEDetails
STATIC s_lC5xDump
FUNCTION Main()
FUNCTION Main( cArg01, cArg02, cArg03, cArg04 )
LOCAL nInt01 := 98
LOCAL nStr01 := "AbC DeF 974"
LOCAL cStr01 := "AbC DF 974"
LOCAL cStr02E := ""
LOCAL dDate01
LOCAL bOldBlock
LOCAL o
LOCAL cCommandLine
DEFAULT cArg01 TO ""
DEFAULT cArg02 TO ""
DEFAULT cArg03 TO ""
DEFAULT cArg04 TO ""
SET DATE ANSI
// ;
cCommandLine := cArg01 + " " + cArg02 + " " + cArg03 + " " + cArg04
s_lCallBackStack := "CALLBACKSTACK" $ Upper( cCommandLine )
s_lRTEDetails := "RTEDETAILS" $ Upper( cCommandLine )
s_lC5xDump := "C5XDUMP" $ Upper( cCommandLine )
// ;
#ifdef __HARBOUR__
s_fhnd := FCreate( "tget_hb.txt", FC_NORMAL )
#else
@@ -81,20 +107,184 @@ FUNCTION Main()
RETURN 1
ENDIF
FWrite( s_fhnd, Set( _SET_DATEFORMAT ) + hb_OSNewLine() )
// ; Picture
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999999999",, )
TEST_LINE( o:Picture := "99" )
TEST_LINE( o:Picture := "!!" )
TEST_LINE( o:Picture := NIL )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:Picture := "99" )
TEST_LINE( o:Picture := "!!" )
TEST_LINE( o:Picture := NIL )
// ; Assign
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999999999",, )
o:SetFocus()
TEST_LINE( o:OverStrike( "z" ) )
TEST_LINE( o:Assign() )
// ; Buffer
s_xVar := "abcdefg"
SetPos( 14, 14 ) ; o := _GET_( s_xVar, "s_xVar",,, )
TEST_LINE( o:buffer := "1234567" )
TEST_LINE( o:buffer := "abcdefg" )
s_xVar := "abcdefg"
SetPos( 14, 14 ) ; o := _GET_( s_xVar, "s_xVar",,, )
o:SetFocus()
TEST_LINE( o:buffer := "1234567" )
TEST_LINE( o:buffer := "abcdefg" )
// ; Clear
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, )
TEST_LINE( o:Clear := .T. )
TEST_LINE( o:Clear := .F. )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:Clear := .T. )
TEST_LINE( o:Clear := .F. )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, )
TEST_LINE( o:Clear := .T. )
TEST_LINE( o:Clear := .F. )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:Clear := .F. )
TEST_LINE( o:Clear := .T. )
// ; Minus
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, )
TEST_LINE( o:Minus := .T. )
TEST_LINE( o:Minus := .F. )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:Minus := .T. )
TEST_LINE( o:Minus := .F. )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, )
TEST_LINE( o:Minus := .F. )
TEST_LINE( o:Minus := .T. )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:Minus := .F. )
TEST_LINE( o:Minus := .T. )
// ; Changed
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, )
TEST_LINE( o:Changed := .T. )
TEST_LINE( o:Changed := .F. )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:Changed := .T. )
TEST_LINE( o:Changed := .F. )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, )
TEST_LINE( o:Changed := .F. )
TEST_LINE( o:Changed := .T. )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:Changed := .F. )
TEST_LINE( o:Changed := .T. )
// ; ColorSpec
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01",,, )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := ",N/G" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "," )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N/N" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N /N" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N/ N" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G, N/N" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G, N/N " )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,hkjhkj" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "n/g,n/bg" )
// ; Pos
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, )
o:SetFocus()
TEST_LINE( o:Pos := 5 )
TEST_LINE( o:ToDecPos() )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999.",, )
o:SetFocus()
TEST_LINE( o:Pos := 5 )
TEST_LINE( o:ToDecPos() )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999",, )
o:SetFocus()
TEST_LINE( o:Pos := 5 )
TEST_LINE( o:ToDecPos() )
TEST_LINE( o:Pos := 0 )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999",, )
o:SetFocus()
TEST_LINE( o:Pos := 10 )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01", "9999",, )
o:SetFocus()
TEST_LINE( o:Pos := 0 )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999--9999",, )
o:SetFocus()
TEST_LINE( o:Pos := 5 )
TEST_LINE( o:Pos := 6 )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999------",, )
o:SetFocus()
TEST_LINE( o:Pos := 5 )
TEST_LINE( o:Pos := 6 )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "----------",, )
o:SetFocus()
TEST_LINE( o:Pos := 5 )
TEST_LINE( o:Pos := 6 )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999999999",, )
o:SetFocus()
TEST_LINE( o:Pos := 11 )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01", "9999999999",, )
o:SetFocus()
// TEST_LINE( o:Pos := -2 )
SetPos( 14, 14 ) ; o := _GET_( cStr02E, "cStr02E",,, )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:Pos := 1 )
// ; Error conditions
TGetAssign( NIL )
// TGetAssign( -1 ) // ; CA-Cl*pper has too many differences due to the low level implementation here
TGetAssign( 0 )
TGetAssign( 1 )
TGetAssign( 3 )
TGetAssign( 100 )
TGetAssign( "" )
TGetAssign( "az" )
TGetAssign( hb_SToD( "20070425" ) )
TGetAssign( .F. )
TGetAssign( .T. )
TGetAssign( {|| NIL } )
TGetAssign( {} )
TGetAssign( { "" } )
// ; Type change N -> C
SetPos( 14, 14 )
o := _GET_( nInt01, "nInt01",,, )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:KillFocus() )
TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, nStr01, nStr01 := h ) } )
TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, cStr01, cStr01 := h ) } )
TEST_LINE( o:SetFocus() )
// ; Reform
SetPos( 14, 14 )
o := _GET_( nStr01, "nStr01",,, )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:picture := "!!!!!!!!" )
@@ -105,8 +295,7 @@ FUNCTION Main()
// ; Minus
SetPos( 14, 14 )
o := _GET_( nInt01, "nInt01",,, )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" )
TEST_LINE( GET_CREATE() )
bOldBlock := o:block
TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } )
@@ -117,38 +306,411 @@ FUNCTION Main()
o:minus := .T.
TEST_LINE( o:SetFocus() )
// ;
SET CENTURY ON
SetPos( 14, 14 ) ; dDate01 := hb_SToD( "20070425" )
o := _GET_( dDate01, "dDate01" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:OverStrike("12345678") )
TEST_LINE( o:KillFocus() )
SetPos( 14, 14 ) ; dDate01 := hb_SToD( "20070425" )
o := _GET_( dDate01, "dDate01", "@E" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:OverStrike("12345678") )
TEST_LINE( o:KillFocus() )
SET CENTURY OFF
SetPos( 14, 14 ) ; dDate01 := hb_SToD( "20070425" )
o := _GET_( dDate01, "dDate01" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:OverStrike("12345678") )
TEST_LINE( o:KillFocus() )
SetPos( 14, 14 ) ; dDate01 := hb_SToD( "20070425" )
o := _GET_( dDate01, "dDate01", "@E" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:OverStrike("12345678") )
TEST_LINE( o:KillFocus() )
SetPos( 14, 14 ) ; cStr01 := "hello world"
o := _GET_( cStr01, "cStr01", "!!LY!!!!!!" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:OverStrike("12345678") )
TEST_LINE( o:KillFocus() )
SetPos( 14, 14 ) ; cStr01 := "hello world"
o := _GET_( cStr01, "cStr01", "!!!.!!!!!!" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:OverStrike("12345678") )
TEST_LINE( o:KillFocus() )
SetPos( 14, 14 ) ; cStr01 := "hello world"
o := _GET_( cStr01, "cStr01", "@R !!LY!!!!!!" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:OverStrike("12345678") )
TEST_LINE( o:KillFocus() )
SetPos( 14, 14 ) ; cStr01 := "hello world"
o := _GET_( cStr01, "cStr01", "@R !!!.!!!!!!" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:SetFocus() )
TEST_LINE( o:OverStrike("12345678") )
TEST_LINE( o:KillFocus() )
// ; Exercises
TGetTest( 98, NIL )
TGetTest( 98, "99999" )
TGetTest( 98, "99999." )
TGetTest( 98, "99999.99" )
TGetTest( -98, NIL )
TGetTest( -98, "99999" )
TGetTest( -98, "99999." )
TGetTest( -98, "99999.99" )
TGetTest( "hello world", NIL )
TGetTest( "hello world", "@!" )
TGetTest( "hello world", "!!!" )
TGetTest( "hello world", "@S5" )
TGetTest( .T., NIL )
TGetTest( .T., "Y" )
SET CENTURY ON
TGetTest( hb_SToD( "20070425" ), NIL )
SET CENTURY OFF
TGetTest( hb_SToD( "20070425" ), NIL )
TGetTest( NIL, NIL )
TGetTest( NIL, "!!!!" )
TGetTest( {|| "" }, NIL )
FClose( s_fhnd )
RETURN 0
PROCEDURE TGetAssign( xVar )
LOCAL o
LOCAL nInt01 := 76
LOCAL cStr01 := "AbC DeF 974"
LOCAL dDat01 := hb_SToD( "20070425" )
LOCAL lLog01 := .F.
LOCAL bBlo01 := {|| NIL }
s_xVar := xVar
s_cTest := "Non-Focus Assign To N: " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:BadDate := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Block := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Buffer := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Cargo := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Changed := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Clear := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Col := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:ColorSpec := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:DecPos := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:ExitState := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:HasFocus := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Minus := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Name := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Original := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Picture := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Pos := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:PostBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:PreBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Reader := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Rejected := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Row := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:SubScript := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Type := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:TypeOut := xVar )
s_cTest := "Non-Focus Assign To C: " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:BadDate := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Block := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Buffer := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Cargo := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Changed := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Clear := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Col := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:ColorSpec := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:DecPos := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:ExitState := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:HasFocus := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Minus := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Name := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Original := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Picture := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Pos := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:PostBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:PreBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Reader := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Rejected := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Row := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:SubScript := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Type := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:TypeOut := xVar )
s_cTest := "Non-Focus Assign To D: " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:BadDate := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Block := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Buffer := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Cargo := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Changed := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Clear := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Col := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:ColorSpec := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:DecPos := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:ExitState := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:HasFocus := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Minus := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Name := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Original := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Picture := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Pos := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:PostBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:PreBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Reader := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Rejected := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Row := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:SubScript := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Type := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:TypeOut := xVar )
s_cTest := "Non-Focus Assign To L: " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:BadDate := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Block := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Buffer := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Cargo := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Changed := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Clear := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Col := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:ColorSpec := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:DecPos := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:ExitState := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:HasFocus := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Minus := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Name := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Original := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Picture := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Pos := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:PostBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:PreBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Reader := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Rejected := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Row := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:SubScript := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Type := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:TypeOut := xVar )
s_cTest := "Non-Focus Assign To B: " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:BadDate := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Block := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Buffer := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Cargo := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Changed := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Clear := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Col := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:ColorSpec := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:DecPos := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:ExitState := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:HasFocus := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Minus := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Name := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Original := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Picture := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Pos := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:PostBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:PreBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Reader := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Rejected := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Row := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:SubScript := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Type := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:TypeOut := xVar )
s_cTest := "InFocus Assign to N: " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:BadDate := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Block := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Buffer := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Cargo := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Changed := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Clear := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Col := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:ColorSpec := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:DecPos := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:ExitState := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:HasFocus := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Minus := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Name := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Original := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Picture := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Pos := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:PostBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:PreBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Reader := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Rejected := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Row := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:SubScript := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Type := xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar )
s_cTest := "InFocus Assign to C: " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:BadDate := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Block := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Buffer := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Cargo := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Changed := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Clear := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Col := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:ColorSpec := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:DecPos := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:ExitState := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:HasFocus := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Minus := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Name := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Original := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Picture := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Pos := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:PostBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:PreBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Reader := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Rejected := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Row := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:SubScript := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Type := xVar )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar )
s_cTest := "InFocus Assign to D: " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:BadDate := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Block := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Buffer := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Cargo := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Changed := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Clear := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Col := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:ColorSpec := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:DecPos := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:ExitState := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:HasFocus := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Minus := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Name := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Original := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Picture := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Pos := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:PostBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:PreBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Reader := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Rejected := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Row := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:SubScript := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Type := xVar )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar )
s_cTest := "InFocus Assign to L: " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:BadDate := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Block := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Buffer := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Cargo := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Changed := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Clear := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Col := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:ColorSpec := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:DecPos := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:ExitState := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:HasFocus := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Minus := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Name := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Original := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Picture := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Pos := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:PostBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:PreBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Reader := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Rejected := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Row := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:SubScript := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Type := xVar )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar )
s_cTest := "InFocus Assign to B: " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:BadDate := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Block := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Buffer := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Cargo := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Changed := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Clear := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Col := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:ColorSpec := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:DecPos := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:ExitState := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:HasFocus := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Minus := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Name := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Original := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Picture := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Pos := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:PostBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:PreBlock := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Reader := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Rejected := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Row := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:SubScript := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Type := xVar )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar )
s_cTest := "InFocus/SetFocus " + XToStr( xVar )
SetPos( 14, 14 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:SetFocus )
SetPos( 14, 14 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:SetFocus )
SetPos( 14, 14 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:SetFocus )
SetPos( 14, 14 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:SetFocus )
SetPos( 14, 14 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:SetFocus )
RETURN
PROCEDURE TGetTest( xVar, cPic )
LOCAL bOldBlock
LOCAL o
s_xVar := xVar
// ; Display
s_cTest := "Display Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic )
SetPos( 14, 14 ) ; o := _GET_( s_xVar, "s_xVar" )
TEST_LINE( GET_CREATE() )
TEST_LINE( o:Display() )
// ; In focus
s_cTest := "InFocus Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic )
SetPos( 14, 14 )
o := _GET_( s_xVar, "s_xVar",,, )
SetPos( 14, 14 ) ; o := _GET_( s_xVar, "s_xVar" )
TEST_LINE( GET_CREATE() )
bOldBlock := o:block
TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } )
TEST_LINE( o:SetFocus() )
IF cPic != NIL
TEST_LINE( o:picture := "99999" )
TEST_LINE( o:picture := cPic )
TEST_LINE( o:picture := NIL )
ENDIF
@@ -162,12 +724,12 @@ PROCEDURE TGetTest( xVar, cPic )
s_cTest := "NotFocus Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic )
SetPos( 14, 14 )
o := _GET_( s_xVar, "s_xVar",,, )
SetPos( 14, 14 ) ; o := _GET_( s_xVar, "s_xVar" )
TEST_LINE( GET_CREATE() )
bOldBlock := o:block
TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } )
IF cPic != NIL
TEST_LINE( o:picture := "99999" )
TEST_LINE( o:picture := cPic )
TEST_LINE( o:picture := NIL )
ENDIF
@@ -181,8 +743,7 @@ PROCEDURE TGetTest( xVar, cPic )
s_cTest := "InFocus #2 Var: " + ValType( xVar ) + " Pic: " + iif( cPic == NIL, "(none)", cPic )
SetPos( 14, 14 )
o := _GET_( s_xVar, "s_xVar",,, )
SetPos( 14, 14 ) ; o := _GET_( s_xVar, "s_xVar" )
bOldBlock := o:block
TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } )
TEST_LINE( o:SetFocus() )
@@ -213,9 +774,23 @@ PROCEDURE TGetTest( xVar, cPic )
RETURN
PROCEDURE TEST_CALL( o, cBlock, bBlock )
LOCAL xRetVal := Eval( bBlock )
LOCAL xResult
LOCAL bOldError
LOCAL oError
LogGETVars( o, cBlock, xRetVal )
SetPos( 0, 0 ) // ; To check where the cursor was moved after evaluating the block.
bOldError := ErrorBlock( {|oError| Break( oError ) } )
BEGIN SEQUENCE
xResult := Eval( bBlock )
RECOVER USING oError
xResult := ErrorMessage( oError )
END SEQUENCE
ErrorBlock( bOldError )
LogGETVars( o, cBlock, xResult )
RETURN
@@ -224,7 +799,7 @@ PROCEDURE LogMe( data, desc )
LOCAL cStack
cStack := ""
FOR nLevel := 2 TO 2
FOR nLevel := 2 TO 5
IF Empty( ProcName( nLevel ) )
EXIT
ENDIF
@@ -236,17 +811,19 @@ PROCEDURE LogMe( data, desc )
ENDIF
desc := s_cTest + " " + desc
cStack := ""
IF !s_lCallBackStack
cStack := ""
ENDIF
IF PCount() > 2
FWrite( s_fhnd, cStack + "BLOCK_SET " + iif( data == NIL, "NIL", data ) + " " + desc + HB_OSNewLine() )
FWrite( s_fhnd, cStack + "BLOCK_SET " + iif( data == NIL, "NIL", data ) + " " + desc + hb_OSNewLine() )
ELSE
FWrite( s_fhnd, cStack + "BLOCK_GET " + desc + HB_OSNewLine() )
FWrite( s_fhnd, cStack + "BLOCK_GET " + desc + hb_OSNewLine() )
ENDIF
RETURN
PROCEDURE LogGETVars( o, desc, xRetVal )
PROCEDURE LogGETVars( o, desc, xResult )
LOCAL nLevel
LOCAL cStack
@@ -263,40 +840,59 @@ PROCEDURE LogGETVars( o, desc, xRetVal )
ENDIF
desc := s_cTest + " " + XToStr( desc )
FWrite( s_fhnd, cStack + " " + desc + HB_OSNewLine() )
FWrite( s_fhnd, "---------------------" + HB_OSNewLine() )
FWrite( s_fhnd, " s_xVar " + XToStr( s_xVar ) + HB_OSNewLine() )
FWrite( s_fhnd, " xRetVal " + XToStr( xRetVal ) + HB_OSNewLine() )
FWrite( s_fhnd, " Row() " + XToStr( Row() ) + HB_OSNewLine() )
FWrite( s_fhnd, " Col() " + XToStr( Col() ) + HB_OSNewLine() )
FWrite( s_fhnd, " BadDate " + XToStr( o:BadDate ) + HB_OSNewLine() )
FWrite( s_fhnd, " Block " + XToStr( o:Block ) + HB_OSNewLine() )
FWrite( s_fhnd, " Buffer " + XToStr( o:Buffer ) + HB_OSNewLine() )
FWrite( s_fhnd, " Cargo " + XToStr( o:Cargo ) + HB_OSNewLine() )
FWrite( s_fhnd, " Changed " + XToStr( o:Changed ) + HB_OSNewLine() )
FWrite( s_fhnd, " Clear " + XToStr( o:Clear ) + HB_OSNewLine() )
FWrite( s_fhnd, " Col " + XToStr( o:Col ) + HB_OSNewLine() )
FWrite( s_fhnd, " ColorSpec " + XToStr( o:ColorSpec ) + HB_OSNewLine() )
FWrite( s_fhnd, " DecPos " + XToStr( o:DecPos ) + HB_OSNewLine() )
FWrite( s_fhnd, " ExitState " + XToStr( o:ExitState ) + HB_OSNewLine() )
FWrite( s_fhnd, " HasFocus " + XToStr( o:HasFocus ) + HB_OSNewLine() )
FWrite( s_fhnd, " Minus " + XToStr( o:Minus ) + HB_OSNewLine() )
FWrite( s_fhnd, " Name " + XToStr( o:Name ) + HB_OSNewLine() )
FWrite( s_fhnd, " Original " + XToStr( o:Original ) + HB_OSNewLine() )
FWrite( s_fhnd, " Picture " + XToStr( o:Picture ) + HB_OSNewLine() )
FWrite( s_fhnd, " Pos " + XToStr( o:Pos ) + HB_OSNewLine() )
FWrite( s_fhnd, " PostBlock " + XToStr( o:PostBlock ) + HB_OSNewLine() )
FWrite( s_fhnd, " PreBlock " + XToStr( o:PreBlock ) + HB_OSNewLine() )
FWrite( s_fhnd, " Reader " + XToStr( o:Reader ) + HB_OSNewLine() )
FWrite( s_fhnd, " Rejected " + XToStr( o:Rejected ) + HB_OSNewLine() )
FWrite( s_fhnd, " Row " + XToStr( o:Row ) + HB_OSNewLine() )
FWrite( s_fhnd, " SubScript " + XToStr( o:SubScript ) + HB_OSNewLine() )
FWrite( s_fhnd, " Type " + XToStr( o:Type ) + HB_OSNewLine() )
FWrite( s_fhnd, " TypeOut " + XToStr( o:TypeOut ) + HB_OSNewLine() )
FWrite( s_fhnd, "---------------------" + HB_OSNewLine() )
FWrite( s_fhnd, cStack + " " + desc + hb_OSNewLine() )
FWrite( s_fhnd, "---------------------" + hb_OSNewLine() )
FWrite( s_fhnd, " s_xVar " + XToStr( s_xVar ) + hb_OSNewLine() )
FWrite( s_fhnd, " xResult " + XToStr( xResult ) + hb_OSNewLine() )
FWrite( s_fhnd, " Row() " + XToStr( Row() ) + hb_OSNewLine() )
FWrite( s_fhnd, " Col() " + XToStr( Col() ) + hb_OSNewLine() )
FWrite( s_fhnd, " UnTransform() " + XToStr( o:UnTransform() ) + hb_OSNewLine() )
FWrite( s_fhnd, " BadDate " + XToStr( o:BadDate ) + hb_OSNewLine() )
FWrite( s_fhnd, " Block " + XToStr( o:Block ) + hb_OSNewLine() )
FWrite( s_fhnd, " Buffer " + XToStr( o:Buffer ) + hb_OSNewLine() )
FWrite( s_fhnd, " Cargo " + XToStr( o:Cargo ) + hb_OSNewLine() )
FWrite( s_fhnd, " Changed " + XToStr( o:Changed ) + hb_OSNewLine() )
FWrite( s_fhnd, " Clear " + XToStr( o:Clear ) + hb_OSNewLine() )
FWrite( s_fhnd, " Col " + XToStr( o:Col ) + hb_OSNewLine() )
FWrite( s_fhnd, " ColorSpec " + XToStr( o:ColorSpec ) + hb_OSNewLine() )
FWrite( s_fhnd, " DecPos " + XToStr( o:DecPos ) + hb_OSNewLine() )
FWrite( s_fhnd, " ExitState " + XToStr( o:ExitState ) + hb_OSNewLine() )
FWrite( s_fhnd, " HasFocus " + XToStr( o:HasFocus ) + hb_OSNewLine() )
FWrite( s_fhnd, " Minus " + XToStr( o:Minus ) + hb_OSNewLine() )
FWrite( s_fhnd, " Name " + XToStr( o:Name ) + hb_OSNewLine() )
FWrite( s_fhnd, " Original " + XToStr( o:Original ) + hb_OSNewLine() )
FWrite( s_fhnd, " Picture " + XToStr( o:Picture ) + hb_OSNewLine() )
FWrite( s_fhnd, " Pos " + XToStr( o:Pos ) + hb_OSNewLine() )
FWrite( s_fhnd, " PostBlock " + XToStr( o:PostBlock ) + hb_OSNewLine() )
FWrite( s_fhnd, " PreBlock " + XToStr( o:PreBlock ) + hb_OSNewLine() )
FWrite( s_fhnd, " Reader " + XToStr( o:Reader ) + hb_OSNewLine() )
FWrite( s_fhnd, " Rejected " + XToStr( o:Rejected ) + hb_OSNewLine() )
FWrite( s_fhnd, " Row " + XToStr( o:Row ) + hb_OSNewLine() )
FWrite( s_fhnd, " SubScript " + XToStr( o:SubScript ) + hb_OSNewLine() )
FWrite( s_fhnd, " Type " + XToStr( o:Type ) + hb_OSNewLine() )
FWrite( s_fhnd, " TypeOut " + XToStr( o:TypeOut ) + hb_OSNewLine() )
#ifndef __HARBOUR
IF s_lC5xDump
FWrite( s_fhnd, " _dump_ " + GetToList( o ) + hb_OSNewLine() )
ENDIF
#endif
FWrite( s_fhnd, "---------------------" + hb_OSNewLine() )
RETURN
STATIC FUNCTION GetToList( o )
LOCAL cString := ""
LOCAL tmp
FOR tmp := 1 TO Len( o )
cString += XToStr( o[ tmp ] )
IF tmp < Len( o )
cString += ", "
ENDIF
NEXT
RETURN cString
FUNCTION XToStr( xValue )
LOCAL cType := ValType( xValue )
@@ -323,6 +919,123 @@ FUNCTION XToStr( xValue )
RETURN ""
FUNCTION XToStrE( xValue )
LOCAL cType := ValType( xValue )
DO CASE
CASE cType == "C"
xValue := StrTran( xValue, Chr(0), '"+Chr(0)+"' )
xValue := StrTran( xValue, Chr(9), '"+Chr(9)+"' )
xValue := StrTran( xValue, Chr(10), '"+Chr(10)+"' )
xValue := StrTran( xValue, Chr(13), '"+Chr(13)+"' )
xValue := StrTran( xValue, Chr(26), '"+Chr(26)+"' )
RETURN xValue
CASE cType == "N" ; RETURN LTrim( Str( xValue ) )
CASE cType == "D" ; RETURN DToS( xValue )
CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." )
CASE cType == "O" ; RETURN xValue:className() + " Object"
CASE cType == "U" ; RETURN "NIL"
CASE cType == "B" ; RETURN '{||...}'
CASE cType == "A" ; RETURN '{.[' + LTrim( Str( Len( xValue ) ) ) + '].}'
CASE cType == "M" ; RETURN 'M:' + xValue
ENDCASE
RETURN ""
STATIC FUNCTION ErrorMessage( oError )
LOCAL cMessage := ""
LOCAL tmp
IF s_lRTEDetails
IF ValType( oError:severity ) == "N"
DO CASE
CASE oError:severity == ES_WHOCARES ; cMessage += "M "
CASE oError:severity == ES_WARNING ; cMessage += "W "
CASE oError:severity == ES_ERROR ; cMessage += "E "
CASE oError:severity == ES_CATASTROPHIC ; cMessage += "C "
ENDCASE
ENDIF
IF ValType( oError:subsystem ) == "C"
cMessage += oError:subsystem + " "
ENDIF
IF ValType( oError:subCode ) == "N"
cMessage += LTrim( Str( oError:subCode ) ) + " "
ENDIF
IF ValType( oError:description ) == "C"
cMessage += oError:description + " "
ENDIF
IF !Empty( oError:operation )
cMessage += oError:operation + " "
ENDIF
IF !Empty( oError:filename )
cMessage += oError:filename + " "
ENDIF
IF ValType( oError:Args ) == "A"
cMessage += "A:" + LTrim( Str( Len( oError:Args ) ) ) + ":"
FOR tmp := 1 TO Len( oError:Args )
cMessage += ValType( oError:Args[ tmp ] ) + ":" + XToStrE( oError:Args[ tmp ] )
IF tmp < Len( oError:Args )
cMessage += ";"
ENDIF
NEXT
cMessage += " "
ENDIF
IF oError:canDefault .OR. ;
oError:canRetry .OR. ;
oError:canSubstitute
cMessage += "F:"
IF oError:canDefault
cMessage += "D"
ENDIF
IF oError:canRetry
cMessage += "R"
ENDIF
IF oError:canSubstitute
cMessage += "S"
ENDIF
ENDIF
ENDIF
RETURN cMessage
#ifdef __XPP__
FUNCTION HB_SToD( cDate )
RETURN SToD( cDate )
#endif
#ifndef HAVE_HBCLIP
#ifndef __HARBOUR__
#ifndef __XPP__
FUNCTION HB_SToD( cDate )
LOCAL cOldDateFormat
LOCAL dDate
IF ValType( cDate ) == "C" .AND. !Empty( cDate )
cOldDateFormat := Set( _SET_DATEFORMAT, "yyyy/mm/dd" )
dDate := CToD( SubStr( cDate, 1, 4 ) + "/" +;
SubStr( cDate, 5, 2 ) + "/" +;
SubStr( cDate, 7, 2 ) )
Set( _SET_DATEFORMAT, cOldDateFormat )
ELSE
dDate := CToD( "" )
ENDIF
RETURN dDate
#endif
#endif
#endif
PROCEDURE GET_CREATE()
// ; Dummy